diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,37 +3,170 @@ `summoner` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 1.4.0.0 – Dec 25, 2019 🎅 + +* [#339](https://github.com/kowainik/summoner/issues/339): + Support GHC `8.8.1` in generated projects. + __Note:__ Stack projects will use `nightly` resolver as the stable one is not + out at the moment of this issue is implemented. + (by [@vrom911](https://github.com/vrom911)) +* Add `-Wmissing-deriving-strategies` option to GHC version `8.8.1` and upper + in the generated projects. + (by [@vrom911](https://github.com/vrom911)) +* [#314](https://github.com/kowainik/summoner/issues/314): + __#CLI__ __#TUI__ Improve `summon(-tui) show ghc` output. + (by [@gableh](https://github.com/gableh), [@vrom911](https://github.com/vrom911)) +* [#316](https://github.com/kowainik/summoner/issues/316): + Add logos to README bagdes in the generated projects. + (by [@vrom911](https://github.com/vrom911)) +* Generate project of version `0.0.0.0` instead of `0.0.0`. + (by [@vrom911](https://github.com/vrom911)) +* [#322](https://github.com/kowainik/summoner/issues/322): + Run HLint check before project build in `.travis.yml` file for + the generated projects. + (by [@vrom911](https://github.com/vrom911)) +* [#382](https://github.com/kowainik/summoner/issues/382): + Improve error logging when fetching the license from GitHub while generating + the project. + (by [@chshersh](https://github.com/chshersh)) +* [#255](https://github.com/kowainik/summoner/issues/255): + __#CLI__ __#TUI__ Autofill prelude module name when package name is typed. + (by [@yigitozkavci](https://github.com/yigitozkavci)) +* [#354](https://github.com/kowainik/summoner/issues/354): + __#CLI__ __#TUI__ Validate prelude package name and module name in config file, CLI, TUI. + (by [@yigitozkavci](https://github.com/yigitozkavci), [@vrom911](https://github.com/vrom911)) +* [#315](https://github.com/kowainik/summoner/issues/315): + Remove `-fhide-source-paths` from generated `stack.yaml` file + as it is implied by the newer version of Stack. + (by [@bangng](https://github.com/chshersh), [@chshersh](https://github.com/chshersh)) +* Add `stack.yaml.lock` to `.gitignore` file in the generated project. + (by [@vrom911](https://github.com/vrom911)) +* [#318](https://github.com/kowainik/summoner/issues/318): + Support GHC `8.6.5` in generated projects. + (by [@vrom911](https://github.com/vrom911)) +* Remove support of GHC `8.6.4`, `8.6.3`, `8.4.3`. Leave only the latest + versions of each major release for generated projects. + (by [@vrom911](https://github.com/vrom911)) +* [#333](https://github.com/kowainik/summoner/issues/333): + Introduce `files` option in the TOML configuration which allows to specify + custom files. Deprecate `stylish` and `contributing` options. + (by [@chshersh](https://github.com/chshersh)) + + _Migration guide:_ Instead of + + ```toml + stylish.url = "some url" + contributing.link = "some link" + ``` + + specify them like this: + + ```toml + files = + [ { path = ".stylish-haskell.yaml" + , url = "some url" + } + , { path = "CONTRIBUTING.md" + , link = "some link" + } + ] + ``` +* [#374](https://github.com/kowainik/summoner/issues/374): + Remove `warnings` field in the TOML configuration which was deprecated in the previous release. + (by [@chshersh](https://github.com/chshersh)) + + _Migration guide:_ Rename `warnings` field to `ghc-options` instead. +* [#367](https://github.com/kowainik/summoner/issues/367): + Add `raw` type of custom extra files in the TOML configuration. + Remove `link` type of file. + (by [@chshersh](https://github.com/chshersh)) + + _Migration guide:_ Replace `link` with `raw` and specify any custom text you + want. +* Rename `file` config field of `source` to `local` in the TOML configuration. + (by [@chshersh](https://github.com/chshersh)) +* [#327](https://github.com/kowainik/summoner/issues/327): + Better AppVeyor CI configuration for both `cabal` and `stack` in the generated + project. + (by [@chshersh](https://github.com/chshersh)) +* [#253](https://github.com/kowainik/summoner/issues/253): + __#TUI__ Fix new line in the Description field of the form. + (by [@yigitozkavci](https://github.com/yigitozkavci)) +* [#385](https://github.com/kowainik/summoner/issues/385): + Add golden tests for `summon show ghc` command's output. + (by [@vrom911](https://github.com/vrom911)) +* [#384](https://github.com/kowainik/summoner/issues/384): + Test golden project build's success. + (by [@chshersh](https://github.com/chshersh)) +* [#318](https://github.com/kowainik/summoner/issues/318): + Build Summoner multipackage project with GHC `8.6.5`. + (by [@vrom911](https://github.com/vrom911)) +* [#338](https://github.com/kowainik/summoner/issues/338): + Build Summoner multipackage project with GHC-8.8.1. + (by [@vrom911](https://github.com/vrom911)) +* [#360](https://github.com/kowainik/summoner/issues/360): + Use mixins with `base` and `relude` in Summoner. Drop `base-noprelude` trick. + (by [@vrom911](https://github.com/vrom911)) +* [#329](https://github.com/kowainik/summoner/issues/329): + Bump up to `optparse-applicative-0.15`, use custom `ParserPrefs`. + (by [@vrom911](https://github.com/vrom911)) +* [#328](https://github.com/kowainik/summoner/issues/328): + Upgrade `tomland` bounds to allow `1.1.0.0`. + (by [@vrom911](https://github.com/vrom911)) +* [#373](https://github.com/kowainik/summoner/issues/373): + Bump up to `tomland-1.2.1.0`. + (by [@vrom911](https://github.com/vrom911)) +* Bump up to `relude-0.6.0.0`. + (by [@vrom911](https://github.com/vrom911)) +* [#337](https://github.com/kowainik/summoner/issues/337): + Allow `generic-deriving-1.13`. + (by [@chshersh](https://github.com/chshersh)) +* [#341](https://github.com/kowainik/summoner/issues/341): + Allow `ansi-terminal-0.10`. + (by [@mpilgrem](https://github.com/mpilgrem)) +* [#323](https://github.com/kowainik/summoner/issues/323): + Allow `tree-diff-0.1`. + (by [@vrom911](https://github.com/vrom911)) +* [#320](https://github.com/kowainik/summoner/issues/320): + Allow `hedgehog-1.0`. + (by [@vrom911](https://github.com/vrom911)) + ## 1.3.0.1 — Apr 10, 2019 * Include golden test files into `extra-source-files`. -## 1.3.0 — Apr 9, 2019 +## 1.3.0 (TUI: 0.1.0) — Apr 9, 2019 * [#285](https://github.com/kowainik/summoner/issues/285): - Implement `summon script` command. + __#CLI__ __#TUI__ Implement `summon script` command. * [#151](https://github.com/kowainik/summoner/issues/151), [#295](https://github.com/kowainik/summoner/issues/295): Add support for GHC-8.6. Make GHC-8.6.4 default. * [#269](https://github.com/kowainik/summoner/issues/269): - __Important:__ Introduce `ghc-options` configuration parameter. Deprecate `warnings` field in TOML file. + __Important:__ Introduce `ghc-options` configuration parameter. Deprecate + `warnings` field in the TOML configuration. _Migration guide:_ Please, rename `warnings` field if you use one, it will be removed in the very next release. Use `ghc-options` instead. * [#303](https://github.com/kowainik/summoner/issues/303): - Add option `noUpload` to TOML config file. + Add option `noUpload` to the TOML configuration. * __Important:__ Summoner doesn't add old GHC versions into Travis matrix for Stack anymore. See this Stack issue for reasoning: https://github.com/commercialhaskell/stack/issues/4488 * [#280](https://github.com/kowainik/summoner/issues/280): Support build with `cabal-install` on the AppVeyor CI. + + __#TUI__ AppVeyor CI checkbox is no longer disabled when only `cabal` build tool is + selected. * [#272](https://github.com/kowainik/summoner/issues/272): - Simplify Travis config for Cabal. + Simplify Travis config for Cabal in the generated project. * [#275](https://github.com/kowainik/summoner/issues/275): - Simplify Travis settings/installation process for Stack. + Simplify Travis settings/installation process for Stack in the generated + project. * [#261](https://github.com/kowainik/summoner/issues/261): Guess author login, name and email from `.gitconfig`. * [#268](https://github.com/kowainik/summoner/issues/268): - Simplify process of adding custom prelude in the interactive mode. + __#CLI__ Simplify process of adding custom prelude in the interactive mode. * [#282](https://github.com/kowainik/summoner/issues/282): Allow users to extend the `.gitignore` file. * [#286](https://github.com/kowainik/summoner/issues/286), @@ -41,9 +174,16 @@ [#304](https://github.com/kowainik/summoner/issues/304): Bump up to `tomland-1.0.0`, `relude-0.5.0`, `shellmet-0.0.1`. * Drop support for GHC-8.6.3 on CI. Support GHC-8.6.4 on CI. +* __#TUI__ Upgrade to `summoner-1.3.0`. +* [#297](https://github.com/kowainik/summoner/issues/297): + __#TUI__ Strip project description. +* [#304](https://github.com/kowainik/summoner/issues/304): + __#TUI__ Bump up to `brick-0.47`. -## 1.2.0 — Nov 30, 2018 +## 1.2.0 (TUI: 0.0.0) — Nov 30, 2018 +* [#208](https://github.com/kowainik/summoner/issues/208): + __#TUI__ Implement initial TUI for `summoner`. * Make `cabal-version: 2.0` default in generated projects. * [#11](https://github.com/kowainik/summoner/issues/11): Support offline mode. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,9 +1,9 @@ # 🔮 Summoner ![wizard](https://user-images.githubusercontent.com/8126674/44388234-320aac00-a55a-11e8-879d-5dca68512031.png) -[![Build](https://secure.travis-ci.org/kowainik/summoner.svg)](http://travis-ci.org/kowainik/summoner) +[![Build](https://img.shields.io/travis/kowainik/summoner.svg?logo=travis)](http://travis-ci.org/kowainik/summoner) [![Windows build](https://ci.appveyor.com/api/projects/status/github/kowainik/summoner?branch=master&svg=true)](https://ci.appveyor.com/project/kowainik/summoner) -[![Hackage](https://img.shields.io/hackage/v/summoner.svg)](https://hackage.haskell.org/package/summoner) +[![Hackage](https://img.shields.io/hackage/v/summoner.svg?logo=haskell)](https://hackage.haskell.org/package/summoner) [![MPL-2.0 license](https://img.shields.io/badge/license-MPL--2.0-blue.svg)](https://github.com/kowainik/summoner/blob/master/LICENSE) > _So many of our dreams at first seem impossible, then they seem improbable, and @@ -14,7 +14,8 @@ Summoner is a tool for scaffolding fully configured batteries-included production-level Haskell projects. Do you want to create a library that is to be uploaded to Hackage/Stackage, that builds with both Cabal and Stack and supports the latest three major GHC versions? -Or you are building a production application which uses a custom prelude and has CI with Travis Linux and AppVeyors Windows checks? +Or are you building a production application which uses a custom prelude and has CI with Travis Linux and AppVeyors Windows checks? +Maybe do you want to play with your idea in a single module without introducing the whole complexity of the Haskell projects? Summoner can help you do all that with minimal effort from you - it can even upload the project to GitHub if you wish! By the way, Summoner operates as either CLI or TUI application, so you can choose what you're more comfortable with and install only the required one. @@ -24,13 +25,14 @@ * [Demo](#demo-) + [TUI demo](#tui-demo-) + [CLI demo](#cli-demo-) - + [Scaffolded project structure](#scaffolded-project-structure-) + + [Examples](#examples-) * [Features](#features-) * [Get started](#get-started-) + [Prerequisites](#prerequisites-) + [Installation](#installation-) + [Summon-TUI](#summon-tui-) + [TUI: download binary](#tui-download-binary-) + + [TUI: from Hackage/Stackage](#tui-from-hackagestackage-) + [TUI: from source](#tui-from-source-) + [Summon-CLI](#summon-cli-) + [CLI: download binary](#cli-download-binary-) @@ -47,7 +49,6 @@ + [Build](#build-) + [Test](#test-) + [Run](#run-) -* [Changelog](#changelog-) * [Acknowledgments](#acknowledgments-) ## Demo [↑](#structure) @@ -60,60 +61,38 @@ [![CLI demo](https://asciinema.org/a/214433.png)](https://asciinema.org/a/214433) -### Scaffolded project structure [↑](#structure) - -This is an example of the project hierarchy you can get if you're running Summoner with all options enabled: - -``` -project-name/ -├── app/ -│   └── Main.hs -├── benchmark/ -│   └── Main.hs -├── src/ -│ ├── ProjectName.hs -│   └── Prelude.hs -├── test/ -│   └── Spec.hs -├── CHANGELOG.md -├── CONTRIBUTING.md -├── LICENSE -├── project-name.cabal -├── README.md -├── Setup.hs -├── stack.yaml -├── appveyor.yml -├── .git -├── .gitignore -├── .stylish-haskell.yaml -└── .travis.yml -``` +### Examples You can also see complete examples in the following folder: * [`summon-cli/tests/golden`: Examples of scaffolded projects](https://github.com/kowainik/summoner/tree/master/summoner-cli/test/golden) -Directory `smallProject` contains an example of the straightforward package, and `fullProject` shows a generated project with more advanced structure and more features. +Directory `smallProject` contains an example of the straightforward package, +and `fullProject` shows a generated project with more advanced structure and more features. ## Features [↑](#structure) Summoner is a tool that combines predefined configurations, command-line arguments and a chosen interface. -To fully understand the power in your hands with the help of Summoner, please check out this section. +To fully understand the power in your hands with the help of Summoner, please read this section. Below you can see highlighted features in different categories. ### Project [↑](#structure) +Features related to the structure and content of the generated projects. + + Support for Cabal and Stack build tools. + Ability to pick stanzas (library, executable, test-suite, benchmark). -+ Option to include an alternative prelude, if desired. The project would then use [`base-noprelude` technique](http://hackage.haskell.org/package/Prelude), and the `Prelude` module would be added to the library target. -+ Whole Hackage-upload checklist support. ++ Option to include an alternative prelude, if desired. The project would then + use [`base-noprelude` technique](http://hackage.haskell.org/package/Prelude), + and the `Prelude` module would be added to the library target. ++ Whole Hackage-upload checklist support (exhaustive `.cabal` file, PVP versioning, GHC options, conventional meta files). + Support for multiple GHC versions, with thoughtful reflection on project meta, base versions (e.g. `base >= 4.9 && < 4.12`), etc. + Ability to create runnable Haskell scripts. + Different license support: MIT, BSD2, BSD3, GPL-2, GPL-3, LGPL-2.1, LGPL-3, AGPL-3, Apache-2.0, MPL-2.0, None (All Rights Reserved license without file). + Creation of the `CHANGELOG.md` file with [PVP versioning policy](https://pvp.haskell.org). -+ Ability to include your `.stylish-haskell.yaml` file. ++ Ability to include any custom files (including `.stylish-haskell.yaml`, `CONTRIBUTING.md`, `CODEOWNERS`, etc.). + Usage of the `ghc-options` field with sensible defaults. If `ghc-options` are not explicitly stated in the configuration file, then the following list of GHC flags is added to all stanzas: @@ -124,10 +103,11 @@ -Wincomplete-record-updates -Wcompat -Widentities - -Wredundant-constraints (ghc >= 8.0) - -fhide-source-paths (ghc >= 8.2.2) - -Wmissing-export-lists (ghc >= 8.4.1) - -Wpartial-fields (ghc >= 8.4.1) + -Wredundant-constraints (GHC >= 8.0) + -fhide-source-paths (GHC >= 8.2.2) + -Wmissing-export-lists (GHC >= 8.4.1) + -Wpartial-fields (GHC >= 8.4.1) + -Wmissing-deriving-strategies (GHC >= 8.8.1) ``` Besides, the following GHC options are added to the executable, tests and benchmark stanzas: @@ -146,22 +126,55 @@ + Exhaustive `.gitignore` file. + Formation of the `README` file with Hackage, Stackage and CI badges. + Linking to the GitHub repository in the `.cabal` file. -+ Ability to include your `CONTRIBUTING.md` file. -+ Guessing user credentials from `.gitconfig`. ++ Ability to include your custom GitHub meta files: `CONTRIBUTING.md`, `CODEOWNERS`, `.github/pull_request_template.md`, etc. ++ Guessing user credentials from the local `.gitconfig` file. ### CI [↑](#structure) + Generation of the `.travis.yml` file that runs build and tests on CI under Linux using [Dead simple Haskell Travis Settings for Cabal and Stack](https://chshersh.github.io/posts/2019-02-25-haskell-travis). ++ Generation of the `appveyor.yaml` file which runs build and tests on CI under Windows. + Configuration matrix on CI to build with multiple GHC versions and various build tools. + `-Werror` is enabled on CI not to miss any warnings. + Run HLint checks on CI. -+ Generation of the `appveyor.yaml` file which runs build and tests on CI under Windows. ### Others [↑](#structure) -+ Ability to create a project in offline mode. ++ Ability to create a project in the offline mode. ++ Ability to check GHC-specific versions of the corresponding `base` library + and Stackage snapshot resolver via `summon show ghc` command. ++ Carefully collected Haskell project best practices gathered in your projects' scaffold. +### Project structure example [↑](#structure) + +This is an example of the project hierarchy you can get if you are running Summoner's `new` command with all options enabled: + +``` +project-name/ +├── app/ +│   └── Main.hs +├── benchmark/ +│   └── Main.hs +├── src/ +│ ├── ProjectName.hs +│   └── Prelude.hs +├── test/ +│   └── Spec.hs +├── CHANGELOG.md +├── CONTRIBUTING.md +├── LICENSE +├── project-name.cabal +├── README.md +├── Setup.hs +├── stack.yaml +├── stack-8.6.5.yaml +├── appveyor.yml +├── .git +├── .gitignore +├── .stylish-haskell.yaml +└── .travis.yml +``` + ## Get started [↑](#structure) ### Prerequisites [↑](#structure) @@ -172,6 +185,13 @@ * [`hub`](https://github.com/github/hub) – to upload the project to GitHub. * [`curl`](https://curl.haxx.se) – to download licenses. +We also have minimal version requirements for build tools: + +* [Cabal >= 2.0](https://www.haskell.org/cabal/) +* [Stack >= 2.1](http://haskellstack.org) + +However, it is always recommended to use the newest versions of build tools. + ### Installation [↑](#structure) Summon contains two executables: @@ -196,6 +216,21 @@ mv summon-cli-linux ~/.local/bin/summon ``` +##### TUI: from Hackage/Stackage [↑](#structure) + +Using `cabal`: + +```shell +cabal new-update +cabal new-install summoner-tui +``` + +Using `stack`: + +```shell +stack install summoner-tui +``` + ##### TUI: from source [↑](#structure) Fetch the repo using `cabal`: @@ -323,7 +358,7 @@ | `fullName` | Text | Full name. | | `email` | Text | E-mail address. | | `license` | License | One of: `MIT`, `BSD2`, `BSD3`, `GPL-2`, `GPL-3`, `LGPL-2.1`, `LGPL-3`, `AGPL-3`, `Apache-2.0`, `MPL-2.0`, `None`. | -| `ghcVersions` | [GHC] | `summoner` uses default `GHC-8.6.4`. However, additionally you can specify other versions. For each version `x.y.z` the `stack-x.y.z.yaml` will be created. | +| `ghcVersions` | [GHC] | `summoner` uses default `GHC-8.8.1`. However, additionally you can specify other versions. For each version `x.y.z` the `stack-x.y.z.yaml` will be created. | | `github` | Bool | Turn on `GitHub` integration by default? | | `gitignore` | [Text] | List of files you want added to the default `.gitignore`. (Ignored if `github = false`) | | `noUpload` | Bool | Do not upload to GitHub, but create all GitHub related files if specified (Ignored if `github = false`) | @@ -336,8 +371,9 @@ | `bench` | Bool | Create `benchmark` folder with `Main.hs` file with [`gauge`](https://hackage.haskell.org/package/gauge) library usage example? | | `extensions` | [Text] | List of the default extensions to add into `default-extensions` section in the `.cabal`. | | `ghc-options` | [Text] | List of the default GHC options to add into `ghc-options` section in the `.cabal`. | -| `stylish.*` | Text | `stylish.file` to provide the absolute file path OR `stylish.url` to download the `.stylish-haskell.yaml` file to use in the project. | -| `contributing.*` | Text | `contributing.file` to provide the absolute file path OR `contributing.url` download OR `contribuint.link` to link the `CONTRIBUTING.md` file to use in the project. | +| `stylish.*` | Text | **DEPRECATED** `stylish.file` to provide the absolute file path OR `stylish.url` to download the `.stylish-haskell.yaml` file to use in the project. | +| `contributing.*` | Text | **DEPRECATED** `contributing.file` to provide the absolute file path OR `contributing.url` download OR `contribuint.link` to link the `CONTRIBUTING.md` file to use in the project. | +| `files` | Map FilePath Source | Custom mapping of files to their sources. Represented as a list of inline tables in TOML in a format like `files = [ { path = "foo", url = "https://..." }, ... ]`. Supported file types: `url`, `local`, `raw`. | |`[prelude]` | | | | `package` | Text | The package name of the custom prelude you'd like to use in the project (doesn't work without `module` field). | | `module` | Text | The module name of the custom prelude you'd like to use in the project (doesn't work without `package` field). | @@ -505,7 +541,7 @@ #!/usr/bin/env cabal {- cabal: build-depends: - , base ^>= 4.12.0.0 + , base ^>= 4.13.0.0 -} main :: IO () @@ -517,7 +553,7 @@ ```haskell #!/usr/bin/env stack {- stack - --resolver lts-13.16 + --resolver lts-14.18 script --package base -} @@ -562,7 +598,7 @@ * Summoner is a multi-package project which has two packages inside: `summoner-cli` and `summoner-tui`. We are supporting the same functionality in both of them, so, if it's possible, you should add/change the code in both of the packages. * Summoner uses the custom prelude [`relude`](https://github.com/kowainik/relude). * We are using the [Kowainik style guide](https://github.com/kowainik/org/blob/master/style-guide.md#haskell-style-guide). -* To sum up, [here is the Contributing guide](https://github.com/kowainik/org/blob/master/CONTRIBUTING.md#contributing-to-the-kowainik-repositories) we use across the repositories. +* To sum up, [here is the Contributing guide](https://github.com/kowainik/.github/blob/master/CONTRIBUTING.md#contributing-to-the-kowainik-repositories) we use across the repositories. * This project is contributor-friendly, so be kind to other people working on the project. ### Dependencies [↑](#structure) @@ -583,8 +619,15 @@ stack build ``` -for Stack. +for Stack and +```shell= +nix-build -A summoner # To build the CLI only +nix-build -A summoner-tui # To build the TUI +``` + +for Nix. + ### Test [↑](#structure) Summoner uses the golden tests technique for assuring the correctness of the generated files. For this purpose, we have [the `golden` folder](https://github.com/kowainik/summoner/tree/master/summoner-cli/test/golden) with two sample projects to test against. @@ -595,12 +638,18 @@ cabal new-test all ``` -or +or, if using Stack, ```shell stack test ``` +or, if using Nix, + +```shell +nix-shell --run 'cabal new-test all' +``` + ### Run [↑](#structure) Building Summoner with the recommended method creates two executables: `summon` and `summon-tui`. To run the compiled executable you can use the following commands: @@ -610,19 +659,19 @@ cabal new-exec summon-tui -- SOME_COMMAND ``` -or +or, if using Stack, ```shell stack exec summon -- SOME_COMMAND stack exec summon-tui -- SOME_COMMAND ``` -## Changelog [↑](#structure) - -Each package has its own changelog: +or, if using Nix, -* [Summoner changelog](https://github.com/kowainik/summoner/blob/master/summoner-cli/CHANGELOG.md#changelog). -* [Summoner-TUI changelog](https://github.com/kowainik/summoner/blob/master/summoner-tui/CHANGELOG.md#changelog). +```shell +nix-shell --run 'cabal new-run summon -- SOME_COMMAND' +nix-shell --run 'cabal new-run summon-tui -- SOME_COMMAND' +``` ## Acknowledgments [↑](#structure) diff --git a/app/Cli.hs b/app/Cli.hs --- a/app/Cli.hs +++ b/app/Cli.hs @@ -1,8 +1,9 @@ module Main where -import System.IO (hSetEncoding, stdout, utf8) +import System.IO (hSetEncoding, utf8) import Summoner (summonCli) + main :: IO () main = hSetEncoding stdout utf8 >> summonCli diff --git a/src/Prelude.hs b/src/Prelude.hs deleted file mode 100644 --- a/src/Prelude.hs +++ /dev/null @@ -1,19 +0,0 @@ --- | Uses [relude](https://hackage.haskell.org/package/relude) as default Prelude. - -module Prelude - ( module Relude - , module Relude.Extra - - , endLine - , memptyIfFalse - ) where - -import Relude -import Relude.Extra.Enum as Relude.Extra (inverseMap, universe) -import Relude.Extra.Validation as Relude.Extra - -endLine :: Text -endLine = "\n" - -memptyIfFalse :: Monoid m => Bool -> m -> m -memptyIfFalse p val = if p then val else mempty diff --git a/src/Summoner.hs b/src/Summoner.hs --- a/src/Summoner.hs +++ b/src/Summoner.hs @@ -1,3 +1,11 @@ +{- | +Copyright: (c) 2017-2019 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik + +Main module that reexports all library components of the @summoner@. +-} + module Summoner ( module Summoner ) where @@ -5,12 +13,15 @@ import Summoner.Ansi as Summoner import Summoner.CLI as Summoner import Summoner.Config as Summoner +import Summoner.CustomPrelude as Summoner +import Summoner.Decision as Summoner import Summoner.Default as Summoner import Summoner.GhcVer as Summoner import Summoner.License as Summoner -import Summoner.Process as Summoner import Summoner.Project as Summoner import Summoner.Question as Summoner import Summoner.Settings as Summoner +import Summoner.Source as Summoner import Summoner.Template as Summoner import Summoner.Text as Summoner +import Summoner.Tree as Summoner diff --git a/src/Summoner/Ansi.hs b/src/Summoner/Ansi.hs --- a/src/Summoner/Ansi.hs +++ b/src/Summoner/Ansi.hs @@ -1,4 +1,10 @@ --- | This module contains functions for colorful printing into terminal. +{- | +Copyright: (c) 2017-2019 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik + +This module contains functions for colorful printing into terminal. +-} module Summoner.Ansi ( Color (..) diff --git a/src/Summoner/CLI.hs b/src/Summoner/CLI.hs --- a/src/Summoner/CLI.hs +++ b/src/Summoner/CLI.hs @@ -3,8 +3,14 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} --- | This module contains functions and data types to parse CLI inputs. +{- | +Copyright: (c) 2017-2019 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik +This module contains functions and data types to parse CLI inputs. +-} + module Summoner.CLI ( -- * CLI data types Command (..) @@ -25,11 +31,14 @@ import Data.Version (Version, showVersion) import Development.GitRev (gitCommitDate, gitDirty, gitHash) import NeatInterpolation (text) -import Options.Applicative (Parser, ParserInfo, argument, command, execParser, flag, fullDesc, help, - helper, info, infoFooter, infoHeader, infoOption, long, maybeReader, - metavar, option, optional, progDesc, short, strArgument, strOption, - subparser, switch, value) +import Options.Applicative (Parser, ParserInfo, ParserPrefs, argument, command, customExecParser, + flag, fullDesc, help, helpLongEquals, helper, info, infoFooter, + infoHeader, infoOption, long, maybeReader, metavar, option, optional, + prefs, progDesc, short, showHelpOnEmpty, strArgument, strOption, + subparser, subparserInline, switch, value) import Options.Applicative.Help.Chunk (stringChunk) +import Relude.Extra.Enum (universe) +import Relude.Extra.Validation (Validation (..)) import Shellmet (($?), ($|)) import System.Directory (doesFileExist) import System.Info (os) @@ -38,14 +47,16 @@ successMessage, warningMessage) import Summoner.Config (Config, ConfigP (..), PartialConfig, defaultConfig, finalise, loadFileConfig) +import Summoner.CustomPrelude (CustomPrelude (..)) import Summoner.Decision (Decision (..)) import Summoner.Default (defaultConfigFile, defaultGHC) -import Summoner.GhcVer (GhcVer, parseGhcVer, showGhcVer) +import Summoner.GhcVer (GhcVer, ghcTable, parseGhcVer) import Summoner.License (License (..), LicenseName (..), fetchLicense, parseLicenseName, showLicenseWithDesc) import Summoner.Project (generateProject) -import Summoner.Settings (CustomPrelude (..), Tool, parseTool) +import Summoner.Settings (Tool, parseTool) import Summoner.Template.Script (scriptFile) +import Summoner.Text (endLine) import qualified Data.Text as T import qualified Paths_summoner as Meta (version) @@ -54,7 +65,15 @@ -- | Main function that parses @CLI@ commands and runs them using given -- 'Command' handler. summon :: Version -> (Command -> IO ()) -> IO () -summon version performCommand = execParser (cliParser version) >>= performCommand +summon version performCommand = + customExecParser summonerParserPrefs (cliParser version) >>= performCommand + where + -- To turn on some special options. + summonerParserPrefs :: ParserPrefs + summonerParserPrefs = prefs + $ helpLongEquals + <> showHelpOnEmpty + <> subparserInline -- | Runs @summoner@ in CLI mode. summonCli :: IO () @@ -84,7 +103,7 @@ runShow :: ShowOpts -> IO () runShow = \case -- show list of all available GHC versions - GhcList -> showBulletList @GhcVer showGhcVer (reverse universe) + GhcList -> showBulletList id ghcTable -- show a list of all available licenses LicenseList Nothing -> showBulletList @LicenseName showLicenseWithDesc universe -- show a specific license diff --git a/src/Summoner/Config.hs b/src/Summoner/Config.hs --- a/src/Summoner/Config.hs +++ b/src/Summoner/Config.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE FlexibleContexts #-} @@ -7,14 +9,20 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} --- | Summoner configurations. +{- | +Copyright: (c) 2017-2019 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik +Summoner configurations. +-} + module Summoner.Config ( ConfigP (..) , PartialConfig , Config - , configT + , configCodec , defaultConfig , finalise @@ -22,21 +30,24 @@ ) where import Data.List (lookup) -import Generics.Deriving.Monoid (GMonoid, gmemptydefault) -import Generics.Deriving.Semigroup (GSemigroup, gsappenddefault) +import Generics.Deriving.Monoid (GMonoid (..), gmemptydefault) +import Generics.Deriving.Semigroup (GSemigroup (..), gsappenddefault) import Toml (Key, TomlBiMap, TomlCodec, (.=)) +import Relude.Extra.Validation (Validation (..)) +import Summoner.CustomPrelude (CustomPrelude (..), customPreludeT) import Summoner.Decision (Decision (..)) import Summoner.GhcVer (GhcVer (..), parseGhcVer, showGhcVer) import Summoner.License (LicenseName (..), parseLicenseName) -import Summoner.Settings (CustomPrelude (..), customPreludeT) -import Summoner.Source (Source, sourceT) +import Summoner.Source (Source, sourceT, sourceCodec) import qualified Toml -- | The phase of the configurations. -data Phase = Partial | Final +data Phase + = Partial + | Final -- | Potentially incomplete configuration. data ConfigP (p :: Phase) = Config @@ -57,30 +68,33 @@ , cBench :: !Decision , cPrelude :: !(Last CustomPrelude) , cExtensions :: ![Text] - , cWarnings :: ![Text] - , cGhcOptions :: ![Text] -- ^ GHC options to add every stanza + , cGhcOptions :: ![Text] -- ^ GHC options to add to each stanza , cGitignore :: ![Text] - , cStylish :: !(Last Source) - , cContributing :: !(Last Source) + , cStylish :: !(Last Source) -- ^ DEPRECATED: source to .stylish-haskell.yaml + , cContributing :: !(Last Source) -- ^ DEPRECATED: source to CONTRIBUTING.md , cNoUpload :: !Any -- ^ Do not upload to the GitHub (even if enabled) - } deriving (Generic) + , cFiles :: !(Map FilePath Source) -- ^ Custom files + } deriving stock (Generic) -deriving instance +deriving anyclass instance ( GSemigroup (p :- Text) , GSemigroup (p :- LicenseName) , GSemigroup (p :- [GhcVer]) ) => GSemigroup (ConfigP p) -deriving instance + +deriving anyclass instance ( GMonoid (p :- Text) , GMonoid (p :- LicenseName) , GMonoid (p :- [GhcVer]) ) => GMonoid (ConfigP p) -deriving instance + +deriving stock instance ( Eq (p :- Text) , Eq (p :- LicenseName) , Eq (p :- [GhcVer]) ) => Eq (ConfigP p) -deriving instance + +deriving stock instance ( Show (p :- Text) , Show (p :- LicenseName) , Show (p :- [GhcVer]) @@ -104,6 +118,13 @@ mempty = gmemptydefault mappend = (<>) +instance Ord k => GSemigroup (Map k v) where + gsappend = (<>) + +instance Ord k => GMonoid (Map k v) where + gmempty = mempty + gmappend = (<>) + -- | Default 'Config' configurations. defaultConfig :: PartialConfig defaultConfig = Config @@ -124,47 +145,41 @@ , cBench = Idk , cPrelude = Last Nothing , cExtensions = [] - , cWarnings = [] , cGhcOptions = [] , cGitignore = [] , cStylish = Last Nothing , cContributing = Last Nothing , cNoUpload = Any False + , cFiles = mempty } -- | Identifies how to read 'Config' data from the @.toml@ file. -configT :: TomlCodec PartialConfig -configT = Config - <$> lastT Toml.text "owner" .= cOwner - <*> lastT Toml.text "fullName" .= cFullName - <*> lastT Toml.text "email" .= cEmail - <*> lastT license "license" .= cLicense - <*> lastT ghcVerArr "ghcVersions" .= cGhcVer - <*> decision "cabal" .= cCabal - <*> decision "stack" .= cStack - <*> decision "github" .= cGitHub - <*> decision "travis" .= cTravis - <*> decision "appveyor" .= cAppVey - <*> decision "private" .= cPrivate - <*> decision "lib" .= cLib - <*> decision "exe" .= cExe - <*> decision "test" .= cTest - <*> decision "bench" .= cBench - <*> lastT preludeT "prelude" .= cPrelude - <*> textArr "extensions" .= cExtensions - <*> textArr "warnings" .= cWarnings - <*> textArr "ghc-options" .= cGhcOptions - <*> textArr "gitignore" .= cGitignore - <*> lastT sourceT "stylish" .= cStylish - <*> lastT sourceT "contributing" .= cContributing - <*> anyT "noUpload" .= cNoUpload +configCodec :: TomlCodec PartialConfig +configCodec = Config + <$> Toml.last Toml.text "owner" .= cOwner + <*> Toml.last Toml.text "fullName" .= cFullName + <*> Toml.last Toml.text "email" .= cEmail + <*> Toml.last license "license" .= cLicense + <*> Toml.last ghcVerArr "ghcVersions" .= cGhcVer + <*> decision "cabal" .= cCabal + <*> decision "stack" .= cStack + <*> decision "github" .= cGitHub + <*> decision "travis" .= cTravis + <*> decision "appveyor" .= cAppVey + <*> decision "private" .= cPrivate + <*> decision "lib" .= cLib + <*> decision "exe" .= cExe + <*> decision "test" .= cTest + <*> decision "bench" .= cBench + <*> Toml.last preludeT "prelude" .= cPrelude + <*> textArr "extensions" .= cExtensions + <*> textArr "ghc-options" .= cGhcOptions + <*> textArr "gitignore" .= cGitignore + <*> Toml.last sourceT "stylish" .= cStylish + <*> Toml.last sourceT "contributing" .= cContributing + <*> Toml.any "noUpload" .= cNoUpload + <*> filesCodec "files" .= cFiles where - lastT :: (Key -> TomlCodec a) -> Key -> TomlCodec (Last a) - lastT codec = Toml.dimap getLast Last . Toml.dioptional . codec - - anyT :: Key -> TomlCodec Any - anyT = Toml.dimap (Just . getAny) (Any . fromMaybe False) . Toml.dioptional . Toml.bool - _GhcVer :: TomlBiMap GhcVer Toml.AnyValue _GhcVer = Toml._TextBy showGhcVer (maybeToRight "Wrong GHC version" . parseGhcVer) @@ -195,6 +210,8 @@ preludeT :: Key -> TomlCodec CustomPrelude preludeT = Toml.table customPreludeT + filesCodec :: Key -> TomlCodec (Map FilePath Source) + filesCodec = Toml.map (Toml.string "path") sourceCodec -- | Make sure that all the required configurations options were specified. finalise :: PartialConfig -> Validation [Text] Config @@ -216,15 +233,16 @@ <*> pure cBench <*> pure cPrelude <*> pure cExtensions - <*> pure cWarnings <*> pure cGhcOptions <*> pure cGitignore <*> pure cStylish <*> pure cContributing <*> pure cNoUpload + <*> pure cFiles where + fin :: Text -> Last a -> Validation [Text] a fin name = maybe (Failure ["Missing field: " <> name]) Success . getLast -- | Read configuration from the given file and return it in data type. loadFileConfig :: MonadIO m => FilePath -> m PartialConfig -loadFileConfig = Toml.decodeFile configT +loadFileConfig = Toml.decodeFile configCodec diff --git a/src/Summoner/CustomPrelude.hs b/src/Summoner/CustomPrelude.hs new file mode 100644 --- /dev/null +++ b/src/Summoner/CustomPrelude.hs @@ -0,0 +1,40 @@ +{- | +Copyright: (c) 2017-2019 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik + +This module implements data type for representing custom alternative preludes. +-} + +module Summoner.CustomPrelude + ( CustomPrelude (..) + , customPreludeT + ) where + +import Toml (Key, TomlCodec, (.=)) + +import Summoner.Text (moduleNameValid, packageNameValid) + +import qualified Toml + + +data CustomPrelude = CustomPrelude + { cpPackage :: !Text + , cpModule :: !Text + } deriving stock (Show, Eq) + +customPreludeT :: TomlCodec CustomPrelude +customPreludeT = CustomPrelude + <$> textWithBool packageNameValid "package" .= cpPackage + <*> textWithBool moduleNameValid "module" .= cpModule + +-- | Codec for text values. +textWithBool :: (Text -> Bool) -> Key -> TomlCodec Text +textWithBool p = Toml.textBy id validateText + where + validateText :: Text -> Either Text Text + validateText s = + if p s + then Right s + else Left "Given Text doesn't pass the validation" +{-# INLINE textWithBool #-} diff --git a/src/Summoner/Decision.hs b/src/Summoner/Decision.hs --- a/src/Summoner/Decision.hs +++ b/src/Summoner/Decision.hs @@ -1,5 +1,11 @@ --- | Decision data type. +{- | +Copyright: (c) 2017-2019 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik +Decision data type. +-} + module Summoner.Decision ( Decision (..) , decisionToBool @@ -12,8 +18,11 @@ -- | Used for detecting the user decision during CLI input. -data Decision = Idk | Nop | Yes - deriving (Show, Eq, Enum, Bounded, Generic) +data Decision + = Idk + | Nop + | Yes + deriving stock (Show, Eq, Enum, Bounded, Generic) instance Semigroup Decision where (<>) :: Decision -> Decision -> Decision diff --git a/src/Summoner/Default.hs b/src/Summoner/Default.hs --- a/src/Summoner/Default.hs +++ b/src/Summoner/Default.hs @@ -1,5 +1,11 @@ --- | This module contains some default values to use. +{- | +Copyright: (c) 2017-2019 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik +This module contains some default values to use. +-} + module Summoner.Default ( defaultGHC , defaultCabal @@ -15,9 +21,6 @@ import Summoner.GhcVer (GhcVer) ----------------------------------------------------------------------------- --- Default Settings ----------------------------------------------------------------------------- -- | Default GHC version is the latest available. defaultGHC :: GhcVer diff --git a/src/Summoner/GhcVer.hs b/src/Summoner/GhcVer.hs --- a/src/Summoner/GhcVer.hs +++ b/src/Summoner/GhcVer.hs @@ -1,47 +1,52 @@ -{- | Contains data type for GHC versions supported by Summoner +{- | +Copyright: (c) 2017-2019 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik + +Contains data type for GHC versions supported by Summoner and some useful functions for manipulation with them. -} module Summoner.GhcVer ( GhcVer (..) + , GhcMeta (..) , Pvp (..) , showGhcVer , parseGhcVer , latestLts , baseVer , cabalBaseVersions + , ghcTable , oldGhcs ) where import Data.List (maximum, minimum) +import Relude.Extra.Enum (inverseMap, universe) import qualified Text.Show as Show +import qualified Data.Text as T -- | Represents some selected set of GHC versions. data GhcVer = Ghc7103 - | Ghc801 | Ghc802 | Ghc822 - | Ghc843 | Ghc844 - | Ghc863 - | Ghc864 - deriving (Eq, Ord, Show, Enum, Bounded) + | Ghc865 + | Ghc881 + deriving stock (Eq, Ord, Show, Enum, Bounded) -- | Converts 'GhcVer' into dot-separated string. showGhcVer :: GhcVer -> Text showGhcVer = \case Ghc7103 -> "7.10.3" - Ghc801 -> "8.0.1" Ghc802 -> "8.0.2" Ghc822 -> "8.2.2" - Ghc843 -> "8.4.3" Ghc844 -> "8.4.4" - Ghc863 -> "8.6.3" - Ghc864 -> "8.6.4" + Ghc865 -> "8.6.5" + Ghc881 -> "8.8.1" -- | These are old GHC versions that are not working with default GHC versions when using Stack. oldGhcs :: [GhcVer] @@ -53,14 +58,12 @@ -- | Returns latest known LTS resolver for all GHC versions except default one. latestLts :: GhcVer -> Text latestLts = \case - Ghc7103 -> "6.35" - Ghc801 -> "7.24" - Ghc802 -> "9.21" - Ghc822 -> "11.22" - Ghc843 -> "12.14" - Ghc844 -> "12.26" - Ghc863 -> "13.11" - Ghc864 -> "13.16" + Ghc7103 -> "lts-6.35" + Ghc802 -> "lts-9.21" + Ghc822 -> "lts-11.22" + Ghc844 -> "lts-12.26" + Ghc865 -> "lts-14.18" + Ghc881 -> "nightly-2019-12-25" -- | Represents PVP versioning (4 numbers). data Pvp = Pvp @@ -78,13 +81,11 @@ baseVerPvp :: GhcVer -> Pvp baseVerPvp = \case Ghc7103 -> Pvp 4 8 0 2 - Ghc801 -> Pvp 4 9 0 0 Ghc802 -> Pvp 4 9 1 0 Ghc822 -> Pvp 4 10 1 0 - Ghc843 -> Pvp 4 11 1 0 Ghc844 -> Pvp 4 11 1 0 - Ghc863 -> Pvp 4 12 0 0 - Ghc864 -> Pvp 4 12 0 0 + Ghc865 -> Pvp 4 12 0 0 + Ghc881 -> Pvp 4 13 0 0 -- | Returns corresponding @base@ version of the given GHC version. baseVer :: GhcVer -> Text @@ -107,3 +108,40 @@ upperBound :: Text upperBound = let Pvp{..} = baseVerPvp $ maximum ghcs in show pvpFirst <> "." <> show (pvpSecond + 1) + +-- | Data type to keep meta information for every 'GhcVer'. +data GhcMeta = GhcMeta + { gmGhc :: !Text + , gmBase :: !Text + , gmResolver :: !Text + } + +-- | Create corresponding 'GhcMeta' from the given 'GhcVer'. +toGhcMeta :: GhcVer -> GhcMeta +toGhcMeta ghcVer = GhcMeta + { gmGhc = "GHC-" <> showGhcVer ghcVer + , gmBase = "base-" <> baseVer ghcVer + , gmResolver = latestLts ghcVer + } + +ghcTable :: [Text] +ghcTable = map (formatGhcMeta . toGhcMeta) universe + +{- Formats 'GhcMeta' in a special way. +It aligns the meta to the left, filling on the right with the spaces. + +As the pad number it takes the maximum possible length of the data manually. + +Example: + +@ +GHC-8.6.5 base-4.12.0.0 lts-14.17 +@ +-} +formatGhcMeta :: GhcMeta -> Text +formatGhcMeta GhcMeta{..} = + T.justifyLeft 12 ' ' gmGhc + <> " " + <> T.justifyLeft 14 ' ' gmBase + <> " " + <> T.justifyLeft 18 ' ' gmResolver diff --git a/src/Summoner/License.hs b/src/Summoner/License.hs --- a/src/Summoner/License.hs +++ b/src/Summoner/License.hs @@ -1,6 +1,12 @@ --- | Data types that represent license names and license content and functions --- to work with them. +{- | +Copyright: (c) 2017-2019 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik +Data types that represent license names and license content and functions +to work with them. +-} + module Summoner.License ( LicenseName(..) , License(..) @@ -14,9 +20,11 @@ ) where import Data.Aeson (FromJSON (..), decodeStrict, withObject, (.:)) -import Data.ByteString.Char8 (pack) -import System.Process (readProcess) +import Relude.Extra.Enum (inverseMap) +import Shellmet (($|)) +import Summoner.Ansi (errorMessage) + import qualified Data.Text as T import qualified Text.Show as TS @@ -34,7 +42,7 @@ | Apache20 | MPL20 | None - deriving (Eq, Ord, Enum, Bounded, Generic) + deriving stock (Eq, Ord, Enum, Bounded, Generic) instance Show LicenseName where show MIT = "MIT" @@ -49,8 +57,10 @@ show MPL20 = "MPL-2.0" show None = "None" -newtype License = License { unLicense :: Text } - deriving (IsString, Show, Generic) +newtype License = License + { unLicense :: Text + } deriving stock (Show, Generic) + deriving newtype (IsString) instance FromJSON License where parseJSON = withObject "License" $ \o -> License <$> o .: "body" @@ -81,10 +91,11 @@ -- | Replaces name/year placeholders with the actual data. customizeLicense :: LicenseName -> License -> Text -> Text -> License customizeLicense l license@(License licenseText) nm year - | l `elem` [MIT, BSD2, BSD3] = License updateLicenseText + | l `elem` [MIT, BSD2, BSD3] = License updatedLicenseText | otherwise = license where - updateLicenseText = + updatedLicenseText :: Text + updatedLicenseText = let (beforeY, withY) = T.span (/= '[') licenseText afterY = T.tail $ T.dropWhile (/= ']') withY (beforeN, withN) = T.span (/= '[') afterY @@ -95,9 +106,16 @@ fetchLicense None = pure $ License $ licenseShortDesc None fetchLicense name = do let licenseLink = "https://api.github.com/licenses/" <> githubLicenseQueryNames name - licenseJson <- readProcess - "curl" [ toString licenseLink, "-H", "Accept: application/vnd.github.drax-preview+json"] "" - pure $ fromMaybe (error "Broken predefined license list") (decodeStrict $ pack licenseJson) + licenseJson <- "curl" $| + [ licenseLink + , "-H" + , "Accept: application/vnd.github.drax-preview+json" + ] + + whenNothing (decodeStrict @License $ encodeUtf8 licenseJson) $ do + errorMessage $ "Error downloading license: " <> show name + putTextLn $ "Fetched content:\n" <> licenseJson + exitFailure -- | Show short information for the 'LicenseName'. licenseShortDesc :: LicenseName -> Text diff --git a/src/Summoner/Process.hs b/src/Summoner/Process.hs deleted file mode 100644 --- a/src/Summoner/Process.hs +++ /dev/null @@ -1,23 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} - -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeFamilies #-} - --- | This module contains various function to work with commands. -module Summoner.Process - ( deleteFile - ) where - -import Control.Exception (catch) -import System.Directory (removeFile) - -import Summoner.Ansi (errorMessage) - - --- | Delete file, but just print a message if delete fails and continue instead of raising an error. -deleteFile :: FilePath -> IO () -deleteFile file = removeFile file `catch` printError - where - printError :: SomeException -> IO () - printError e = errorMessage $ "Could not delete file '" - <> toText file <> "'. " <> toText (displayException e) diff --git a/src/Summoner/Project.hs b/src/Summoner/Project.hs --- a/src/Summoner/Project.hs +++ b/src/Summoner/Project.hs @@ -1,36 +1,46 @@ {-# LANGUAGE QuasiQuotes #-} --- | This module introduces functions for the project creation. +{- | +Copyright: (c) 2017-2019 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik +This module introduces functions for the project creation. +-} + module Summoner.Project ( generateProject , initializeProject + , fetchSources ) where import Data.List (intersect) import NeatInterpolation (text) +import Relude.Extra.Enum (universe) import Shellmet () import System.Directory (setCurrentDirectory) import Summoner.Ansi (Color (Green), beautyPrint, bold, errorMessage, infoMessage, setColor, skipMessage, successMessage, warningMessage) import Summoner.Config (Config, ConfigP (..)) +import Summoner.CustomPrelude (CustomPrelude (..)) import Summoner.Decision (Decision (..), decisionToBool) import Summoner.Default (currentYear, defaultDescription, defaultGHC) import Summoner.GhcVer (oldGhcs, parseGhcVer, showGhcVer) import Summoner.License (LicenseName (..), customizeLicense, fetchLicense, licenseShortDesc, parseLicenseName) -import Summoner.Process () import Summoner.Question (YesNoPrompt (..), checkUniqueName, choose, falseMessage, mkDefaultYesNoPrompt, query, queryDef, queryManyRepeatOnFail, - targetMessageWithText, trueMessage) -import Summoner.Settings (CustomPrelude (..), Settings (..)) -import Summoner.Source (fetchSource) + queryWithPredicate, targetMessageWithText, trueMessage) +import Summoner.Settings (Settings (..)) +import Summoner.Source (Source, fetchSource) import Summoner.Template (createProjectTemplate) -import Summoner.Text (intercalateMap, packageToModule) -import Summoner.Tree (showBoldTree, traverseTree) +import Summoner.Text (intercalateMap, moduleNameValid, packageNameValid, packageToModule) +import Summoner.Tree (TreeFs, pathToTree, showBoldTree, traverseTree) +import qualified Data.Map.Strict as Map + -- | Generate the project. generateProject :: Bool -- ^ @offline@ mode option @@ -38,9 +48,6 @@ -> Config -- ^ Given configurations. -> IO () generateProject isOffline projectName Config{..} = do - unless (null cWarnings) $ - warningMessage "Please, rename 'warnings' field if you use one, it will be removed in the very next release. Use 'ghc-options' instead." - settingsRepo <- checkUniqueName projectName -- decide cabal stack or both (settingsCabal, settingsStack) <- getCabalStack (cCabal, cStack) @@ -93,7 +100,7 @@ Just _ -> "base-noprelude" let settingsExtensions = cExtensions - let settingsGhcOptions = cWarnings ++ cGhcOptions + let settingsGhcOptions = cGhcOptions let settingsGitignore = cGitignore @@ -111,10 +118,18 @@ when (oldGhcIncluded && settingsStack && settingsTravis) $ warningMessage "Old GHC versions won't be included into Stack matrix at Travis CI because of the Stack issue with newer Cabal versions." - let fetchLast = maybe (pure Nothing) (fetchSource isOffline) . getLast - settingsStylish <- fetchLast cStylish - settingsContributing <- fetchLast cContributing + let fetchLast :: Text -> Last Source -> IO (Maybe Text) + fetchLast option (Last mSource) = case mSource of + Nothing -> pure Nothing + Just source -> do + let msg = [text|The option '${option}' is deprecated. Use 'files' instead.|] + warningMessage msg + fetchSource isOffline source + settingsStylish <- fetchLast "stylish.{url,file,link}" cStylish + settingsContributing <- fetchLast "contributing.{url,file,link}" cContributing + settingsFiles <- fetchSources isOffline cFiles + -- Create project data from all variables in scope -- and make a project from it. initializeProject Settings{..} @@ -156,10 +171,20 @@ getPrelude :: IO (Maybe CustomPrelude) getPrelude = case cPrelude of Last Nothing -> do - p <- query "Custom prelude package (leave empty if no custom prelude is needed): " + p <- queryWithPredicate + "Custom prelude package (leave empty if no custom prelude is needed): " + [] + "Name can contain letters/numbers/'-'" + packageNameValid if p == "" then Nothing <$ skipMessage "No custom prelude will be used in the project" else do - m <- queryDef "Custom prelude module: " (packageToModule p) + let defModule = packageToModule p + input <- queryWithPredicate + "Custom prelude module: " + [defModule] + "Name can contain dot-separated capitalized letter/numeral fragments. Ex: This.Is.Valid1" + moduleNameValid + let m = if input == "" then defModule else input successMessage $ "Custom prelude " <> p <> " will be used in the project" pure $ Just $ CustomPrelude p m Last prelude@(Just (CustomPrelude p _)) -> @@ -191,6 +216,20 @@ createProjectDirectory settings when settingsGitHub $ doGithubCommands settings beautyPrint [bold, setColor Green] "\nJob's done\n" + +{- | This function fetches contents of extra file sources. +-} +fetchSources :: Bool -> Map FilePath Source -> IO [TreeFs] +fetchSources isOffline = mapMaybeM sourceToTree . Map.toList + where + sourceToTree :: (FilePath, Source) -> IO (Maybe TreeFs) + sourceToTree (path, source) = do + infoMessage $ "Fetching content of the extra file: " <> toText path + fetchSource isOffline source >>= \case + Nothing -> do + errorMessage $ "Error fetching: " <> toText path + pure Nothing + Just content -> pure $ Just $ pathToTree path content -- | From the given 'Settings' creates the project. createProjectDirectory :: Settings -> IO () diff --git a/src/Summoner/Question.hs b/src/Summoner/Question.hs --- a/src/Summoner/Question.hs +++ b/src/Summoner/Question.hs @@ -2,8 +2,14 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} --- | This module contains function to proper questioning in terminal. +{- | +Copyright: (c) 2017-2019 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik +This module contains function to proper questioning in terminal. +-} + module Summoner.Question ( -- * Choose functions. choose @@ -16,6 +22,7 @@ -- * Queries , query + , queryWithPredicate , queryNotNull , queryDef , queryManyRepeatOnFail @@ -59,8 +66,8 @@ -} data YesNoPrompt = YesNoPrompt - { yesNoTarget :: Text -- ^ target (e.g., __TARGET will be added to the project__) - , yesNoPrompt :: Text -- ^ prompt (e.g., __PROMPT [y]/n__) + { yesNoTarget :: !Text -- ^ target (e.g., __TARGET will be added to the project__) + , yesNoPrompt :: !Text -- ^ prompt (e.g., __PROMPT [y]/n__) } {- | Build a prompt with the TARGET name only @@ -78,7 +85,9 @@ mkDefaultYesNoPrompt target = YesNoPrompt target ("Add " <> target <> "?") -- | Represents a user's answer -data Answer = Y | N +data Answer + = Y + | N -- | Parse an answer to 'Answer' yesOrNo :: Text -> Maybe Answer @@ -106,10 +115,12 @@ -> IO () printQuestion question [] = putTextLn question printQuestion question (def:rest) = do - let restSlash = T.intercalate "/" rest putStrFlush question boldDefault def - putTextLn $ "/" <> restSlash + let restSlash = T.intercalate "/" rest + if restSlash == "" + then putTextLn "" + else putTextLn $ "/" <> restSlash -- | Allows users to choose one of the given options. -- It asks the question until the appropriate answer is received. @@ -182,6 +193,20 @@ -} query :: Text -> IO Text query question = putTextLn question >> prompt + +{- | Queries for the answer that should satisfy the given predicate, or be empty. +-} +queryWithPredicate :: Text -> [Text] -> Text -> (Text -> Bool) -> IO Text +queryWithPredicate question options instruction p = loop + where + loop :: IO Text + loop = do + printQuestion question options + beautyPrint [italic] $ instruction <> "\n" + input <- prompt + if input /= "" && not (p input) + then errorMessage ("'" <> input <> "' doesn't satisfy the requirements.") >> loop + else pure input -- | Queries for an non-empty answer. diff --git a/src/Summoner/Settings.hs b/src/Summoner/Settings.hs --- a/src/Summoner/Settings.hs +++ b/src/Summoner/Settings.hs @@ -1,32 +1,27 @@ +{- | +Copyright: (c) 2017-2019 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik + +Complete settings required for the project creation. +-} + module Summoner.Settings ( Settings (..) - , CustomPrelude (..) - , customPreludeT - , Tool (..) , showTool , parseTool ) where -import Toml (TomlCodec, (.=)) +import Relude.Extra.Enum (inverseMap) +import Summoner.CustomPrelude (CustomPrelude) import Summoner.GhcVer (GhcVer) import Summoner.License (License, LicenseName) - -import qualified Toml +import Summoner.Tree (TreeFs) -data CustomPrelude = CustomPrelude - { cpPackage :: Text - , cpModule :: Text - } deriving (Show, Eq) - -customPreludeT :: TomlCodec CustomPrelude -customPreludeT = CustomPrelude - <$> Toml.text "package" .= cpPackage - <*> Toml.text "module" .= cpModule - -- | Data needed for project creation. data Settings = Settings { settingsRepo :: !Text -- ^ repository name @@ -57,13 +52,14 @@ , settingsStylish :: !(Maybe Text) -- ^ @.stylish-haskell.yaml@ file , settingsContributing :: !(Maybe Text) -- ^ @CONTRIBUTING.md@ file , settingsNoUpload :: !Bool -- ^ do not upload to GitHub - } deriving (Show) + , settingsFiles :: ![TreeFs] -- ^ Tree nodes of extra files + } deriving stock (Show) -- | Enum for supported build tools. data Tool = Cabal | Stack - deriving (Show, Eq, Enum, Bounded) + deriving stock (Show, Eq, Enum, Bounded) -- | Show 'Tool' in lowercase. showTool :: Tool -> Text diff --git a/src/Summoner/Source.hs b/src/Summoner/Source.hs --- a/src/Summoner/Source.hs +++ b/src/Summoner/Source.hs @@ -1,14 +1,20 @@ -{-# LANGUAGE QuasiQuotes #-} +{- | +Copyright: (c) 2017-2019 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik +This module contains the 'Source' data that describes how to fetch custom files. +-} + module Summoner.Source ( Source (..) , sourceT + , sourceCodec , fetchSource ) where import Control.Arrow ((>>>)) import Control.Exception (catch) -import NeatInterpolation (text) import System.Process (readProcess) import Toml (Key, TomlBiMap, TomlBiMapError (..), TomlCodec) @@ -16,57 +22,79 @@ import qualified Toml + +-- | Type of the source resource. data Source - -- | URL link to the source file. - = Url Text - -- | File path to the local source file. - | File FilePath - -- | Link to external file. - | Link Text - deriving (Show, Eq) + {- | URL link to the source file. Such files will be downloaded by URL. But + they are ingored in the @offline@ mode. + -} + = Url !Text + {- | File path to the local source file. + -} + | Local !FilePath + + {- | Raw file text content. + -} + | Raw !Text + deriving stock (Show, Eq) + showSource :: Source -> Text showSource = \case - Url _ -> "Url" - File _ -> "File" - Link _ -> "Link" + Url _ -> "Url" + Local _ -> "Local" + Raw _ -> "Raw" +-- TODO: return Maybe matchUrl :: Source -> Either TomlBiMapError Text matchUrl (Url url) = Right url matchUrl e = Left $ WrongConstructor "Url" $ showSource e -matchFile :: Source -> Either TomlBiMapError FilePath -matchFile (File file) = Right file -matchFile e = Left $ WrongConstructor "File" $ showSource e +-- TODO: return Maybe +matchLocal :: Source -> Either TomlBiMapError FilePath +matchLocal (Local file) = Right file +matchLocal e = Left $ WrongConstructor "Local" $ showSource e -matchLink :: Source -> Either TomlBiMapError Text -matchLink (Link link) = Right link -matchLink e = Left $ WrongConstructor "Link" $ showSource e +-- TODO: return Maybe +matchRaw :: Source -> Either TomlBiMapError Text +matchRaw (Raw raw) = Right raw +matchRaw e = Left $ WrongConstructor "Raw" $ showSource e +-- DEPRECATED: To be removed in 2.0 sourceT :: Key -> TomlCodec Source -sourceT nm = Toml.match (_Url >>> Toml._Text) (nm <> "url") - <|> Toml.match (_File >>> Toml._String) (nm <> "file") - <|> Toml.match (_Link >>> Toml._Text) (nm <> "link") +sourceT nm = Toml.match (_Url >>> Toml._Text) (nm <> "url") + <|> Toml.match (_Local >>> Toml._String) (nm <> "Local") + <|> Toml.match (_Raw >>> Toml._Text) (nm <> "raw") where _Url :: TomlBiMap Source Text _Url = Toml.prism Url matchUrl - _File :: TomlBiMap Source FilePath - _File = Toml.prism File matchFile + _Local :: TomlBiMap Source FilePath + _Local = Toml.prism Local matchLocal - _Link :: TomlBiMap Source Text - _Link = Toml.prism Link matchLink + _Raw :: TomlBiMap Source Text + _Raw = Toml.prism Raw matchRaw +{- | This 'TomlCodec' is used in the @files@ field of config. It decodes +corresponding constructor from the top-level key. +-} +sourceCodec :: TomlCodec Source +sourceCodec = asum + [ Toml.dimatch (rightToMaybe . matchUrl) Url (Toml.text "url") + , Toml.dimatch (rightToMaybe . matchLocal) Local (Toml.string "local") + , Toml.dimatch (rightToMaybe . matchRaw) Raw (Toml.text "raw") + ] + fetchSource :: Bool -> Source -> IO (Maybe Text) fetchSource isOffline = \case - File path -> catch (Just <$> readFileText path) (fileError path) - Url url -> if isOffline + Local path -> catch (Just <$> readFileText path) (localError path) + Url url -> if isOffline then Nothing <$ infoMessage ("Ignoring fetching from URL in offline mode from source: " <> url) else fetchUrl url `catch` urlError url - Link link -> putLink link + Raw raw -> pure $ Just raw where - fileError :: FilePath -> SomeException -> IO (Maybe Text) - fileError path _ = errorMessage ("Couldn't read file: " <> toText path) + localError :: FilePath -> SomeException -> IO (Maybe Text) + localError path _ = errorMessage ("Couldn't read file: " <> toText path) >> pure Nothing urlError :: Text -> SomeException -> IO (Maybe Text) @@ -75,6 +103,3 @@ fetchUrl :: Text -> IO (Maybe Text) fetchUrl url = Just . toText <$> readProcess "curl" [toString url] "" - - putLink :: Text -> IO (Maybe Text) - putLink link = pure $ Just [text|See full content of the file [here]($link)|] diff --git a/src/Summoner/Template.hs b/src/Summoner/Template.hs --- a/src/Summoner/Template.hs +++ b/src/Summoner/Template.hs @@ -1,5 +1,11 @@ --- | This module contains functions for stack template creation. +{- | +Copyright: (c) 2017-2019 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik +This module contains functions for the Haskell project template creation. +-} + module Summoner.Template ( createProjectTemplate ) where @@ -9,23 +15,31 @@ import Summoner.Template.Doc (docFiles) import Summoner.Template.GitHub (gitHubFiles) import Summoner.Template.Haskell (haskellFiles) +import Summoner.Template.Mempty (memptyIfFalse) import Summoner.Template.Stack (stackFiles) -import Summoner.Tree (TreeFs (..)) +import Summoner.Tree (TreeFs (..), insertTree) -- | Creating tree structure of the project. createProjectTemplate :: Settings -> TreeFs -createProjectTemplate settings@Settings{..} = Dir (toString settingsRepo) $ concat - [ cabal - , stack - , haskell - , docs - , gitHub - ] +createProjectTemplate settings@Settings{..} = Dir + (toString settingsRepo) + (foldr insertTree generatedFiles settingsFiles) where + generatedFiles :: [TreeFs] + generatedFiles = concat + [ cabal + , stack + , haskell + , docs + , gitHub + ] + cabal, stack :: [TreeFs] - cabal = [cabalFile settings] - stack = memptyIfFalse settingsStack $ stackFiles settings -- TODO: write more elegant + cabal = [cabalFile settings] + stack = memptyIfFalse settingsStack $ stackFiles settings + + haskell, docs, gitHub :: [TreeFs] haskell = haskellFiles settings docs = docFiles settings gitHub = gitHubFiles settings diff --git a/src/Summoner/Template/Cabal.hs b/src/Summoner/Template/Cabal.hs --- a/src/Summoner/Template/Cabal.hs +++ b/src/Summoner/Template/Cabal.hs @@ -1,21 +1,32 @@ {-# LANGUAGE QuasiQuotes #-} +{- | +Copyright: (c) 2017-2019 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik + +@.cabal@ file template. +-} + module Summoner.Template.Cabal ( cabalFile ) where import NeatInterpolation (text) +import Summoner.CustomPrelude (CustomPrelude (..)) import Summoner.Default (defaultCabal) import Summoner.GhcVer (GhcVer (..), cabalBaseVersions, showGhcVer) import Summoner.License (LicenseName (..), cabalLicense) -import Summoner.Settings (CustomPrelude (..), Settings (..)) -import Summoner.Text (intercalateMap, packageToModule) +import Summoner.Settings (Settings (..)) +import Summoner.Template.Mempty (memptyIfFalse) +import Summoner.Text (endLine, intercalateMap, packageToModule) import Summoner.Tree (TreeFs (..)) import qualified Data.Text as T +-- | Creates a `.cabal` file from the given 'Settings'. cabalFile :: Settings -> TreeFs cabalFile Settings{..} = File (toString settingsRepo ++ ".cabal") cabalFileContent where @@ -34,7 +45,7 @@ cabalHeader = unlines $ [ "cabal-version: " <> defaultCabal , "name: " <> settingsRepo - , "version: 0.0.0" + , "version: 0.0.0.0" , "synopsis: " <> settingsDescription , "description: " <> settingsDescription ] ++ [ "homepage: " <> githubUrl | settingsGitHub ] ++ @@ -60,7 +71,10 @@ libModuleName = packageToModule settingsRepo testedGhcs :: Text - testedGhcs = intercalateMap ", " (mappend "GHC == " . showGhcVer) settingsTestedVersions + testedGhcs = intercalateMap + ("\n" <> T.replicate 19 " " <> ", ") + (mappend "GHC == " . showGhcVer) + settingsTestedVersions sourceRepository :: Text sourceRepository = @@ -188,15 +202,17 @@ versionGhcOptions :: Text versionGhcOptions - = memptyIfFalse (settingsTestedVersions `hasLeast` Ghc801) + = memptyIfFalse (settingsTestedVersions `hasLeast` Ghc802) "-Wredundant-constraints\n" <> memptyIfFalse (settingsTestedVersions `hasLeast` Ghc822) "-fhide-source-paths\n" - <> memptyIfFalse (settingsTestedVersions `hasLeast` Ghc843) + <> memptyIfFalse (settingsTestedVersions `hasLeast` Ghc844) [text| -Wmissing-export-lists -Wpartial-fields |] + <> memptyIfFalse (settingsTestedVersions `hasLeast` Ghc881) + "-Wmissing-deriving-strategies\n" where hasLeast :: [GhcVer] -> GhcVer -> Bool hasLeast list el = all (>= el) list diff --git a/src/Summoner/Template/Doc.hs b/src/Summoner/Template/Doc.hs --- a/src/Summoner/Template/Doc.hs +++ b/src/Summoner/Template/Doc.hs @@ -1,11 +1,20 @@ -{-# LANGUAGE QuasiQuotes #-} +{- | +Copyright: (c) 2017-2019 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik +Templates for various documentation files: + +* CHANGELOG.md +* CONTRIBUTING.md +* LICENSE +* README.md +-} + module Summoner.Template.Doc ( docFiles ) where -import NeatInterpolation (text) - import Summoner.License (License (..), LicenseName (None)) import Summoner.Settings (Settings (..)) import Summoner.Tree (TreeFs (..)) @@ -27,22 +36,22 @@ licenseName = show settingsLicenseName readme :: Text - readme = T.intercalate "\n" $ + readme = unlines $ [ "# " <> settingsRepo , "" - , hackage ] - ++ [licenseBadge | hasLicense] - ++ [stackLtsBadge | settingsStack] - ++ [stackNightlyBadge | settingsStack] ++ [travisBadge | settingsTravis] ++ [appVeyorBadge | settingsAppVeyor] + ++ [hackage] + ++ [stackLtsBadge | settingsStack] + ++ [stackNightlyBadge | settingsStack] + ++ [licenseBadge | hasLicense] ++ ["" , settingsDescription ] where hackageShield :: Text = - "https://img.shields.io/hackage/v/" <> settingsRepo <> ".svg" + "https://img.shields.io/hackage/v/" <> settingsRepo <> ".svg?logo=haskell" hackageLink :: Text = "https://hackage.haskell.org/package/" <> settingsRepo hackage :: Text = makeBadge "Hackage" hackageShield hackageLink @@ -67,7 +76,7 @@ makeBadge "Stackage Nightly" stackShieldNightly stackLinkNightly travisShield :: Text = - "https://secure.travis-ci.org/" <> settingsOwner <> "/" <> settingsRepo <> ".svg" + "https://img.shields.io/travis/" <> settingsOwner <> "/" <> settingsRepo <> ".svg?logo=travis" travisLink :: Text = "https://travis-ci.org/" <> settingsOwner <> "/" <> settingsRepo travisBadge :: Text = @@ -84,22 +93,21 @@ makeBadge title shield link = "[![" <> title <> "](" <> shield <> ")](" <> link <> ")" changelog :: Text - changelog = T.stripEnd - [text| - # Changelog - - `$settingsRepo` uses [PVP Versioning][1]. - $githubLine - - 0.0.0 - ===== - - * Initially created. - - [1]: https://pvp.haskell.org - $githubFootNote - |] + changelog = unlines $ + [ "# Changelog" + , "" + , "`" <> settingsRepo <> "` uses [PVP Versioning][1]." + ] ++ + [ githubLine | settingsGitHub ] ++ + [ "" + , "## 0.0.0.0" + , "" + , "* Initially created." + , "" + , "[1]: https://pvp.haskell.org" + ] ++ + [ githubFootNote | settingsGitHub ] where - githubLine :: Text = memptyIfFalse settingsGitHub "The changelog is available [on GitHub][2]." - githubFootNote :: Text = memptyIfFalse settingsGitHub $ - "[2]: https://github.com/" <> settingsOwner <> "/" <> settingsRepo <> "/releases" + githubLine, githubFootNote :: Text + githubLine = "The changelog is available [on GitHub][2]." + githubFootNote = "[2]: https://github.com/" <> settingsOwner <> "/" <> settingsRepo <> "/releases" diff --git a/src/Summoner/Template/GitHub.hs b/src/Summoner/Template/GitHub.hs --- a/src/Summoner/Template/GitHub.hs +++ b/src/Summoner/Template/GitHub.hs @@ -1,8 +1,13 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ViewPatterns #-} -{-| This module contains template for GitHub related docs: +{-| +Copyright: (c) 2017-2019 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik +This module contains template for GitHub related docs: + * @.gitignore@ — static file with all Haskell related ignored files. * @appveyor.yml@ — Appveyor CI for Stack project only. * @.travis.yml@ — depending on the build tool and supported GHC versions @@ -12,7 +17,6 @@ track the problem: + https://github.com/commercialhaskell/stack/issues/4488 - -} module Summoner.Template.GitHub @@ -25,15 +29,17 @@ import Summoner.Default (defaultGHC) import Summoner.GhcVer (GhcVer (..), oldGhcs, showGhcVer) import Summoner.Settings (Settings (..)) -import Summoner.Text (tconcatMap) +import Summoner.Template.Mempty (memptyIfFalse) +import Summoner.Text (endLine, tconcatMap) import Summoner.Tree (TreeFs (..)) gitHubFiles :: Settings -> [TreeFs] -gitHubFiles Settings{..} = - [File ".gitignore" (gitignoreDefault <> gitignoreCustom) | settingsGitHub] - ++ [File ".travis.yml" travisYml | settingsTravis] - ++ [File "appveyor.yml" appVeyorYml | settingsAppVeyor] +gitHubFiles Settings{..} = concat + [ [File ".gitignore" (gitignoreDefault <> gitignoreCustom) | settingsGitHub] + , [File ".travis.yml" travisYml | settingsTravis] + , [File "appveyor.yml" appVeyorYml | settingsAppVeyor] + ] where -- default .gitignore template gitignoreDefault :: Text @@ -64,6 +70,7 @@ .HTF/ # Stack .stack-work/ + stack.yaml.lock ### IDE/support # Vim @@ -183,6 +190,8 @@ installScriptBoth = [text| install: + $hlintCheck + - | if [ -z "$$STACK_YAML" ]; then ghc --version @@ -202,15 +211,14 @@ else stack test --system-ghc fi - - # HLint check - - curl -sSL https://raw.github.com/ndmitchell/neil/master/misc/travis.sh | sh -s -- hlint . |] installScriptCabal :: Text installScriptCabal = [text| install: + $hlintCheck + - cabal new-update - cabal new-build --enable-tests --enable-benchmarks @@ -222,6 +230,8 @@ installScriptStack = [text| install: + $hlintCheck + - curl -sSL https://get.haskellstack.org/ | sh - stack --version - stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks --ghc-options=-Werror @@ -230,6 +240,13 @@ - stack test --system-ghc |] + hlintCheck :: Text + hlintCheck = + [text| + # HLint check + - curl -sSL https://raw.github.com/ndmitchell/neil/master/misc/travis.sh | sh -s -- hlint . + |] + appVeyorYml :: Text appVeyorYml = if settingsCabal @@ -237,55 +254,76 @@ else appVeyorYmlStack appVeyorYmlCabal :: Text - appVeyorYmlCabal = + appVeyorYmlCabal = let defGhc = showGhcVer defaultGHC in [text| - install: - # Using '-y' and 'refreshenv' as a workaround to: - # https://github.com/haskell/cabal/issues/3687 - - choco source add -n mistuke -s https://www.myget.org/F/mistuke/api/v2 - - choco install -y ghc --ignore-dependencies - - choco install -y cabal-head -pre - - refreshenv - # See http://help.appveyor.com/discussions/problems/6312-curl-command-not-found#comment_42195491 - # NB: Do this after refreshenv, otherwise it will be clobbered! - - set PATH=%APPDATA%\cabal\bin;C:\Program Files\Git\cmd;C:\Program Files\Git\mingw64\bin;C:\msys64\usr\bin;%PATH% - - cabal --version - - cabal %CABOPTS% new-update + clone_folder: "c:\\WORK" + clone_depth: 5 - environment: - global: - CABOPTS: "--store-dir=C:\\SR" + # Do not build feature branch with open Pull Requests + skip_branch_with_pr: true + platform: + - x86_64 + cache: - - dist-newstyle - "C:\\SR" + - dist-newstyle + environment: + global: + CABOPTS: --store-dir=C:\\SR + + matrix: + - GHCVER: $defGhc + + install: + - choco source add -n mistuke -s https://www.myget.org/F/mistuke/api/v2 + - choco install -y cabal --version 2.4.1.0 + - choco install -y ghc --version $defGhc + - refreshenv + + before_build: + - cabal --version + - ghc --version + - cabal %CABOPTS% v2-update + build_script: - - cabal %CABOPTS% new-build --enable-tests --enable-benchmarks - - cabal %CABOPTS% new-test --enable-tests + - cabal %CABOPTS% v2-build --enable-tests + - cabal %CABOPTS% v2-test --enable-tests |] -- create appveyor.yml template appVeyorYmlStack :: Text appVeyorYmlStack = [text| - build: off - - before_test: - # http://help.appveyor.com/discussions/problems/6312-curl-command-not-found - - set PATH=C:\Program Files\Git\mingw64\bin;%PATH% + clone_depth: 5 - - curl -sS -ostack.zip -L --insecure http://www.stackage.org/stack/windows-x86_64 - - 7z x stack.zip stack.exe + # Do not build feature branch with open Pull Requests + skip_branch_with_pr: true - clone_folder: "c:\\stack" environment: - global: - STACK_ROOT: "c:\\sr" + STACK_ROOT: C:\sr + STACK_VERSION: 2.1.1 + # Workaround a gnarly bug https://github.com/haskell/cabal/issues/5386 + # See: https://www.fpcomplete.com/blog/2018/06/sed-a-debugging-story + # TODO: check if it's fixed once we switch to lst-13 and GHC 8.6 + TMP: "c:\\tmp" + + matrix: + - STACK_YAML: stack.yaml + + cache: + - "%STACK_ROOT% -> %STACK_YAML%, appveyor.yml" + - ".stack-work -> %STACK_YAML%, appveyor.yml" + + install: + - choco install -y haskell-stack --version %STACK_VERSION% + - stack setup > nul + + build_script: + - stack build --test --bench --no-run-tests --no-run-benchmarks + test_script: - - stack setup > nul - # The ugly echo "" hack is to avoid complaints about 0 being an invalid file - # descriptor - - echo "" | stack --arch x86_64 --no-terminal build --bench --no-run-benchmarks --test + - stack test |] diff --git a/src/Summoner/Template/Haskell.hs b/src/Summoner/Template/Haskell.hs --- a/src/Summoner/Template/Haskell.hs +++ b/src/Summoner/Template/Haskell.hs @@ -1,12 +1,21 @@ {-# LANGUAGE QuasiQuotes #-} +{- | +Copyright: (c) 2017-2019 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik + +Templates for generated Haskell source code files. +-} + module Summoner.Template.Haskell ( haskellFiles ) where import NeatInterpolation (text) -import Summoner.Settings (CustomPrelude (..), Settings (..)) +import Summoner.CustomPrelude (CustomPrelude (..)) +import Summoner.Settings (Settings (..)) import Summoner.Text (packageToModule) import Summoner.Tree (TreeFs (..)) diff --git a/src/Summoner/Template/Mempty.hs b/src/Summoner/Template/Mempty.hs new file mode 100644 --- /dev/null +++ b/src/Summoner/Template/Mempty.hs @@ -0,0 +1,18 @@ +{- | +Copyright: (c) 2017-2019 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik + +'Monoid' utilities for templates. +-} + +module Summoner.Template.Mempty + ( memptyIfFalse + ) where + + +{- | Returns the given value in case of the given 'Bool' is 'True'. +Otherwise, it returns 'mempty'. +-} +memptyIfFalse :: Monoid m => Bool -> m -> m +memptyIfFalse p val = if p then val else mempty diff --git a/src/Summoner/Template/Script.hs b/src/Summoner/Template/Script.hs --- a/src/Summoner/Template/Script.hs +++ b/src/Summoner/Template/Script.hs @@ -1,7 +1,13 @@ {-# LANGUAGE QuasiQuotes #-} --- | File templates for @cabal@ and @stack@ scripts. +{- | +Copyright: (c) 2017-2019 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik +File templates for @cabal@ and @stack@ scripts. +-} + module Summoner.Template.Script ( scriptFile ) where @@ -30,7 +36,7 @@ [text| #!/usr/bin/env stack {- stack - --resolver lts-${ltsVersion} + --resolver ${ltsVersion} script --package base -} diff --git a/src/Summoner/Template/Stack.hs b/src/Summoner/Template/Stack.hs --- a/src/Summoner/Template/Stack.hs +++ b/src/Summoner/Template/Stack.hs @@ -1,11 +1,15 @@ -{-# LANGUAGE QuasiQuotes #-} +{- | +Copyright: (c) 2017-2019 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik +Templates for @stack.yaml@ files. +-} + module Summoner.Template.Stack ( stackFiles ) where -import NeatInterpolation (text) - import Summoner.Default (defaultGHC) import Summoner.GhcVer (GhcVer (..), baseVer, latestLts, showGhcVer) import Summoner.Settings (Settings (..)) @@ -18,7 +22,7 @@ -- create @stack.yaml@ file with LTS corresponding to specified ghc version createStackYaml :: GhcVer -> TreeFs createStackYaml ghcV = File (toString $ "stack" <> ver <> ".yaml") - $ "resolver: lts-" <> latestLts ghcV <> extraDeps <> ghcOpts + $ "resolver: " <> latestLts ghcV <> extraDeps where ver :: Text ver = if ghcV == defaultGHC @@ -29,12 +33,3 @@ extraDeps = case settingsPrelude of Nothing -> "" Just _ -> "\n\nextra-deps: [base-noprelude-" <> baseVer ghcV <> "]" - - ghcOpts :: Text - ghcOpts = memptyIfFalse (ghcV > Ghc802) - [text| - $endLine - - ghc-options: - "$$locals": -fhide-source-paths - |] diff --git a/src/Summoner/Text.hs b/src/Summoner/Text.hs --- a/src/Summoner/Text.hs +++ b/src/Summoner/Text.hs @@ -1,5 +1,16 @@ +{- | +Copyright: (c) 2017-2019 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik + +Various helpful functions to work with 'Text' +-} + module Summoner.Text - ( packageToModule + ( endLine + , packageToModule + , packageNameValid + , moduleNameValid , intercalateMap , headToUpper , tconcatMap @@ -8,10 +19,35 @@ import qualified Data.Char as C import qualified Data.Text as T + +-- | Endline symbol to use with @neat-interpolation@. +endLine :: Text +endLine = "\n" + -- | Creates module name from the name of the package -- Ex: @my-lovely-project@ — @MyLovelyProject@ packageToModule :: Text -> Text packageToModule = tconcatMap headToUpper . T.splitOn "-" + +-- | Decides whether the given text is a valid package name. Spec is here: +-- https://www.haskell.org/cabal/users-guide/developing-packages.html#package-names-and-versions +packageNameValid :: Text -> Bool +packageNameValid = T.all (\c -> c == '-' || C.isAlphaNum c) + +{- | Validate module name. It should be in the following formatTriple + +@ +Part1[.PartN] +@ +-} +moduleNameValid :: Text -> Bool +moduleNameValid = all isValidFragment . T.split (== '.') + where + isValidFragment :: Text -> Bool + isValidFragment s = + s /= "" + && T.all C.isAlphaNum s + && C.isUpper (T.head s) -- | Converts every element of list into 'Text' and then joins every element -- into single 'Text' like 'T.intercalate'. diff --git a/src/Summoner/Tree.hs b/src/Summoner/Tree.hs --- a/src/Summoner/Tree.hs +++ b/src/Summoner/Tree.hs @@ -1,13 +1,24 @@ {-# LANGUAGE ViewPatterns #-} +{- | +Copyright: (c) 2017-2019 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik + +Data type for representing filesystem structure via tree. +-} + module Summoner.Tree ( TreeFs (..) , traverseTree + , pathToTree + , insertTree , showBoldTree , showTree ) where import System.Directory (createDirectoryIfMissing, withCurrentDirectory) +import System.FilePath (splitDirectories) import Summoner.Ansi (boldCode, resetCode) @@ -18,16 +29,58 @@ = Dir FilePath [TreeFs] -- | File name (relative) and file content | File FilePath Text - deriving (Generic, Show, Eq, Ord) + deriving stock (Generic, Show, Eq, Ord) -- | Walks through directory tree and write file contents, creating all -- intermediate directories. traverseTree :: TreeFs -> IO () +traverseTree (File name content) = writeFileText name content traverseTree (Dir name children) = do createDirectoryIfMissing False name withCurrentDirectory name $ for_ children traverseTree -traverseTree (File name content) = writeFileText name content +{- | This function converts a string file path to the tree structure. + +For a path like this: @".github/workflow/ci.yml"@ + +This function produces the following tree: + +@ +.github/ +└── workflow/ + └── ci.yml +@ +-} +pathToTree :: FilePath -> Text -> TreeFs +pathToTree path content = + let pathParts = splitDirectories path + in case pathParts of + [] -> Dir path [] -- shouldn't happen + x:xs -> go x xs + where + go :: FilePath -> [FilePath] -> TreeFs + go p [] = File p content + go p (x:xs) = Dir p [go x xs] + +{- | This functions inserts given 'TreeFs' node into the list of existing +'TreeFs' nodes. The behavior of this function is the following: + +1. It merges duplicating directories. +2. It overrides existing 'File' with the given 'TreeFs' in case of duplicates. +-} +insertTree :: TreeFs -> [TreeFs] -> [TreeFs] +insertTree node [] = [node] +insertTree node (x:xs) = case (node, x) of + (Dir _ _, File _ _) -> x : insertTree node xs + (File _ _, Dir _ _) -> x : insertTree node xs + (File nodePath _, File curPath _) + | nodePath == curPath -> node : xs + | otherwise -> x : insertTree node xs + (Dir nodePath nodeChildren, Dir curPath curChildren) + | nodePath == curPath -> + Dir nodePath (foldr insertTree curChildren nodeChildren) : xs + | otherwise -> x : insertTree node xs + -- | Pretty shows the directory tree content. showBoldTree :: TreeFs -> Text showBoldTree = showTree True @@ -61,7 +114,7 @@ let arms = replicate (length children - 1) "├" <> ["└"] in concat (zipWith (showOne leader "── ") arms children) --- For sorting in alphabetic order. +-- | Extract 'TreeFs' path. Used for sorting in alphabetic order. treeFp :: TreeFs -> FilePath treeFp (Dir fp _) = fp treeFp (File fp _) = fp diff --git a/summoner.cabal b/summoner.cabal --- a/summoner.cabal +++ b/summoner.cabal @@ -1,6 +1,6 @@ -cabal-version: 2.0 +cabal-version: 2.4 name: summoner -version: 1.3.0.1 +version: 1.4.0.0 synopsis: Tool for scaffolding fully configured batteries-included production-level Haskell projects. description: Tool for scaffolding fully configured batteries-included production-level Haskell projects. See [README.md](https://github.com/kowainik/summoner#-summoner) for details. @@ -8,9 +8,9 @@ bug-reports: https://github.com/kowainik/summoner/issues license: MPL-2.0 license-file: LICENSE -author: Kowainik -maintainer: xrom.xkov@gmail.com -copyright: 2018-2019 Kowainik +author: Veronika Romashkina, Dmitrii Kovanikov +maintainer: Kowainik +copyright: 2018-2020 Kowainik category: CLI, CLI Tool, Development build-type: Simple stability: stable @@ -18,7 +18,8 @@ , CHANGELOG.md tested-with: GHC == 8.2.2 , GHC == 8.4.4 - , GHC == 8.6.4 + , GHC == 8.6.5 + , GHC == 8.8.1 extra-source-files: test/golden/fullProject/*.yml test/golden/fullProject/*.yaml @@ -44,17 +45,52 @@ type: git location: git@github.com:kowainik/summoner.git +common common-options + build-depends: base >= 4.10 && < 4.14 + , relude ^>= 0.6.0.0 + + mixins: base hiding (Prelude) + , relude (Relude as Prelude + , Relude.Extra.Enum + , Relude.Extra.Validation + , Relude.Unsafe + ) + + ghc-options: -Wall + -Wincomplete-uni-patterns + -Wincomplete-record-updates + -Wcompat + -Widentities + -Wredundant-constraints + -fhide-source-paths + if impl(ghc >= 8.8.1) + ghc-options: -Wmissing-deriving-strategies + -Werror=missing-deriving-strategies + + default-extensions: DeriveGeneric + DerivingStrategies + GeneralizedNewtypeDeriving + InstanceSigs + LambdaCase + OverloadedStrings + RecordWildCards + ScopedTypeVariables + TypeApplications + + default-language: Haskell2010 + library + import: common-options hs-source-dirs: src exposed-modules: Summoner Summoner.Ansi Summoner.CLI Summoner.Config + Summoner.CustomPrelude Summoner.Decision Summoner.Default Summoner.GhcVer Summoner.License - Summoner.Process Summoner.Project Summoner.Question Summoner.Settings @@ -64,6 +100,7 @@ Summoner.Template.Doc Summoner.Template.GitHub Summoner.Template.Haskell + Summoner.Template.Mempty Summoner.Template.Script Summoner.Template.Stack Summoner.Text @@ -71,100 +108,57 @@ autogen-modules: Paths_summoner other-modules: Paths_summoner - Prelude - build-depends: base-noprelude >= 4.10 && < 4.13 - , aeson >= 1.2.4.0 && < 1.5 - , ansi-terminal >= 0.8 && < 0.10 + build-depends: aeson >= 1.2.4.0 && < 1.5 + , ansi-terminal >= 0.8 && < 0.11 , bytestring ^>= 0.10.8.2 + , containers , directory ^>= 1.3.0.2 , filepath ^>= 1.4.1.2 - , generic-deriving ^>= 1.12.2 + , generic-deriving >= 1.12.2 && < 1.14 , gitrev ^>= 1.3.1 , neat-interpolation ^>= 0.3.2.2 - , optparse-applicative ^>= 0.14.2.0 + , optparse-applicative ^>= 0.15 , process ^>= 1.6.1.0 - , relude ^>= 0.5.0 - , shellmet ^>= 0.0.1 + , shellmet ^>= 0.0.3.0 , text ^>= 1.2.3.0 - , time ^>= 1.8 - , tomland ^>= 1.0 - - ghc-options: -Wall - -Wincomplete-uni-patterns - -Wincomplete-record-updates - -Wcompat - -Widentities - -Wredundant-constraints - -fhide-source-paths - - default-extensions: DeriveGeneric - GeneralizedNewtypeDeriving - InstanceSigs - LambdaCase - OverloadedStrings - RecordWildCards - ScopedTypeVariables - TypeApplications - - default-language: Haskell2010 + , time >= 1.8 && < 1.10 + , tomland ^>= 1.2.1.0 executable summon + import: common-options hs-source-dirs: app main-is: Cli.hs - build-depends: base >= 4.10 && < 4.13 - , summoner + build-depends: summoner - ghc-options: -Wall - -threaded + ghc-options: -threaded -rtsopts -with-rtsopts=-N - -Wincomplete-uni-patterns - -Wincomplete-record-updates - -Wcompat - -Widentities - -Wredundant-constraints - -fhide-source-paths - default-language: Haskell2010 - test-suite summoner-test + import: common-options type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs - other-modules: Test.DecisionSpec + other-modules: Test.CustomPrelude + Test.DecisionSpec Test.Golden Test.Script + Test.Show Test.TomlSpec Test.QuestionSpec - Prelude - build-depends: base-noprelude >= 4.10 && < 4.13 - , directory + build-depends: directory , filepath - , hedgehog >= 0.5.3 && < 0.7 + , hedgehog >= 0.5.3 && < 1.1 , hspec >= 2.4.8 , neat-interpolation - , relude + , text , tomland - , tree-diff ^>= 0.0.2 + , tree-diff >= 0.0.2 && < 0.2 , summoner - - ghc-options: -Wall - -threaded + ghc-options: -threaded -rtsopts -with-rtsopts=-N - -Wincomplete-uni-patterns - -Wincomplete-record-updates - -Wcompat - -Widentities - -Wredundant-constraints - -fhide-source-paths - - default-extensions: LambdaCase - OverloadedStrings - RecordWildCards - - default-language: Haskell2010 diff --git a/test/Prelude.hs b/test/Prelude.hs deleted file mode 100644 --- a/test/Prelude.hs +++ /dev/null @@ -1,9 +0,0 @@ --- | Uses @relude@ as a default prelude. - -module Prelude - ( module Relude - , module Relude.Extra - ) where - -import Relude -import Relude.Extra.Enum as Relude.Extra (inverseMap, universe) diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -3,10 +3,12 @@ import Hedgehog (Group (..), checkParallel) import Test.Hspec (hspec) +import Test.CustomPrelude (customPreludeSpec) import Test.DecisionSpec (decisionMonoidMempty, decisionSemigroupAssoc) import Test.Golden (goldenSpec) import Test.QuestionSpec (yesNoPromptSpec) import Test.Script (scriptSpec) +import Test.Show (showCommandSpec) import Test.TomlSpec (tomlProp) @@ -15,7 +17,9 @@ hspec $ do yesNoPromptSpec scriptSpec + showCommandSpec goldenSpec + customPreludeSpec ifM (checkParallel hedgehogTests) exitSuccess exitFailure hedgehogTests :: Group diff --git a/test/Test/CustomPrelude.hs b/test/Test/CustomPrelude.hs new file mode 100644 --- /dev/null +++ b/test/Test/CustomPrelude.hs @@ -0,0 +1,35 @@ +module Test.CustomPrelude + ( customPreludeSpec + ) where + +import Test.Hspec (Spec, describe, it, shouldNotSatisfy, shouldSatisfy) + +import Summoner.Text (moduleNameValid, packageNameValid) + + +customPreludeSpec :: Spec +customPreludeSpec = do + describe "package name validation" $ do + it "validates 'package'" $ + "package" `shouldSatisfy` packageNameValid + it "validates 'package-package'" $ + "package-package" `shouldSatisfy` packageNameValid + it "should not contain symbols" $ + "package-package%" `shouldNotSatisfy` packageNameValid + it "should be one word" $ + "package -package" `shouldNotSatisfy` packageNameValid + describe "module name validation" $ do + it "one fragment" $ + "Module" `shouldSatisfy` moduleNameValid + it "several fragments" $ + "Module1.Fragment2" `shouldSatisfy` moduleNameValid + it "no trailing dot" $ + "Module1.Fragment2." `shouldNotSatisfy` moduleNameValid + it "no double dots" $ + "Module1..Fragment2" `shouldNotSatisfy` moduleNameValid + it "no lower leading letter" $ + "Module1.fragment2" `shouldNotSatisfy` moduleNameValid + it "no other Symbols" $ + "Module1.fr#agment2" `shouldNotSatisfy` moduleNameValid + it "no several words" $ + "Module1.fra gment2" `shouldNotSatisfy` moduleNameValid diff --git a/test/Test/DecisionSpec.hs b/test/Test/DecisionSpec.hs --- a/test/Test/DecisionSpec.hs +++ b/test/Test/DecisionSpec.hs @@ -1,3 +1,6 @@ +{- HLINT ignore "Monoid law, right identity" -} +{- HLINT ignore "Monoid law, left identity" -} + module Test.DecisionSpec ( decisionSemigroupAssoc , decisionMonoidMempty diff --git a/test/Test/Golden.hs b/test/Test/Golden.hs --- a/test/Test/Golden.hs +++ b/test/Test/Golden.hs @@ -80,7 +80,7 @@ , settingsIsExe = True , settingsTest = True , settingsBench = True - , settingsTestedVersions = [Ghc802, Ghc822, Ghc844, defaultGHC] + , settingsTestedVersions = [Ghc802 .. defaultGHC] , settingsBaseType = "base-noprelude" , settingsPrelude = Just $ CustomPrelude "relude" "Relude" , settingsExtensions = ["ConstraintKinds", "LambdaCase", "OverloadedStrings"] @@ -91,6 +91,10 @@ , settingsStylish = Just "This is stylish-haskell.yaml\n" , settingsContributing = Just "This is contributing guide\n" , settingsNoUpload = True + , settingsFiles = + [ File "extra.txt" "See full content of the file [here](@github)\n" + , Dir ".github" [File "CODEOWNERS" "* @chshersh @vrom911\n"] + ] } where mitLicense :: License @@ -148,6 +152,7 @@ , settingsStylish = Nothing , settingsContributing = Nothing , settingsNoUpload = True + , settingsFiles = mempty } -- Orphan instances diff --git a/test/Test/Script.hs b/test/Test/Script.hs --- a/test/Test/Script.hs +++ b/test/Test/Script.hs @@ -17,7 +17,7 @@ it "correctly creates cabal script" $ scriptFile Ghc844 Cabal `shouldBe` cabalScript it "correctly creates stack script" $ - scriptFile Ghc864 Stack `shouldBe` stackScript + scriptFile Ghc865 Stack `shouldBe` stackScript cabalScript :: Text cabalScript = [text| @@ -35,7 +35,7 @@ stackScript = [text| #!/usr/bin/env stack {- stack - --resolver lts-13.16 + --resolver lts-14.18 script --package base -} diff --git a/test/Test/Show.hs b/test/Test/Show.hs new file mode 100644 --- /dev/null +++ b/test/Test/Show.hs @@ -0,0 +1,23 @@ +module Test.Show + ( showCommandSpec + ) where + +import Test.Hspec (Spec, describe, it, shouldBe) + +import Summoner.GhcVer (ghcTable) + + +showCommandSpec :: Spec +showCommandSpec = describe "show command golden tests" $ + it "correctly shows 'show ghc'" $ + ghcTable `shouldBe` goldenGhcTable + +goldenGhcTable :: [Text] +goldenGhcTable = + [ "GHC-7.10.3 base-4.8.0.2 lts-6.35 " + , "GHC-8.0.2 base-4.9.1.0 lts-9.21 " + , "GHC-8.2.2 base-4.10.1.0 lts-11.22 " + , "GHC-8.4.4 base-4.11.1.0 lts-12.26 " + , "GHC-8.6.5 base-4.12.0.0 lts-14.18 " + , "GHC-8.8.1 base-4.13.0.0 nightly-2019-12-25" + ] diff --git a/test/Test/TomlSpec.hs b/test/Test/TomlSpec.hs --- a/test/Test/TomlSpec.hs +++ b/test/Test/TomlSpec.hs @@ -3,15 +3,17 @@ ) where import Hedgehog (MonadGen, Property, forAll, property, tripping) +import Relude.Extra.Enum (universe) import Toml.Bi.Code (decode, encode) -import Summoner.Config (ConfigP (..), PartialConfig, configT) +import Summoner.Config (ConfigP (..), PartialConfig, configCodec) +import Summoner.CustomPrelude (CustomPrelude (..)) import Summoner.GhcVer (GhcVer) import Summoner.License (LicenseName) -import Summoner.Settings (CustomPrelude (..)) import Summoner.Source (Source (..)) import Test.DecisionSpec (genDecision) +import qualified Data.Text as T import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range @@ -19,17 +21,26 @@ tomlProp :: Property tomlProp = property $ do configToml <- forAll genPartialConfig - tripping configToml (encode configT) (decode configT) + tripping configToml (encode configCodec) (decode configCodec) ---------------------------------------------------------------------------- -- Generators ---------------------------------------------------------------------------- +genTextWithSeparator :: MonadGen m => Char -> m Text +genTextWithSeparator s = do + x <- T.toUpper <$> genText + y <- T.toUpper <$> genText + Gen.element [x, x <> T.cons s y] + genText :: MonadGen m => m Text genText = Gen.text - (Range.constant 0 10) - (Gen.frequency [ (1, Gen.element ['.','-']), (10, Gen.alphaNum) ]) + (Range.constant 1 11) + Gen.alpha +genString :: MonadGen m => m String +genString = Gen.list (Range.constant 0 100) Gen.alphaNum + genTextArr :: MonadGen m => m [Text] genTextArr = Gen.list (Range.constant 0 10) genText @@ -37,7 +48,10 @@ genGhcVerArr = Gen.list (Range.constant 0 10) Gen.enumBounded genCustomPrelude :: MonadGen m => m CustomPrelude -genCustomPrelude = CustomPrelude <$> genText <*> genText +genCustomPrelude = do + cpPackage <- genTextWithSeparator '-' + cpModule <- genTextWithSeparator '.' + pure CustomPrelude{..} genLicense :: MonadGen m => m LicenseName genLicense = Gen.element universe @@ -45,7 +59,7 @@ genSource :: MonadGen m => m Source genSource = do txt <- genText - s <- Gen.element [File . toString, Url, Link] + s <- Gen.element [Local . toString, Url, Raw] pure $ s txt genPartialConfig :: MonadGen m => m PartialConfig @@ -67,10 +81,10 @@ cBench <- genDecision cPrelude <- Last <$> Gen.maybe genCustomPrelude cExtensions <- genTextArr - cWarnings <- genTextArr cGhcOptions <- genTextArr cGitignore <- genTextArr cStylish <- Last <$> Gen.maybe genSource cContributing <- Last <$> Gen.maybe genSource cNoUpload <- Any <$> Gen.bool + cFiles <- Gen.map (Range.constant 0 10) (liftA2 (,) genString genSource) pure Config{..} diff --git a/test/golden/fullProject/.gitignore b/test/golden/fullProject/.gitignore --- a/test/golden/fullProject/.gitignore +++ b/test/golden/fullProject/.gitignore @@ -23,6 +23,7 @@ .HTF/ # Stack .stack-work/ +stack.yaml.lock ### IDE/support # Vim diff --git a/test/golden/fullProject/.travis.yml b/test/golden/fullProject/.travis.yml --- a/test/golden/fullProject/.travis.yml +++ b/test/golden/fullProject/.travis.yml @@ -17,7 +17,8 @@ - ghc: 8.0.2 - ghc: 8.2.2 - ghc: 8.4.4 - - ghc: 8.6.4 + - ghc: 8.6.5 + - ghc: 8.8.1 - ghc: 8.2.2 env: STACK_YAML="$TRAVIS_BUILD_DIR/stack-8.2.2.yaml" @@ -25,10 +26,16 @@ - ghc: 8.4.4 env: STACK_YAML="$TRAVIS_BUILD_DIR/stack-8.4.4.yaml" - - ghc: 8.6.4 + - ghc: 8.6.5 + env: STACK_YAML="$TRAVIS_BUILD_DIR/stack-8.6.5.yaml" + + - ghc: 8.8.1 env: STACK_YAML="$TRAVIS_BUILD_DIR/stack.yaml" install: + # HLint check + - curl -sSL https://raw.github.com/ndmitchell/neil/master/misc/travis.sh | sh -s -- hlint . + - | if [ -z "$STACK_YAML" ]; then ghc --version @@ -48,9 +55,6 @@ else stack test --system-ghc fi - - # HLint check - - curl -sSL https://raw.github.com/ndmitchell/neil/master/misc/travis.sh | sh -s -- hlint . notifications: email: false diff --git a/test/golden/fullProject/CHANGELOG.md b/test/golden/fullProject/CHANGELOG.md --- a/test/golden/fullProject/CHANGELOG.md +++ b/test/golden/fullProject/CHANGELOG.md @@ -3,8 +3,7 @@ `fullProject` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. -0.0.0 -===== +## 0.0.0.0 * Initially created. diff --git a/test/golden/fullProject/README.md b/test/golden/fullProject/README.md --- a/test/golden/fullProject/README.md +++ b/test/golden/fullProject/README.md @@ -1,10 +1,10 @@ # fullProject -[![Hackage](https://img.shields.io/hackage/v/fullProject.svg)](https://hackage.haskell.org/package/fullProject) -[![MIT license](https://img.shields.io/badge/license-MIT-blue.svg)](LICENSE) +[![Build status](https://img.shields.io/travis/kowainik/fullProject.svg?logo=travis)](https://travis-ci.org/kowainik/fullProject) +[![Windows build status](https://ci.appveyor.com/api/projects/status/github/kowainik/fullProject?branch=master&svg=true)](https://ci.appveyor.com/project/kowainik/fullProject) +[![Hackage](https://img.shields.io/hackage/v/fullProject.svg?logo=haskell)](https://hackage.haskell.org/package/fullProject) [![Stackage Lts](http://stackage.org/package/fullProject/badge/lts)](http://stackage.org/lts/package/fullProject) [![Stackage Nightly](http://stackage.org/package/fullProject/badge/nightly)](http://stackage.org/nightly/package/fullProject) -[![Build status](https://secure.travis-ci.org/kowainik/fullProject.svg)](https://travis-ci.org/kowainik/fullProject) -[![Windows build status](https://ci.appveyor.com/api/projects/status/github/kowainik/fullProject?branch=master&svg=true)](https://ci.appveyor.com/project/kowainik/fullProject) +[![MIT license](https://img.shields.io/badge/license-MIT-blue.svg)](LICENSE) Full test project diff --git a/test/golden/fullProject/appveyor.yml b/test/golden/fullProject/appveyor.yml --- a/test/golden/fullProject/appveyor.yml +++ b/test/golden/fullProject/appveyor.yml @@ -1,24 +1,34 @@ -install: - # Using '-y' and 'refreshenv' as a workaround to: - # https://github.com/haskell/cabal/issues/3687 - - choco source add -n mistuke -s https://www.myget.org/F/mistuke/api/v2 - - choco install -y ghc --ignore-dependencies - - choco install -y cabal-head -pre - - refreshenv - # See http://help.appveyor.com/discussions/problems/6312-curl-command-not-found#comment_42195491 - # NB: Do this after refreshenv, otherwise it will be clobbered! - - set PATH=%APPDATA%\cabal\bin;C:\Program Files\Git\cmd;C:\Program Files\Git\mingw64\bin;C:\msys64\usr\bin;%PATH% - - cabal --version - - cabal %CABOPTS% new-update +clone_folder: "c:\\WORK" +clone_depth: 5 -environment: - global: - CABOPTS: "--store-dir=C:\\SR" +# Do not build feature branch with open Pull Requests +skip_branch_with_pr: true +platform: + - x86_64 + cache: - - dist-newstyle - "C:\\SR" + - dist-newstyle +environment: + global: + CABOPTS: --store-dir=C:\\SR + + matrix: + - GHCVER: 8.8.1 + +install: + - choco source add -n mistuke -s https://www.myget.org/F/mistuke/api/v2 + - choco install -y cabal --version 2.4.1.0 + - choco install -y ghc --version 8.8.1 + - refreshenv + +before_build: + - cabal --version + - ghc --version + - cabal %CABOPTS% v2-update + build_script: - - cabal %CABOPTS% new-build --enable-tests --enable-benchmarks - - cabal %CABOPTS% new-test --enable-tests + - cabal %CABOPTS% v2-build --enable-tests + - cabal %CABOPTS% v2-test --enable-tests diff --git a/test/golden/fullProject/fullProject.cabal b/test/golden/fullProject/fullProject.cabal --- a/test/golden/fullProject/fullProject.cabal +++ b/test/golden/fullProject/fullProject.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: fullProject -version: 0.0.0 +version: 0.0.0.0 synopsis: Full test project description: Full test project homepage: https://github.com/kowainik/fullProject @@ -14,7 +14,11 @@ build-type: Simple extra-doc-files: README.md , CHANGELOG.md -tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.4 +tested-with: GHC == 8.0.2 + , GHC == 8.2.2 + , GHC == 8.4.4 + , GHC == 8.6.5 + , GHC == 8.8.1 source-repository head type: git @@ -25,7 +29,7 @@ exposed-modules: FullProject Prelude - build-depends: base-noprelude >= 4.9.1.0 && < 4.13 + build-depends: base-noprelude >= 4.9.1.0 && < 4.14 , relude ghc-options: -Wall @@ -41,7 +45,7 @@ hs-source-dirs: app main-is: Main.hs - build-depends: base-noprelude >= 4.9.1.0 && < 4.13 + build-depends: base-noprelude >= 4.9.1.0 && < 4.14 , fullProject , relude @@ -62,7 +66,7 @@ hs-source-dirs: test main-is: Spec.hs - build-depends: base-noprelude >= 4.9.1.0 && < 4.13 + build-depends: base-noprelude >= 4.9.1.0 && < 4.14 , fullProject , relude @@ -83,7 +87,7 @@ hs-source-dirs: benchmark main-is: Main.hs - build-depends: base-noprelude >= 4.9.1.0 && < 4.13 + build-depends: base-noprelude >= 4.9.1.0 && < 4.14 , gauge , fullProject , relude diff --git a/test/golden/fullProject/stack-8.2.2.yaml b/test/golden/fullProject/stack-8.2.2.yaml --- a/test/golden/fullProject/stack-8.2.2.yaml +++ b/test/golden/fullProject/stack-8.2.2.yaml @@ -1,6 +1,3 @@ resolver: lts-11.22 extra-deps: [base-noprelude-4.10.1.0] - -ghc-options: - "$locals": -fhide-source-paths diff --git a/test/golden/fullProject/stack-8.4.4.yaml b/test/golden/fullProject/stack-8.4.4.yaml --- a/test/golden/fullProject/stack-8.4.4.yaml +++ b/test/golden/fullProject/stack-8.4.4.yaml @@ -1,6 +1,3 @@ resolver: lts-12.26 extra-deps: [base-noprelude-4.11.1.0] - -ghc-options: - "$locals": -fhide-source-paths diff --git a/test/golden/fullProject/stack-8.6.5.yaml b/test/golden/fullProject/stack-8.6.5.yaml new file mode 100644 --- /dev/null +++ b/test/golden/fullProject/stack-8.6.5.yaml @@ -0,0 +1,3 @@ +resolver: lts-14.18 + +extra-deps: [base-noprelude-4.12.0.0] diff --git a/test/golden/fullProject/stack.yaml b/test/golden/fullProject/stack.yaml --- a/test/golden/fullProject/stack.yaml +++ b/test/golden/fullProject/stack.yaml @@ -1,6 +1,3 @@ -resolver: lts-13.16 - -extra-deps: [base-noprelude-4.12.0.0] +resolver: nightly-2019-12-25 -ghc-options: - "$locals": -fhide-source-paths +extra-deps: [base-noprelude-4.13.0.0] diff --git a/test/golden/smallProject/CHANGELOG.md b/test/golden/smallProject/CHANGELOG.md --- a/test/golden/smallProject/CHANGELOG.md +++ b/test/golden/smallProject/CHANGELOG.md @@ -2,9 +2,7 @@ `smallProject` uses [PVP Versioning][1]. - -0.0.0 -===== +## 0.0.0.0 * Initially created. diff --git a/test/golden/smallProject/README.md b/test/golden/smallProject/README.md --- a/test/golden/smallProject/README.md +++ b/test/golden/smallProject/README.md @@ -1,5 +1,5 @@ # smallProject -[![Hackage](https://img.shields.io/hackage/v/smallProject.svg)](https://hackage.haskell.org/package/smallProject) +[![Hackage](https://img.shields.io/hackage/v/smallProject.svg?logo=haskell)](https://hackage.haskell.org/package/smallProject) Small test project diff --git a/test/golden/smallProject/smallProject.cabal b/test/golden/smallProject/smallProject.cabal --- a/test/golden/smallProject/smallProject.cabal +++ b/test/golden/smallProject/smallProject.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: smallProject -version: 0.0.0 +version: 0.0.0.0 synopsis: Small test project description: Small test project license: AllRightsReserved @@ -10,13 +10,13 @@ build-type: Simple extra-doc-files: README.md , CHANGELOG.md -tested-with: GHC == 8.6.4 +tested-with: GHC == 8.8.1 executable smallProject hs-source-dirs: app main-is: Main.hs - build-depends: base ^>= 4.12.0.0 + build-depends: base ^>= 4.13.0.0 @@ -32,5 +32,6 @@ -fhide-source-paths -Wmissing-export-lists -Wpartial-fields + -Wmissing-deriving-strategies default-language: Haskell2010