doctest 0.19.0 → 0.25.0
raw patch · 57 files changed
Files
- CHANGES.markdown +71/−0
- LICENSE +1/−1
- README.markdown +0/−479
- README.md +612/−0
- doctest.cabal +108/−65
- driver/Main.hs +0/−6
- driver/cabal-doctest.hs +8/−0
- driver/doctest.hs +8/−0
- ghci-wrapper/src/Language/Haskell/GhciWrapper.hs +0/−146
- src/Cabal.hs +77/−0
- src/Cabal/Options.hs +78/−0
- src/Cabal/Paths.hs +96/−0
- src/Cabal/ReplOptions.hs +195/−0
- src/Extract.hs +74/−105
- src/GhcUtil.hs +18/−53
- src/Imports.hs +34/−0
- src/Info.hs +63/−0
- src/Interpreter.hs +17/−27
- src/Language/Haskell/GhciWrapper.hs +160/−0
- src/Location.hs +4/−12
- src/Options.hs +82/−92
- src/PackageDBs.hs +15/−33
- src/Parse.hs +13/−17
- src/Property.hs +2/−4
- src/Run.hs +66/−33
- src/Runner.hs +129/−97
- src/Runner/Example.hs +2/−0
- src/Test/DocTest.hs +1/−2
- src/Test/DocTest/Internal/Cabal.hs +10/−0
- src/Test/DocTest/Internal/Extract.hs +4/−0
- src/Test/DocTest/Internal/Location.hs +4/−0
- src/Test/DocTest/Internal/Parse.hs +4/−0
- src/Test/DocTest/Internal/Run.hs +4/−0
- src/Util.hs +3/−0
- test/Cabal/OptionsSpec.hs +60/−0
- test/Cabal/PathsSpec.hs +22/−0
- test/Cabal/ReplOptionsSpec.hs +99/−0
- test/ExtractSpec.hs +2/−2
- test/InfoSpec.hs +17/−0
- test/InterpreterSpec.hs +8/−8
- test/Language/Haskell/GhciWrapperSpec.hs +115/−0
- test/LocationSpec.hs +2/−0
- test/MainSpec.hs +32/−14
- test/OptionsSpec.hs +54/−15
- test/Orphans.hs +0/−16
- test/PackageDBsSpec.hs +2/−3
- test/ParseSpec.hs +10/−10
- test/PropertySpec.hs +23/−27
- test/RunSpec.hs +60/−27
- test/Runner/ExampleSpec.hs +1/−2
- test/RunnerSpec.hs +17/−64
- test/UtilSpec.hs +2/−0
- test/doctests.hs +0/−12
- test/integration/fail-fast/Bar.hs +8/−0
- test/integration/fail-fast/Foo.hs +24/−0
- test/integration/fail-fast/SetupBar.hs +12/−0
- test/integration/fail-fast/SetupFoo.hs +29/−0
CHANGES.markdown view
@@ -1,3 +1,74 @@+Changes in 0.25.0+ - Full GHC 9.14 compatibility / `-unit`-support++Changes in 0.24.3+ - Allow building with GHC 9.14 (#478)++Changes in 0.24.2+ - Use `GHC.ResponseFile.expandResponse`++Changes in 0.24.1+ - Interpret GHC response files++Changes in 0.24.0+ - cabal-doctest: Add support for cabal-install 3.14.*++Changes in 0.23.0+ - Add `--fail-fast`++Changes in 0.22.10+ - Make progress reporting more robust++Changes in 0.22.9+ - Use `-fprint-error-index-links=never` for GHC `>=9.10`++Changes in 0.22.8+ - cabal-doctest: Fix handling of options with optional arguments++Changes in 0.22.7+ - cabal-doctest: Accept component+ - cabal-doctest: Get rid of separate `cabal build` step+ - cabal-doctest: Add support for `--list-options`++Changes in 0.22.6+ - cabal-doctest: Take `with-compiler:` from `cabal-project` into account+ - cabal-doctest: Add support for `--with-compiler`+ - cabal-doctest: Fix `ghc-pkg` discovery logic+ - cabal-doctest: Cache `doctest` executables++Changes in 0.22.5+ - Add (experimental) `cabal-doctest` executable. This is guarded behind a+ flag for now, use `cabal install doctest -f cabal-doctest` to install it.++Changes in 0.22.4+ - Use `-Wno-unused-packages` for GHC `8.10` / `9.0` / `9.2`++Changes in 0.22.3+ - Use `-Wno-unused-packages` when extracting comments++Changes in 0.22.2+ - GHC 9.8 compatibility++Changes in 0.22.1+ - Add `Test.DocTest.Internal.Run.doctestWithRepl`++Changes in 0.22.0+ - Export more internals++Changes in 0.21.1+ - GHC 9.6 compatibility.++Changes in 0.21.0+ - Accept `--fast`, `--preserve-it` and `--verbose` via `--repl-options`++Changes in 0.20.1+ - GHC 9.4 compatibility. (#382)++Changes in 0.20.0+ - Allow doctest to be invoked via `cabal repl --with-compiler=doctest`+ - Include `ghc --info` output in `--info`+ - Make `--info` output formatting consistent with GHC+ Changes in 0.19.0 - Better support for `cabal v2-*`
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2009-2018 Simon Hengel <sol@typeful.net>+Copyright (c) 2009-2026 Simon Hengel <sol@typeful.net> Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal
− README.markdown
@@ -1,479 +0,0 @@-# Doctest: Test interactive Haskell examples--`doctest` is a small program, that checks [examples in Haddock comments](http://www.haskell.org/haddock/doc/html/ch03s08.html#id566093). It is similar-to the [popular Python module with the same name](http://docs.python.org/library/doctest.html).---## Installation--`doctest` is available from-[Hackage](http://hackage.haskell.org/cgi-bin/hackage-scripts/package/doctest).-Install it, by typing:-- cabal install doctest--Make sure that Cabal's `bindir` is on your `PATH`.--On Linux:-- export PATH="$HOME/.cabal/bin:$PATH"--On Mac OS X:-- export PATH="$HOME/Library/Haskell/bin:$PATH"--On Windows:-- set PATH="%AppData%\cabal\bin\;%PATH%"--For more information, see the [section on paths in the Cabal User Guide](http://www.haskell.org/cabal/users-guide/installing-packages.html#paths-in-the-simple-build-system).--## Usage--Below is a small Haskell module.-The module contains a Haddock comment with some examples of interaction.-The examples demonstrate how the module is supposed to be used.--```haskell-module Fib where---- | Compute Fibonacci numbers------ Examples:------ >>> fib 10--- 55------ >>> fib 5--- 5-fib :: Int -> Int-fib 0 = 0-fib 1 = 1-fib n = fib (n - 1) + fib (n - 2)-```--(A comment line starting with `>>>` denotes an _expression_.-All comment lines following an expression denote the _result_ of that expression.-Result is defined by what a-[REPL](http://en.wikipedia.org/wiki/Read-eval-print_loop) (e.g. ghci)-prints to `stdout` and `stderr` when evaluating that expression.)--With `doctest` you may check whether the implementation satisfies the given examples, by typing:-- doctest Fib.hs--You may produce Haddock documentation for that module with:-- haddock -h Fib.hs -o doc/--`doctest` will fail on comments that `haddock` also doesn't like.-Sometimes (e.g., [#251](https://github.com/sol/doctest/issues/251)), this means that `doctest` will fail on input that GHC accepts.--`doctest` likes UTF-8. If you are running it with, e.g., `LC_ALL=C`,-you may need to invoke `doctest` with `LC_ALL=C.UTF-8`.--### Example groups--Examples from a single Haddock comment are grouped together and share the same-scope. E.g. the following works:--```haskell--- |--- >>> let x = 23--- >>> x + 42--- 65-```--If an example fails, subsequent examples from the same group are skipped. E.g.-for--```haskell--- |--- >>> let x = 23--- >>> let n = x + y--- >>> print n-```--`print n` is not tried, because `let n = x + y` fails (`y` is not in scope!).--#### A note on performance--By default, `doctest` calls `:reload` between each group to clear GHCi's scope-of any local definitions. This ensures that previous examples cannot influence-later ones. However, it can lead to performance penalties if you are using-`doctest` in a project with many modules. One possible remedy is to pass the-`--fast` flag to `doctest`, which disables calling `:reload` between groups.-If `doctest`s are running too slowly, you might consider using `--fast`.-(With the caveat that the order in which groups appear now matters!)--However, note that due to a-[bug on GHC 8.2.1 or later](https://ghc.haskell.org/trac/ghc/ticket/14052),-the performance of `--fast` suffers significantly when combined with the-`--preserve-it` flag (which keeps the value of GHCi's `it` value between-examples).--### Setup code--You can put setup code in a [named chunk][named-chunks] with the name `$setup`.-The setup code is run before each example group. If the setup code produces-any errors/failures, all tests from that module are skipped.--Here is an example:--```haskell-module Foo where--import Bar.Baz---- $setup--- >>> let x = 23 :: Int---- |--- >>> foo + x--- 65-foo :: Int-foo = 42-```--Note that you should not place setup code inbetween the module header (`module-... where`) and import declarations. GHC will not be able to parse it ([issue- #167](https://github.com/sol/doctest/issues/167)). It is best to place setup-code right after import declarations, but due to its declarative nature you can-place it anywhere inbetween top level declarations as well.---### Multi-line input-GHCi supports commands which span multiple lines, and the same syntax works for doctest:--```haskell--- |--- >>> :{--- let--- x = 1--- y = 2--- in x + y + multiline--- :}--- 6-multiline = 3-```--Note that `>>>` can be left off for the lines following the first: this is so that-haddock does not strip leading whitespace. The expected output has whitespace-stripped relative to the :}.--Some peculiarities on the ghci side mean that whitespace at the very start is lost.-This breaks the example `broken`, since the x and y aren't aligned from ghci's-perspective. A workaround is to avoid leading space, or add a newline such-that the indentation does not matter:--```haskell-{- | >>> :{-let x = 1- y = 2- in x + y + works-:}-6--}-works = 3--{- | >>> :{- let x = 1- y = 2- in x + y + broken-:}-3--}-broken = 3-```--### Multi-line output-If there are no blank lines in the output, multiple lines are handled-automatically.--```haskell--- | >>> putStr "Hello\nWorld!"--- Hello--- World!-```--If however the output contains blank lines, they must be noted-explicitly with `<BLANKLINE>`. For example,--```haskell-import Data.List ( intercalate )---- | Double-space a paragraph.------ Examples:------ >>> let s1 = "\"Every one of whom?\""--- >>> let s2 = "\"Every one of whom do you think?\""--- >>> let s3 = "\"I haven't any idea.\""--- >>> let paragraph = unlines [s1,s2,s3]--- >>> putStrLn $ doubleSpace paragraph--- "Every one of whom?"--- <BLANKLINE>--- "Every one of whom do you think?"--- <BLANKLINE>--- "I haven't any idea."----doubleSpace :: String -> String-doubleSpace = (intercalate "\n\n") . lines-```--### Matching arbitrary output-Any lines containing only three dots (`...`) will match one or more lines with-arbitrary content. For instance,--```haskell--- |--- >>> putStrLn "foo\nbar\nbaz"--- foo--- ...--- baz-```--If a line contains three dots and additional content, the three dots will match-anything *within that line*:--```haskell--- |--- >>> putStrLn "foo bar baz"--- foo ... baz-```--### QuickCheck properties--Haddock (since version 2.13.0) has markup support for properties. Doctest can-verify properties with QuickCheck. A simple property looks like this:--```haskell--- |--- prop> \xs -> sort xs == (sort . sort) (xs :: [Int])-```--The lambda abstraction is optional and can be omitted:--```haskell--- |--- prop> sort xs == (sort . sort) (xs :: [Int])-```--A complete example that uses setup code is below:--```haskell-module Fib where---- $setup--- >>> import Control.Applicative--- >>> import Test.QuickCheck--- >>> newtype Small = Small Int deriving Show--- >>> instance Arbitrary Small where arbitrary = Small . (`mod` 10) <$> arbitrary---- | Compute Fibonacci numbers------ The following property holds:------ prop> \(Small n) -> fib n == fib (n + 2) - fib (n + 1)-fib :: Int -> Int-fib 0 = 0-fib 1 = 1-fib n = fib (n - 1) + fib (n - 2)-```--If you see an error like the following, ensure that-[QuickCheck](http://hackage.haskell.org/package/QuickCheck) is a dependency-of the test-suite or executable running `doctest`.--```haskell-<interactive>:39:3:- Not in scope: ‘polyQuickCheck’- In the splice: $(polyQuickCheck (mkName "doctest_prop"))--<interactive>:39:3:- GHC stage restriction:- ‘polyQuickCheck’ is used in a top-level splice or annotation,- and must be imported, not defined locally- In the expression: polyQuickCheck (mkName "doctest_prop")- In the splice: $(polyQuickCheck (mkName "doctest_prop"))-```--### Hiding examples from Haddock--You can put examples into [named chunks][named-chunks], and not refer to them-in the export list. That way they will not be part of the generated Haddock-documentation, but Doctest will still find them.--```haskell--- $--- >>> 1 + 1--- 2-```--[named-chunks]: http://www.haskell.org/haddock/doc/html/ch03s05.html--### Using GHC extensions--There's two sets of GHC extensions involved when running Doctest:--1. The set of GHC extensions that are active when compiling the module code-(excluding the doctest examples). The easiest way to specify these extensions-is through [LANGUAGE pragmas][language-pragma] in your source files.-(Doctest will not look at your cabal file.)-2. The set of GHC extensions that are active when executing the Doctest-examples. (These are not influenced by the LANGUAGE pragmas in the file.) The-recommended way to enable extensions for Doctest examples is to switch them-on like this:--```haskell--- |--- >>> :set -XTupleSections--- >>> fst' $ (1,) 2--- 1-fst' :: (a, b) -> a-fst' = fst-```--Alternatively you can pass any GHC options to Doctest, e.g.:-- doctest -XCPP Foo.hs--These options will affect both the loading of the module and the execution of-the Doctest examples.--If you want to omit the information which language extensions are enabled from-the Doctest examples you can use the method described in [Hiding examples from-Haddock](#hiding-examples-from-haddock), e.g.:--```haskell--- $--- >>> :set -XTupleSections-```--[language-pragma]: http://www.haskell.org/ghc/docs/latest/html/users_guide/pragmas.html#language-pragma--### Limitations--Due to [a GHC bug](https://gitlab.haskell.org/ghc/ghc/-/issues/20670), running-`:set -XTemplateHaskell` within `ghci` may unload any modules that were-specified on the command line.--To address this `doctest >= 0.19.0` does two things:--1. Doctest always enables `-XTemplateHaskell`. So it is safe to use Template- Haskell in examples without enabling the extension explicitly.-1. Doctest filters out `-XTemplateHaskell` from single-line `:set`-statements.- So it is still safe to include `:set -XTemplateHaskell` in examples for- documentation purposes. It may just not work as intended in `ghci` due to- that GHC bug.--Doctest does not filter out `-XTemplateHaskell` from multi-line-`:set`-statements. So if you e.g. use--```->>> :{-:set -XTemplateHaskell-:}-```-then you are on your own.---### Cabal integration--Doctest provides both, an executable and a library. The library exposes a-function `doctest` of type:--```haskell-doctest :: [String] -> IO ()-```--Doctest's own `main` is simply:--```haskell-main = getArgs >>= doctest-```--Consequently, it is possible to create a custom executable for a project, by-passing all command-line arguments that are required for that project to-`doctest`. A simple example looks like this:--```haskell--- file doctests.hs-import Test.DocTest-main = doctest ["-isrc", "src/Main.hs"]-```--And a corresponding Cabal test suite section like this:-- test-suite doctests- type: exitcode-stdio-1.0- ghc-options: -threaded- main-is: doctests.hs- build-depends: base, doctest >= 0.8--## Doctest in the wild--You can find real world examples of `Doctest` being used below:-- * [base Data/Maybe.hs](https://github.com/ghc/ghc/blob/669cbef03c220de43b0f88f2b2238bf3c02ed64c/libraries/base/Data/Maybe.hs#L36-L79)- * [base Data/Functor.hs](https://github.com/ghc/ghc/blob/669cbef03c220de43b0f88f2b2238bf3c02ed64c/libraries/base/Data/Functor.hs#L34-L64)---## Doctest extensions-- * [doctest-discover](https://github.com/karun012/doctest-discover)--## Development [](http://travis-ci.org/sol/doctest)--Join in at `#hspec` on freenode.--Discuss your ideas first, ideally by opening an issue on GitHub.--Add tests for new features, and make sure that the test suite passes with your-changes.-- cabal configure --enable-tests && cabal build && cabal exec cabal test---## Contributors-- * Adam Vogt- * Alan Zimmerman- * Alexander Bernauer- * Alexandre Esteves- * Anders Persson- * Andreas Abel- * Ankit Ahuja- * Artyom Kazak- * Edward Kmett- * Gabor Greif- * Hiroki Hattori- * Ignat Insarov- * Jens Petersen- * Joachim Breitner- * John Chee- * João Cristóvão- * Julian Arni- * Kazu Yamamoto- * Leon Schoorl- * Levent Erkok- * Luke Murphy- * Matvey Aksenov- * Michael Orlitzky- * Michael Snoyman- * Mitchell Rosen- * Nick Smallbone- * Nikos Baxevanis- * Oleg Grenrus- * quasicomputational- * Ryan Scott- * Sakari Jokinen- * Simon Hengel- * Sönke Hahn- * Takano Akio- * Tamar Christina- * Veronika Romashkina--For up-to-date list, query-- git shortlog -s
+ README.md view
@@ -0,0 +1,612 @@+# Doctest: Test interactive Haskell examples++`doctest` is a tool that checks+[examples](https://haskell-haddock.readthedocs.io/latest/markup.html#examples)+and+[properties](https://haskell-haddock.readthedocs.io/latest/markup.html#properties)+in Haddock comments.+It is similar in spirit to the [popular Python module with the same name](https://docs.python.org/3/library/doctest.html).++* [Getting started](#getting-started)+ * [Installation](#installation)+ * [A basic example](#a-basic-example)+* [Running doctest for a Cabal package](#running-doctest-for-a-cabal-package)+ * [Passing doctest options to cabal repl](#passing-doctest-options-to-cabal-repl)+ * [Cabal integration](#cabal-integration)+* [Writing examples and properties](#writing-examples-and-properties)+ * [Example groups](#example-groups)+ * [A note on performance](#a-note-on-performance)+ * [Setup code](#setup-code)+ * [Multi-line input](#multi-line-input)+ * [Multi-line output](#multi-line-output)+ * [Matching arbitrary output](#matching-arbitrary-output)+ * [QuickCheck properties](#quickcheck-properties)+ * [Hiding examples from Haddock](#hiding-examples-from-haddock)+ * [Using GHC extensions](#using-ghc-extensions)+* [Limitations](#limitations)+* [Doctest in the wild](#doctest-in-the-wild)+* [Development](#development)+* [Contributors](#contributors)+++# Getting started++## Installation++`doctest` is available from+[Hackage](https://hackage.haskell.org/package/doctest).+Install it with:++ cabal update && cabal install --ignore-project doctest++Make sure that Cabal's `installdir` is on your `PATH`.++On Linux / macOS / BSD:++```bash+ # requires cabal-install version 3.12, or later+export PATH="$(cabal -v0 path --installdir):$PATH"+```+or+```bash+export PATH="$HOME/.local/bin:$PATH"+```++On Windows with PowerShell:++```pwsh+# requires cabal-install version 3.12, or later+$Env:PATH = "$(cabal -v0 path --installdir)" + ";" + $Env:PATH+```++## A basic example++Below is a small Haskell module.+The module contains a Haddock comment with some examples of interaction.+The examples demonstrate how the module is supposed to be used.++```haskell+-- src/Fib.hs+module Fib where++-- | Compute Fibonacci numbers+--+-- Examples:+--+-- >>> fib 10+-- 55+--+-- >>> fib 5+-- 5+fib :: Int -> Int+fib 0 = 0+fib 1 = 1+fib n = fib (n - 1) + fib (n - 2)++```++(A comment line starting with `>>>` denotes an _expression_.+All comment lines following an expression denote the _result_ of that expression.+Result is defined by what a+[REPL](https://en.wikipedia.org/wiki/Read%E2%80%93eval%E2%80%93print_loop) (e.g. ghci)+prints to `stdout` and `stderr` when evaluating that expression.)++With `doctest` you can check whether the implementation satisfies the given+examples:++```+doctest src/Fib.hs+```+++# Running `doctest` for a Cabal package++The easiest way to run `doctest` for a Cabal package is via `cabal repl --with-compiler=doctest`.++This doesn't make a big difference for a simple package, but in more involved+situations `cabal` will make sure that all dependencies are available and it+will pass any required GHC options to `doctest`.++A simple `.cabal` file for `Fib` looks like this:++```cabal+-- fib.cabal+cabal-version: 1.12++name: fib+version: 0.0.0+build-type: Simple++library+ build-depends: base == 4.*+ hs-source-dirs: src+ exposed-modules: Fib+ default-language: Haskell2010++```++With a `.cabal` file in place, it is possible to run `doctest` via `cabal repl`:++```bash+$ cabal repl --with-compiler=doctest+...+Examples: 2 Tried: 2 Errors: 0 Failures: 0+```+++Notes:++- If you use properties you need to pass `--build-depends=QuickCheck` and+ `--build-depends=template-haskell` to `cabal repl`.++- You likely want to reset the warning strategy for `cabal repl` with+ `--repl-options='-w -Wdefault'`.++- `doctest` always uses the version of GHC it was compiled with. Reinstalling+ `doctest` with `cabal install doctest --overwrite-policy=always` before each+ invocation ensures that it uses the same version of GHC as is on the `PATH`.++- Technically, `cabal build` is not necessary. `cabal repl --with-compiler=doctest`+ will build any dependencies as needed. However, it's more robust to run+ `cabal build` first (specifically it is not a good idea to build+ `ghc-paths` with `--with-compiler=doctest`).++So a more robust way to call `doctest` is as follows:++```+cabal install doctest --ignore-project --overwrite-policy=always && cabal build && cabal repl --build-depends=QuickCheck --build-depends=template-haskell --with-compiler=doctest --repl-options='-w -Wdefault'+```++(This is what you want to use on CI.)++## Passing `doctest` options to `cabal repl`++You can pass `doctest` options like `--fast`, `--preserve-it` and `--verbose` to+`cabal repl` via `--repl-options`.++Example:++```bash+$ cabal repl --with-compiler=doctest --repl-options=--verbose+### Started execution at src/Fib.hs:7.+### example:+fib 10+### Successful!++### Started execution at src/Fib.hs:10.+### example:+fib 5+### Successful!++# Final summary:+Examples: 2 Tried: 2 Errors: 0 Failures: 0+```++## Cabal integration++***NOTE:*** This feature is experimental.++***NOTE:*** This feature requires `cabal-install` version 3.12 or later.+++```bash+$ cabal install --ignore-project doctest --flag cabal-doctest+```++```bash+$ cabal doctest+Examples: 2 Tried: 2 Errors: 0 Failures: 0+```++```bash+$ cabal doctest -w ghc-8.6.5+Examples: 2 Tried: 2 Errors: 0 Failures: 0+```++```bash+$ cabal doctest --repl-options=--verbose+### Started execution at src/Fib.hs:7.+### example:+fib 10+### Successful!++### Started execution at src/Fib.hs:10.+### example:+fib 5+### Successful!++# Final summary:+Examples: 2 Tried: 2 Errors: 0 Failures: 0+```++```bash+$ cabal doctest --build-depends transformers+Examples: 2 Tried: 2 Errors: 0 Failures: 0+```++# Writing examples and properties++## Example groups++Examples from a single Haddock comment are grouped together and share the same+scope. E.g. the following works:++```haskell+-- |+-- >>> let x = 23+-- >>> x + 42+-- 65+```++If an example fails, subsequent examples from the same group are skipped. E.g.+for++```haskell+-- |+-- >>> let x = 23+-- >>> let n = x + y+-- >>> print n+```++`print n` is skipped, because `let n = x + y` fails (as `y` is not in scope).++### A note on performance++By default, `doctest` calls `:reload` between each group to clear GHCi's scope+of any local definitions. This ensures that previous examples cannot influence+later ones. However, it can lead to performance penalties if you are using+`doctest` in a project with many modules. One possible remedy is to pass the+`--fast` flag to `doctest`, which disables calling `:reload` between groups.+If `doctest`s are running too slowly, you might consider using `--fast`.+(With the caveat that the order in which groups appear now matters!)++However, note that due to a+[bug on GHC 8.2.1 or later](https://gitlab.haskell.org/ghc/ghc/-/issues/14052),+the performance of `--fast` suffers significantly when combined with the+`--preserve-it` flag (which keeps the value of GHCi's `it` value between+examples).++## Setup code++You can put setup code in a [named chunk][named-chunks] with the name `$setup`.+The setup code is run before each example group. If the setup code produces+any errors/failures, all tests from that module are skipped.++Here is an example:++```haskell+module Foo where++import Bar.Baz++-- $setup+-- >>> let x = 23 :: Int++-- |+-- >>> foo + x+-- 65+foo :: Int+foo = 42+```++Note that you should not place setup code inbetween the module header (`module+... where`) and import declarations. GHC will not be able to parse it ([issue+ #167](https://github.com/sol/doctest/issues/167)). It is best to place setup+code right after import declarations, but due to its declarative nature you can+place it anywhere inbetween top level declarations as well.+++## Multi-line input+GHCi supports commands which span multiple lines, and the same syntax works for doctest:++```haskell+-- |+-- >>> :{+-- let+-- x = 1+-- y = 2+-- in x + y + multiline+-- :}+-- 6+multiline = 3+```++Note that `>>>` can be left off for the lines following the first: this is so that+haddock does not strip leading whitespace. The expected output has whitespace+stripped relative to the :}.++Some peculiarities on the ghci side mean that whitespace at the very start is lost.+This breaks the example `broken`, since the x and y aren't aligned from ghci's+perspective. A workaround is to avoid leading space, or add a newline such+that the indentation does not matter:++```haskell+{- | >>> :{+let x = 1+ y = 2+ in x + y + works+:}+6+-}+works = 3++{- | >>> :{+ let x = 1+ y = 2+ in x + y + broken+:}+3+-}+broken = 3+```++## Multi-line output+If there are no blank lines in the output, multiple lines are handled+automatically.++```haskell+-- | >>> putStr "Hello\nWorld!"+-- Hello+-- World!+```++If however the output contains blank lines, they must be noted+explicitly with `<BLANKLINE>`. For example,++```haskell+import Data.List ( intercalate )++-- | Double-space a paragraph.+--+-- Examples:+--+-- >>> let s1 = "\"Every one of whom?\""+-- >>> let s2 = "\"Every one of whom do you think?\""+-- >>> let s3 = "\"I haven't any idea.\""+-- >>> let paragraph = unlines [s1,s2,s3]+-- >>> putStrLn $ doubleSpace paragraph+-- "Every one of whom?"+-- <BLANKLINE>+-- "Every one of whom do you think?"+-- <BLANKLINE>+-- "I haven't any idea."+--+doubleSpace :: String -> String+doubleSpace = (intercalate "\n\n") . lines+```++## Matching arbitrary output+Any lines containing only three dots (`...`) will match one or more lines with+arbitrary content. For instance,++```haskell+-- |+-- >>> putStrLn "foo\nbar\nbaz"+-- foo+-- ...+-- baz+```++If a line contains three dots and additional content, the three dots will match+anything *within that line*:++```haskell+-- |+-- >>> putStrLn "foo bar baz"+-- foo ... baz+```++## QuickCheck properties++Haddock has markup support for properties. Doctest can verify properties with+QuickCheck. A simple property looks like this:++```haskell+-- |+-- prop> \xs -> sort xs == (sort . sort) (xs :: [Int])+```++The lambda abstraction is optional and can be omitted:++```haskell+-- |+-- prop> sort xs == (sort . sort) (xs :: [Int])+```++A complete example that uses setup code is below:++```haskell+module Fib where++-- $setup+-- >>> import Control.Applicative+-- >>> import Test.QuickCheck+-- >>> newtype Small = Small Int deriving Show+-- >>> instance Arbitrary Small where arbitrary = Small . (`mod` 10) <$> arbitrary++-- | Compute Fibonacci numbers+--+-- The following property holds:+--+-- prop> \(Small n) -> fib n == fib (n + 2) - fib (n + 1)+fib :: Int -> Int+fib 0 = 0+fib 1 = 1+fib n = fib (n - 1) + fib (n - 2)+```++If you see an error like the following, ensure that+[QuickCheck](https://hackage.haskell.org/package/QuickCheck) is visible to+`doctest` (e.g. by passing `--build-depends=QuickCheck` to `cabal repl`).++```haskell+<interactive>:39:3:+ Not in scope: ‘polyQuickCheck’+ In the splice: $(polyQuickCheck (mkName "doctest_prop"))++<interactive>:39:3:+ GHC stage restriction:+ ‘polyQuickCheck’ is used in a top-level splice or annotation,+ and must be imported, not defined locally+ In the expression: polyQuickCheck (mkName "doctest_prop")+ In the splice: $(polyQuickCheck (mkName "doctest_prop"))+```++## Hiding examples from Haddock++You can put examples into [named chunks][named-chunks], and not refer to them+in the export list. That way they will not be part of the generated Haddock+documentation, but Doctest will still find them.++```haskell+-- $+-- >>> 1 + 1+-- 2+```++[named-chunks]: https://haskell-haddock.readthedocs.io/latest/markup.html#named-chunks++## Using GHC extensions++There's two sets of GHC extensions involved when running Doctest:++1. The set of GHC extensions that are active when compiling the module code+ (excluding the doctest examples). The easiest way to specify these+ extensions is through [LANGUAGE pragmas][language-pragma] in your source+ files.++1. The set of GHC extensions that are active when executing the Doctest+ examples. (These are not influenced by the LANGUAGE pragmas in the file.)+ The recommended way to enable extensions for Doctest examples is to switch+ them on like this:++```haskell+-- |+-- >>> :seti -XTupleSections+-- >>> fst' $ (1,) 2+-- 1+fst' :: (a, b) -> a+fst' = fst+```++Alternatively you can pass any GHC options to Doctest, e.g.:++ doctest -XCPP Foo.hs++These options will affect both the loading of the module and the execution of+the Doctest examples.++If you want to omit the information which language extensions are enabled from+the Doctest examples you can use the method described in [Hiding examples from+Haddock](#hiding-examples-from-haddock), e.g.:++```haskell+-- $+-- >>> :seti -XTupleSections+```++[language-pragma]: https://downloads.haskell.org/ghc/latest/docs/users_guide/exts/pragmas.html#language-pragma++# Limitations+++- Doctests only works on platforms that have support for GHC's `--interactive` mode (`ghci`).+++- Due to [a GHC bug](https://gitlab.haskell.org/ghc/ghc/-/issues/20670), running+ `:set -XTemplateHaskell` within `ghci` may unload any modules that were+ specified on the command-line.++ To address this `doctest >= 0.19.0` does two things:++ 1. Doctest always enables `-XTemplateHaskell`. So it is safe to use Template+ Haskell in examples without enabling the extension explicitly.+ 1. Doctest filters out `-XTemplateHaskell` from single-line `:set`-statements.+ So it is still safe to include `:set -XTemplateHaskell` in examples for+ documentation purposes. It may just not work as intended in `ghci` due to+ that GHC bug.++ Doctest does not filter out `-XTemplateHaskell` from multi-line+ `:set`-statements. So if you e.g. use++ ```+ >>> :{+ :set -XTemplateHaskell+ :}+ ```+ then you are on your own.++ Note that all platforms that support `--interactive` also support+ `-XTemplateHaskell`. So this approach does not reduce Doctest's platform+ support.++- Modules that are rejected by `haddock` will not work with `doctest`. This+ can mean that `doctest` fails on input that is accepted by GHC (e.g.+ [#251](https://github.com/sol/doctest/issues/251)).++- Doctest works best with UTF-8. If your locale is e.g. `LC_ALL=C`, you may+ want to invoke `doctest` with `LC_ALL=C.UTF-8`.++# Doctest in the wild++You can find real world examples of `Doctest` being used below:++ * [base Data/Maybe.hs](https://github.com/ghc/ghc/blob/669cbef03c220de43b0f88f2b2238bf3c02ed64c/libraries/base/Data/Maybe.hs#L36-L79)+ * [base Data/Functor.hs](https://github.com/ghc/ghc/blob/669cbef03c220de43b0f88f2b2238bf3c02ed64c/libraries/base/Data/Functor.hs#L34-L64)+++# Development++Discuss your ideas first, ideally by opening an issue on GitHub.++Add tests for new features, and make sure that the test suite passes with your+changes.++ cabal build && cabal exec $(cabal list-bin spec)+++# Contributors++ * Simon Hengel+ * quasicomputational+ * Kazu Yamamoto+ * Andreas Abel+ * Michael Snoyman+ * Michael Orlitzky+ * Sakari Jokinen+ * Adam Vogt+ * Ryan Scott+ * Oleg Grenrus+ * Sönke Hahn+ * Edward Kmett+ * Elliot Marsden+ * Greg Pfeil+ * Ignat Insarov+ * Julian K. Arni+ * Takano Akio+ * Joachim Breitner+ * Alan Zimmerman+ * Alexander Bernauer+ * Alexandre Esteves+ * Anders Persson+ * Ankit Ahuja+ * Artyom Kazak+ * Gabor Greif+ * Guillaume Bouchard+ * Hiroki Hattori+ * Jens Petersen+ * John Chee+ * João Cristóvão+ * Leon Schoorl+ * Levent Erkok+ * Luke Murphy+ * Matvey Aksenov+ * Mitchell Rosen+ * Nick Smallbone+ * Nikos Baxevanis+ * Tamar Christina+ * Veronika Romashkina++For up-to-date list, query++ git shortlog -s
doctest.cabal view
@@ -1,14 +1,16 @@-cabal-version: 2.0+cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.39.1. -- -- see: https://github.com/sol/hpack name: doctest-version: 0.19.0+version: 0.25.0 synopsis: Test interactive Haskell examples-description: The doctest program checks examples in source code comments. It is modeled- after doctest for Python (<https://docs.python.org/3/library/doctest.html>).+description: `doctest` is a tool that checks [examples](https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744)+ and [properties](https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810771856)+ in Haddock comments.+ It is similar in spirit to the [popular Python module with the same name](https://docs.python.org/3/library/doctest.html). . Documentation is at <https://github.com/sol/doctest#readme>. category: Testing@@ -16,22 +18,10 @@ homepage: https://github.com/sol/doctest#readme license: MIT license-file: LICENSE-copyright: (c) 2009-2018 Simon Hengel+copyright: (c) 2009-2026 Simon Hengel author: Simon Hengel <sol@typeful.net>-maintainer: quasicomputational@gmail.com, Andreas Abel+maintainer: Simon Hengel <sol@typeful.net> build-type: Simple-tested-with:- GHC == 7.6.3- , GHC == 7.8.4- , GHC == 7.10.3- , GHC == 8.0.2- , GHC == 8.2.2- , GHC == 8.4.4- , GHC == 8.6.5- , GHC == 8.8.4- , GHC == 8.10.7- , GHC == 9.0.1- , GHC == 9.2.1 extra-source-files: example/example.cabal example/src/Example.hs@@ -77,6 +67,10 @@ test/integration/custom-package-conf/foo/doctest-foo.cabal test/integration/custom-package-conf/foo/Foo.hs test/integration/dos-line-endings/Fib.hs+ test/integration/fail-fast/Bar.hs+ test/integration/fail-fast/Foo.hs+ test/integration/fail-fast/SetupBar.hs+ test/integration/fail-fast/SetupFoo.hs test/integration/failing-multiple/Foo.hs test/integration/failing/Foo.hs test/integration/it/Foo.hs@@ -111,23 +105,44 @@ test/integration/with-cbits/Bar.hs test/integration/with-cbits/foo.c CHANGES.markdown- README.markdown+ README.md source-repository head type: git location: https://github.com/sol/doctest +flag cabal-doctest+ description: Install (experimental) cabal-doctest executable+ manual: True+ default: False+ library ghc-options: -Wall hs-source-dirs: src- ghci-wrapper/src+ default-extensions:+ NamedFieldPuns+ RecordWildCards+ DeriveFunctor+ NoImplicitPrelude exposed-modules: Test.DocTest+ Test.DocTest.Internal.Extract+ Test.DocTest.Internal.Location+ Test.DocTest.Internal.Parse+ Test.DocTest.Internal.Run+ Test.DocTest.Internal.Cabal other-modules:+ Cabal+ Cabal.Options+ Cabal.Paths+ Cabal.ReplOptions Extract GhcUtil+ Imports+ Info Interpreter+ Language.Haskell.GhciWrapper Location Options PackageDBs@@ -137,74 +152,82 @@ Runner Runner.Example Util- Language.Haskell.GhciWrapper+ Paths_doctest build-depends:- base >=4.5 && <5- , base-compat >=0.7.0+ base >=4.12 && <5 , code-page >=0.1+ , containers , deepseq , directory , exceptions , filepath- , ghc >=7.0 && <9.3+ , ghc >=8.6 && <9.16 , ghc-paths >=0.1.0.9 , process , syb >=0.3+ , temporary , transformers default-language: Haskell2010+ if impl(ghc >= 9.0)+ ghc-options: -fwarn-unused-packages+ if impl(ghc >= 9.8)+ ghc-options: -fno-warn-x-partial -executable doctest- main-is: Main.hs+executable cabal-doctest+ main-is: driver/cabal-doctest.hs+ other-modules:+ Paths_doctest+ default-extensions:+ NamedFieldPuns+ RecordWildCards+ DeriveFunctor+ NoImplicitPrelude ghc-options: -Wall -threaded- hs-source-dirs:- driver build-depends:- base >=4.5 && <5- , base-compat >=0.7.0- , code-page >=0.1- , deepseq- , directory+ base >=4.12 && <5 , doctest- , exceptions- , filepath- , ghc >=7.0 && <9.3- , ghc-paths >=0.1.0.9- , process- , syb >=0.3- , transformers default-language: Haskell2010+ if impl(ghc >= 9.0)+ ghc-options: -fwarn-unused-packages+ if impl(ghc >= 9.8)+ ghc-options: -fno-warn-x-partial+ if flag(cabal-doctest)+ buildable: True+ else+ buildable: False -test-suite doctests- main-is: doctests.hs- type: exitcode-stdio-1.0+executable doctest+ main-is: driver/doctest.hs+ other-modules:+ Paths_doctest ghc-options: -Wall -threaded- hs-source-dirs:- test+ default-extensions:+ NamedFieldPuns+ RecordWildCards+ DeriveFunctor+ NoImplicitPrelude build-depends:- base >=4.5 && <5- , base-compat >=0.7.0- , code-page >=0.1- , deepseq- , directory+ base >=4.12 && <5 , doctest- , exceptions- , filepath- , ghc >=7.0 && <9.3- , ghc-paths >=0.1.0.9- , process- , syb >=0.3- , transformers default-language: Haskell2010+ if impl(ghc >= 9.0)+ ghc-options: -fwarn-unused-packages+ if impl(ghc >= 9.8)+ ghc-options: -fno-warn-x-partial test-suite spec main-is: Spec.hs other-modules:+ Cabal.OptionsSpec+ Cabal.PathsSpec+ Cabal.ReplOptionsSpec ExtractSpec+ InfoSpec InterpreterSpec+ Language.Haskell.GhciWrapperSpec LocationSpec MainSpec OptionsSpec- Orphans PackageDBsSpec ParseSpec PropertySpec@@ -212,9 +235,16 @@ RunnerSpec RunSpec UtilSpec+ Cabal+ Cabal.Options+ Cabal.Paths+ Cabal.ReplOptions Extract GhcUtil+ Imports+ Info Interpreter+ Language.Haskell.GhciWrapper Location Options PackageDBs@@ -224,15 +254,24 @@ Runner Runner.Example Test.DocTest+ Test.DocTest.Internal.Cabal+ Test.DocTest.Internal.Extract+ Test.DocTest.Internal.Location+ Test.DocTest.Internal.Parse+ Test.DocTest.Internal.Run Util- Language.Haskell.GhciWrapper+ Paths_doctest type: exitcode-stdio-1.0 ghc-options: -Wall -threaded cpp-options: -DTEST hs-source-dirs: test src- ghci-wrapper/src+ default-extensions:+ NamedFieldPuns+ RecordWildCards+ DeriveFunctor+ NoImplicitPrelude c-sources: test/integration/with-cbits/foo.c build-tool-depends:@@ -240,22 +279,26 @@ build-depends: HUnit , QuickCheck >=2.13.1- , base >=4.5 && <5- , base-compat >=0.7.0+ , base >=4.12 && <5 , code-page >=0.1+ , containers , deepseq , directory , exceptions , filepath- , ghc >=7.0 && <9.3+ , ghc >=8.6 && <9.16 , ghc-paths >=0.1.0.9 , hspec >=2.3.0 , hspec-core >=2.3.0 , mockery , process- , setenv , silently >=1.2.4 , stringbuilder >=0.4 , syb >=0.3+ , temporary , transformers default-language: Haskell2010+ if impl(ghc >= 9.0)+ ghc-options: -fwarn-unused-packages+ if impl(ghc >= 9.8)+ ghc-options: -fno-warn-x-partial
− driver/Main.hs
@@ -1,6 +0,0 @@-module Main (main) where-import Test.DocTest-import System.Environment (getArgs)--main :: IO ()-main = getArgs >>= doctest
+ driver/cabal-doctest.hs view
@@ -0,0 +1,8 @@+module Main (main) where++import Prelude+import qualified Test.DocTest.Internal.Cabal as Cabal+import System.Environment (getArgs)++main :: IO ()+main = getArgs >>= Cabal.doctest
+ driver/doctest.hs view
@@ -0,0 +1,8 @@+module Main (main) where++import Prelude+import Test.DocTest+import System.Environment (getArgs)++main :: IO ()+main = getArgs >>= doctest
− ghci-wrapper/src/Language/Haskell/GhciWrapper.hs
@@ -1,146 +0,0 @@-{-# LANGUAGE RecordWildCards #-}-module Language.Haskell.GhciWrapper (- Interpreter-, Config(..)-, defaultConfig-, new-, close-, eval-, evalIt-, evalEcho-) where--import System.IO hiding (stdin, stdout, stderr)-import System.Process-import System.Exit-import Control.Monad-import Control.Exception-import Data.List (isSuffixOf)-import Data.Maybe--data Config = Config {- configGhci :: String-, configVerbose :: Bool-, configIgnoreDotGhci :: Bool-} deriving (Eq, Show)--defaultConfig :: Config-defaultConfig = Config {- configGhci = "ghci"-, configVerbose = False-, configIgnoreDotGhci = True-}---- | Truly random marker, used to separate expressions.------ IMPORTANT: This module relies upon the fact that this marker is unique. It--- has been obtained from random.org. Do not expect this module to work--- properly, if you reuse it for any purpose!-marker :: String-marker = show "dcbd2a1e20ae519a1c7714df2859f1890581d57fac96ba3f499412b2f5c928a1"--itMarker :: String-itMarker = "d42472243a0e6fc481e7514cbc9eb08812ed48daa29ca815844d86010b1d113a"--data Interpreter = Interpreter {- hIn :: Handle- , hOut :: Handle- , process :: ProcessHandle- }--new :: Config -> [String] -> IO Interpreter-new Config{..} args_ = do- (Just stdin_, Just stdout_, Nothing, processHandle ) <- createProcess $ (proc configGhci args) {std_in = CreatePipe, std_out = CreatePipe, std_err = Inherit}- setMode stdin_- setMode stdout_- let interpreter = Interpreter {hIn = stdin_, hOut = stdout_, process = processHandle}- _ <- eval interpreter "import qualified System.IO"- _ <- eval interpreter "import qualified GHC.IO.Handle"- -- The buffering of stdout and stderr is NoBuffering- _ <- eval interpreter "GHC.IO.Handle.hDuplicateTo System.IO.stdout System.IO.stderr"- -- Now the buffering of stderr is BlockBuffering Nothing- -- In this situation, GHC 7.7 does not flush the buffer even when- -- error happens.- _ <- eval interpreter "GHC.IO.Handle.hSetBuffering System.IO.stdout GHC.IO.Handle.LineBuffering"- _ <- eval interpreter "GHC.IO.Handle.hSetBuffering System.IO.stderr GHC.IO.Handle.LineBuffering"-- -- this is required on systems that don't use utf8 as default encoding (e.g.- -- Windows)- _ <- eval interpreter "GHC.IO.Handle.hSetEncoding System.IO.stdout GHC.IO.Handle.utf8"- _ <- eval interpreter "GHC.IO.Handle.hSetEncoding System.IO.stderr GHC.IO.Handle.utf8"-- _ <- eval interpreter ":m - System.IO"- _ <- eval interpreter ":m - GHC.IO.Handle"-- return interpreter- where- args = args_ ++ catMaybes [- if configIgnoreDotGhci then Just "-ignore-dot-ghci" else Nothing- , if configVerbose then Nothing else Just "-v0"- ]- setMode h = do- hSetBinaryMode h False- hSetBuffering h LineBuffering- hSetEncoding h utf8--close :: Interpreter -> IO ()-close repl = do- hClose $ hIn repl-- -- It is crucial not to close `hOut` before calling `waitForProcess`,- -- otherwise ghci may not cleanly terminate on SIGINT (ctrl-c) and hang- -- around consuming 100% CPU. This happens when ghci tries to print- -- something to stdout in its signal handler (e.g. when it is blocked in- -- threadDelay it writes "Interrupted." on SIGINT).- e <- waitForProcess $ process repl- hClose $ hOut repl-- when (e /= ExitSuccess) $ do- throwIO (userError $ "Language.Haskell.GhciWrapper.close: Interpreter exited with an error (" ++ show e ++ ")")--putExpression :: Interpreter -> Bool -> String -> IO ()-putExpression Interpreter{hIn = stdin} preserveIt e = do- hPutStrLn stdin e- when preserveIt $ hPutStrLn stdin $ "let " ++ itMarker ++ " = it"- hPutStrLn stdin (marker ++ " :: Data.String.String")- when preserveIt $ hPutStrLn stdin $ "let it = " ++ itMarker- hFlush stdin--getResult :: Bool -> Interpreter -> IO String-getResult echoMode Interpreter{hOut = stdout} = go- where- go = do- line <- hGetLine stdout- if marker `isSuffixOf` line- then do- let xs = stripMarker line- echo xs- return xs- else do- echo (line ++ "\n")- result <- go- return (line ++ "\n" ++ result)- stripMarker l = take (length l - length marker) l-- echo :: String -> IO ()- echo- | echoMode = putStr- | otherwise = (const $ return ())---- | Evaluate an expression-eval :: Interpreter -> String -> IO String-eval repl expr = do- putExpression repl False expr- getResult False repl---- | Like 'eval', but try to preserve the @it@ variable-evalIt :: Interpreter -> String -> IO String-evalIt repl expr = do- putExpression repl True expr- getResult False repl---- | Evaluate an expression-evalEcho :: Interpreter -> String -> IO String-evalEcho repl expr = do- putExpression repl False expr- getResult True repl
+ src/Cabal.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE LambdaCase #-}+module Cabal (externalCommand) where++import Imports++import Data.List+import Data.Version (makeVersion)+import System.IO+import System.IO.Temp+import System.Environment+import System.Directory+import System.FilePath+import System.Process++import qualified Info+import Cabal.Paths+import Cabal.Options++externalCommand :: [String] -> IO ()+externalCommand args = do+ lookupEnv "CABAL" >>= \ case+ Nothing -> run "cabal" args+ Just cabal -> run cabal (drop 1 args)++run :: String -> [String] -> IO ()+run cabal args = do+ rejectUnsupportedOptions args++ Paths{..} <- paths cabal (discardReplOptions args)++ let+ doctest = cache </> "doctest" <> "-" <> Info.version+ script = cache </> "init-ghci-" <> Info.version++ doesFileExist doctest >>= \ case+ True -> pass+ False -> callProcess cabal [+ "install" , "doctest-" <> Info.version+ , "--flag", "-cabal-doctest"+ , "--ignore-project"+ , "--installdir", cache+ , "--program-suffix", "-" <> Info.version+ , "--install-method=copy"+ , "--with-compiler", ghc+ ]++ doesFileExist script >>= \ case+ True -> pass+ False -> writeFileAtomically script ":seti -w -Wdefault"++ callProcess doctest ["--version"]++ let+ repl extraArgs = call cabal ("repl"+ : "--build-depends=QuickCheck"+ : "--build-depends=template-haskell"+ : ("--repl-options=-ghci-script=" <> script)+ : args ++ extraArgs)++ case ghcVersion < makeVersion [9,4] of+ True -> do+ callProcess cabal ("build" : "--only-dependencies" : discardReplOptions args)+ repl ["--with-compiler", doctest, "--with-hc-pkg", ghcPkg]++ False -> do+ withSystemTempDirectory "cabal-doctest" $ \ dir -> do+ repl ["--keep-temp-files", "--repl-multi-file", dir]+ files <- filter (isSuffixOf "-inplace") <$> listDirectory dir+ let options = concatMap (\ file -> ["-unit", '@' : dir </> file]) files+ call doctest ("--no-magic" : options)++writeFileAtomically :: FilePath -> String -> IO ()+writeFileAtomically name contents = do+ (tmp, h) <- openTempFile (takeDirectory name) (takeFileName name)+ hPutStr h contents+ hClose h+ renameFile tmp name
+ src/Cabal/Options.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+module Cabal.Options (+ rejectUnsupportedOptions+, discardReplOptions++#ifdef TEST+, replOnlyOptions+#endif+) where++import Imports++import System.Exit+import System.Console.GetOpt++import Data.Set (Set)+import qualified Data.Set as Set++import qualified Cabal.ReplOptions as Repl++replOnlyOptions :: Set String+replOnlyOptions = Set.fromList [+ "-z"+ , "--ignore-project"+ , "--repl-no-load"+ , "--repl-options"+ , "--repl-multi-file"+ , "-b"+ , "--build-depends"+ , "--no-transitive-deps"+ , "--enable-multi-repl"+ , "--disable-multi-repl"+ , "--with-repl"+ ]++rejectUnsupportedOptions :: [String] -> IO ()+rejectUnsupportedOptions args = case getOpt' Permute options args of+ (xs, _, _, _) | ListOptions `elem` xs -> do+ let+ names :: [String]+ names = concat [map (\ c -> ['-', c]) short ++ map ("--" <> ) long | Option short long _ _ <- documentedOptions]+ putStr (unlines names)+ exitSuccess+ (_, _, unsupported : _, _) -> do+ die $ "Error: cabal: unrecognized 'doctest' option `" <> unsupported <> "'"+ _ -> pass++data Argument = Argument String (Maybe String) | ListOptions+ deriving (Eq, Show)++options :: [OptDescr Argument]+options =+ Option [] ["list-options"] (NoArg ListOptions) ""+ : documentedOptions++documentedOptions :: [OptDescr Argument]+documentedOptions = map toOptDescr Repl.options+ where+ toOptDescr :: Repl.Option -> OptDescr Argument+ toOptDescr (Repl.Option long short arg help) = Option (maybeToList short) [long] (toArgDescr long arg) help++ toArgDescr :: String -> Repl.Argument -> ArgDescr Argument+ toArgDescr long = \ case+ Repl.Argument name -> ReqArg (argument . Just) name+ Repl.NoArgument -> NoArg (argument Nothing)+ Repl.OptionalArgument name -> OptArg argument name+ where+ argument :: Maybe String -> Argument+ argument value = Argument ("--" <> long) value++discardReplOptions :: [String] -> [String]+discardReplOptions args = case getOpt Permute options args of+ (xs, _, _) -> [renderArgument name value | Argument name value <- xs, Set.notMember name replOnlyOptions]+ where+ renderArgument name = \ case+ Nothing -> name+ Just value -> name <> "=" <> value
+ src/Cabal/Paths.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE StrictData #-}+module Cabal.Paths (+ Paths(..)+, paths+) where++import Imports++import Data.Char+import Data.Tuple+import Data.Version hiding (parseVersion)+import qualified Data.Version as Version+import System.Exit hiding (die)+import System.Directory+import System.FilePath+import System.IO+import System.Process+import Text.ParserCombinators.ReadP++data Paths = Paths {+ ghcVersion :: Version+, ghc :: FilePath+, ghcPkg :: FilePath+, cache :: FilePath+} deriving (Eq, Show)++paths :: FilePath -> [String] -> IO Paths+paths cabal args = do+ cabalVersion <- strip <$> readProcess cabal ["--numeric-version"] ""++ let+ required :: Version+ required = makeVersion [3, 12]++ when (parseVersion cabalVersion < Just required) $ do+ die $ "'cabal-install' version " <> showVersion required <> " or later is required, but 'cabal --numeric-version' returned " <> cabalVersion <> "."++ values <- parseFields <$> readProcess cabal ("path" : args ++ ["-v0"]) ""++ let+ getPath :: String -> String -> IO FilePath+ getPath subject key = case lookup key values of+ Nothing -> die $ "Cannot determine the path to " <> subject <> ". Running 'cabal path' did not return a value for '" <> key <> "'."+ Just path -> canonicalizePath path++ ghc <- getPath "'ghc'" "compiler-path"++ ghcVersionString <- strip <$> readProcess ghc ["--numeric-version"] ""++ ghcVersion <- case parseVersion ghcVersionString of+ Nothing -> die $ "Cannot determine GHC version from '" <> ghcVersionString <> "'."+ Just version -> return version++ let+ ghcPkg :: FilePath+ ghcPkg = takeDirectory ghc </> "ghc-pkg-" <> ghcVersionString+#ifdef mingw32_HOST_OS+ <.> "exe"+#endif++ doesFileExist ghcPkg >>= \ case+ True -> pass+ False -> die $ "Cannot determine the path to 'ghc-pkg' from '" <> ghc <> "'. File '" <> ghcPkg <> "' does not exist."++ abi <- strip <$> readProcess ghcPkg ["--no-user-package-db", "field", "base", "abi", "--simple-output"] ""++ cache_home <- getPath "Cabal's cache directory" "cache-home"+ let cache = cache_home </> "doctest" </> "ghc-" <> ghcVersionString <> "-" <> abi++ createDirectoryIfMissing True cache++ return Paths {+ ghcVersion+ , ghc+ , ghcPkg+ , cache+ }+ where+ parseFields :: String -> [(String, FilePath)]+ parseFields = map parseField . lines++ parseField :: String -> (String, FilePath)+ parseField input = case break (== ':') input of+ (key, ':' : value) -> (key, dropWhile isSpace value)+ (key, _) -> (key, "")++die :: String -> IO a+die message = do+ hPutStrLn stderr "Error: [cabal-doctest]"+ hPutStrLn stderr message+ exitFailure++parseVersion :: String -> Maybe Version+parseVersion = lookup "" . map swap . readP_to_S Version.parseVersion
+ src/Cabal/ReplOptions.hs view
@@ -0,0 +1,195 @@+module Cabal.ReplOptions (+ Option(..)+, Argument(..)+, options+) where++import Imports++data Option = Option {+ optionName :: String+, optionShortName :: Maybe Char+, optionArgument :: Argument+, optionHelp :: String+} deriving (Eq, Show)++data Argument = Argument String | NoArgument | OptionalArgument String+ deriving (Eq, Show)++options :: [Option]+options = [+ Option "help" (Just 'h') NoArgument "Show this help text"+ , Option "verbose" (Just 'v') (OptionalArgument "n") "Control verbosity (n is 0--3, default verbosity level is 1)"+ , Option "builddir" Nothing (Argument "DIR") "The directory where Cabal puts generated build files (default dist)"+ , Option "keep-temp-files" Nothing NoArgument "Keep temporary files."+ , Option "ghc" (Just 'g') NoArgument "compile with GHC"+ , Option "ghcjs" Nothing NoArgument "compile with GHCJS"+ , Option "uhc" Nothing NoArgument "compile with UHC"+ , Option "with-compiler" (Just 'w') (Argument "PATH") "give the path to a particular compiler"+ , Option "with-hc-pkg" Nothing (Argument "PATH") "give the path to the package tool"+ , Option "prefix" Nothing (Argument "DIR") "bake this prefix in preparation of installation"+ , Option "bindir" Nothing (Argument "DIR") "installation directory for executables"+ , Option "libdir" Nothing (Argument "DIR") "installation directory for libraries"+ , Option "libsubdir" Nothing (Argument "DIR") "subdirectory of libdir in which libs are installed"+ , Option "dynlibdir" Nothing (Argument "DIR") "installation directory for dynamic libraries"+ , Option "libexecdir" Nothing (Argument "DIR") "installation directory for program executables"+ , Option "libexecsubdir" Nothing (Argument "DIR") "subdirectory of libexecdir in which private executables are installed"+ , Option "datadir" Nothing (Argument "DIR") "installation directory for read-only data"+ , Option "datasubdir" Nothing (Argument "DIR") "subdirectory of datadir in which data files are installed"+ , Option "docdir" Nothing (Argument "DIR") "installation directory for documentation"+ , Option "htmldir" Nothing (Argument "DIR") "installation directory for HTML documentation"+ , Option "haddockdir" Nothing (Argument "DIR") "installation directory for haddock interfaces"+ , Option "sysconfdir" Nothing (Argument "DIR") "installation directory for configuration files"+ , Option "program-prefix" Nothing (Argument "PREFIX") "prefix to be applied to installed executables"+ , Option "program-suffix" Nothing (Argument "SUFFIX") "suffix to be applied to installed executables"+ , Option "enable-library-vanilla" Nothing NoArgument "Enable Vanilla libraries"+ , Option "disable-library-vanilla" Nothing NoArgument "Disable Vanilla libraries"+ , Option "enable-library-profiling" (Just 'p') NoArgument "Enable Library profiling"+ , Option "disable-library-profiling" Nothing NoArgument "Disable Library profiling"+ , Option "enable-shared" Nothing NoArgument "Enable Shared library"+ , Option "disable-shared" Nothing NoArgument "Disable Shared library"+ , Option "enable-static" Nothing NoArgument "Enable Static library"+ , Option "disable-static" Nothing NoArgument "Disable Static library"+ , Option "enable-executable-dynamic" Nothing NoArgument "Enable Executable dynamic linking"+ , Option "disable-executable-dynamic" Nothing NoArgument "Disable Executable dynamic linking"+ , Option "enable-executable-static" Nothing NoArgument "Enable Executable fully static linking"+ , Option "disable-executable-static" Nothing NoArgument "Disable Executable fully static linking"+ , Option "enable-profiling" Nothing NoArgument "Enable Executable and library profiling"+ , Option "disable-profiling" Nothing NoArgument "Disable Executable and library profiling"+ , Option "enable-profiling-shared" Nothing NoArgument "Enable Build profiling shared libraries"+ , Option "disable-profiling-shared" Nothing NoArgument "Disable Build profiling shared libraries"+ , Option "enable-executable-profiling" Nothing NoArgument "Enable Executable profiling (DEPRECATED)"+ , Option "disable-executable-profiling" Nothing NoArgument "Disable Executable profiling (DEPRECATED)"+ , Option "profiling-detail" Nothing (Argument "level") "Profiling detail level for executable and library (default, none, exported-functions, toplevel-functions, all-functions, late)."+ , Option "library-profiling-detail" Nothing (Argument "level") "Profiling detail level for libraries only."+ , Option "enable-optimization" (Just 'O') (OptionalArgument "n") "Build with optimization (n is 0--2, default is 1)"+ , Option "disable-optimization" Nothing NoArgument "Build without optimization"+ , Option "enable-debug-info" Nothing (OptionalArgument "n") "Emit debug info (n is 0--3, default is 0)"+ , Option "disable-debug-info" Nothing NoArgument "Don't emit debug info"+ , Option "enable-build-info" Nothing NoArgument "Enable build information generation during project building"+ , Option "disable-build-info" Nothing NoArgument "Disable build information generation during project building"+ , Option "enable-library-for-ghci" Nothing NoArgument "Enable compile library for use with GHCi"+ , Option "disable-library-for-ghci" Nothing NoArgument "Disable compile library for use with GHCi"+ , Option "enable-split-sections" Nothing NoArgument "Enable compile library code such that unneeded definitions can be dropped from the final executable (GHC 7.8+)"+ , Option "disable-split-sections" Nothing NoArgument "Disable compile library code such that unneeded definitions can be dropped from the final executable (GHC 7.8+)"+ , Option "enable-split-objs" Nothing NoArgument "Enable split library into smaller objects to reduce binary sizes (GHC 6.6+)"+ , Option "disable-split-objs" Nothing NoArgument "Disable split library into smaller objects to reduce binary sizes (GHC 6.6+)"+ , Option "enable-executable-stripping" Nothing NoArgument "Enable strip executables upon installation to reduce binary sizes"+ , Option "disable-executable-stripping" Nothing NoArgument "Disable strip executables upon installation to reduce binary sizes"+ , Option "enable-library-stripping" Nothing NoArgument "Enable strip libraries upon installation to reduce binary sizes"+ , Option "disable-library-stripping" Nothing NoArgument "Disable strip libraries upon installation to reduce binary sizes"+ , Option "configure-option" Nothing (Argument "OPT") "Extra option for configure"+ , Option "user" Nothing NoArgument "Enable doing a per-user installation"+ , Option "global" Nothing NoArgument "Disable doing a per-user installation"+ , Option "package-db" Nothing (Argument "DB") "Append the given package database to the list of package databases used (to satisfy dependencies and register into). May be a specific file, 'global' or 'user'. The initial list is ['global'], ['global', 'user'], or ['global', $sandbox], depending on context. Use 'clear' to reset the list to empty. See the user guide for details."+ , Option "flags" (Just 'f') (Argument "FLAGS") "Force values for the given flags in Cabal conditionals in the .cabal file. E.g., --flags=\"debug -usebytestrings\" forces the flag \"debug\" to true and \"usebytestrings\" to false."+ , Option "extra-include-dirs" Nothing (Argument "PATH") "A list of directories to search for header files"+ , Option "enable-deterministic" Nothing NoArgument "Enable Try to be as deterministic as possible (used by the test suite)"+ , Option "disable-deterministic" Nothing NoArgument "Disable Try to be as deterministic as possible (used by the test suite)"+ , Option "ipid" Nothing (Argument "IPID") "Installed package ID to compile this package as"+ , Option "cid" Nothing (Argument "CID") "Installed component ID to compile this component as"+ , Option "extra-lib-dirs" Nothing (Argument "PATH") "A list of directories to search for external libraries"+ , Option "extra-lib-dirs-static" Nothing (Argument "PATH") "A list of directories to search for external libraries when linking fully static executables"+ , Option "extra-framework-dirs" Nothing (Argument "PATH") "A list of directories to search for external frameworks (OS X only)"+ , Option "extra-prog-path" Nothing (Argument "PATH") "A list of directories to search for required programs (in addition to the normal search locations)"+ , Option "instantiate-with" Nothing (Argument "NAME=MOD") "A mapping of signature names to concrete module instantiations."+ , Option "enable-tests" Nothing NoArgument "Enable dependency checking and compilation for test suites listed in the package description file."+ , Option "disable-tests" Nothing NoArgument "Disable dependency checking and compilation for test suites listed in the package description file."+ , Option "enable-coverage" Nothing NoArgument "Enable build package with Haskell Program Coverage. (GHC only)"+ , Option "disable-coverage" Nothing NoArgument "Disable build package with Haskell Program Coverage. (GHC only)"+ , Option "enable-library-coverage" Nothing NoArgument "Enable build package with Haskell Program Coverage. (GHC only) (DEPRECATED)"+ , Option "disable-library-coverage" Nothing NoArgument "Disable build package with Haskell Program Coverage. (GHC only) (DEPRECATED)"+ , Option "enable-benchmarks" Nothing NoArgument "Enable dependency checking and compilation for benchmarks listed in the package description file."+ , Option "disable-benchmarks" Nothing NoArgument "Disable dependency checking and compilation for benchmarks listed in the package description file."+ , Option "enable-relocatable" Nothing NoArgument "Enable building a package that is relocatable. (GHC only)"+ , Option "disable-relocatable" Nothing NoArgument "Disable building a package that is relocatable. (GHC only)"+ , Option "disable-response-files" Nothing NoArgument "enable workaround for old versions of programs like \"ar\" that do not support @file arguments"+ , Option "allow-depending-on-private-libs" Nothing NoArgument "Allow depending on private libraries. If set, the library visibility check MUST be done externally."+ , Option "coverage-for" Nothing (Argument "UNITID") "A list of unit-ids of libraries to include in the Haskell Program Coverage report."+ , Option "ignore-build-tools" Nothing NoArgument "Ignore build tool dependencies. If set, declared build tools needn't be found for compilation to proceed."+ , Option "cabal-lib-version" Nothing (Argument "VERSION") "Select which version of the Cabal lib to use to build packages (useful for testing)."+ , Option "enable-append" Nothing NoArgument "Enable appending the new config to the old config file"+ , Option "disable-append" Nothing NoArgument "Disable appending the new config to the old config file"+ , Option "enable-backup" Nothing NoArgument "Enable the backup of the config file before any alterations"+ , Option "disable-backup" Nothing NoArgument "Disable the backup of the config file before any alterations"+ , Option "constraint" (Just 'c') (Argument "CONSTRAINT") "Specify constraints on a package (version, installed/source, flags)"+ , Option "preference" Nothing (Argument "CONSTRAINT") "Specify preferences (soft constraints) on the version of a package"+ , Option "solver" Nothing (Argument "SOLVER") "Select dependency solver to use (default: modular). Choices: modular."+ , Option "allow-older" Nothing (OptionalArgument "DEPS") "Ignore lower bounds in all dependencies or DEPS"+ , Option "allow-newer" Nothing (OptionalArgument "DEPS") "Ignore upper bounds in all dependencies or DEPS"+ , Option "write-ghc-environment-files" Nothing (Argument "always|never|ghc8.4.4+") "Whether to create a .ghc.environment file after a successful build (v2-build only)"+ , Option "enable-documentation" Nothing NoArgument "Enable building of documentation"+ , Option "disable-documentation" Nothing NoArgument "Disable building of documentation"+ , Option "doc-index-file" Nothing (Argument "TEMPLATE") "A central index of haddock API documentation (template cannot use $pkgid)"+ , Option "dry-run" Nothing NoArgument "Do not install anything, only print what would be installed."+ , Option "only-download" Nothing NoArgument "Do not build anything, only fetch the packages."+ , Option "max-backjumps" Nothing (Argument "NUM") "Maximum number of backjumps allowed while solving (default: 4000). Use a negative number to enable unlimited backtracking. Use 0 to disable backtracking completely."+ , Option "reorder-goals" Nothing NoArgument "Try to reorder goals according to certain heuristics. Slows things down on average, but may make backtracking faster for some packages."+ , Option "count-conflicts" Nothing NoArgument "Try to speed up solving by preferring goals that are involved in a lot of conflicts (default)."+ , Option "fine-grained-conflicts" Nothing NoArgument "Skip a version of a package if it does not resolve the conflicts encountered in the last version, as a solver optimization (default)."+ , Option "minimize-conflict-set" Nothing NoArgument "When there is no solution, try to improve the error message by finding a minimal conflict set (default: false). May increase run time significantly."+ , Option "independent-goals" Nothing NoArgument "Treat several goals on the command line as independent. If several goals depend on the same package, different versions can be chosen."+ , Option "prefer-oldest" Nothing NoArgument "Prefer the oldest (instead of the latest) versions of packages available. Useful to determine lower bounds in the build-depends section."+ , Option "shadow-installed-packages" Nothing NoArgument "If multiple package instances of the same version are installed, treat all but one as shadowed."+ , Option "strong-flags" Nothing NoArgument "Do not defer flag choices (this used to be the default in cabal-install <= 1.20)."+ , Option "allow-boot-library-installs" Nothing NoArgument "Allow cabal to install base, ghc-prim, integer-simple, integer-gmp, and template-haskell."+ , Option "reject-unconstrained-dependencies" Nothing (Argument "none|all") "Require these packages to have constraints on them if they are to be selected (default: none)."+ , Option "reinstall" Nothing NoArgument "Install even if it means installing the same version again."+ , Option "avoid-reinstalls" Nothing NoArgument "Do not select versions that would destructively overwrite installed packages."+ , Option "force-reinstalls" Nothing NoArgument "Reinstall packages even if they will most likely break other installed packages."+ , Option "upgrade-dependencies" Nothing NoArgument "Pick the latest version for all dependencies, rather than trying to pick an installed version."+ , Option "only-dependencies" Nothing NoArgument "Install only the dependencies necessary to build the given packages"+ , Option "dependencies-only" Nothing NoArgument "A synonym for --only-dependencies"+ , Option "index-state" Nothing (Argument "STATE") "Use source package index state as it existed at a previous time. Accepts unix-timestamps (e.g. '@1474732068'), ISO8601 UTC timestamps (e.g. '2016-09-24T17:47:48Z'), or 'HEAD' (default: 'HEAD')."+ , Option "root-cmd" Nothing (Argument "COMMAND") "(No longer supported, do not use.)"+ , Option "build-summary" Nothing (Argument "TEMPLATE") "Save build summaries to file (name template can use $pkgid, $compiler, $os, $arch)"+ , Option "build-log" Nothing (Argument "TEMPLATE") "Log all builds to file (name template can use $pkgid, $compiler, $os, $arch)"+ , Option "remote-build-reporting" Nothing (Argument "LEVEL") "Generate build reports to send to a remote server (none, anonymous or detailed)."+ , Option "report-planning-failure" Nothing NoArgument "Generate build reports when the dependency solver fails. This is used by the Hackage build bot."+ , Option "enable-per-component" Nothing NoArgument "Enable Per-component builds when possible"+ , Option "disable-per-component" Nothing NoArgument "Disable Per-component builds when possible"+ , Option "run-tests" Nothing NoArgument "Run package test suites during installation."+ , Option "semaphore" Nothing NoArgument "Use a semaphore so GHC can compile components in parallel"+ , Option "jobs" (Just 'j') (OptionalArgument "NUM") "Run NUM jobs simultaneously (or '$ncpus' if no NUM is given)."+ , Option "keep-going" Nothing NoArgument "After a build failure, continue to build other unaffected packages."+ , Option "offline" Nothing NoArgument "Don't download packages from the Internet."+ , Option "haddock-hoogle" Nothing NoArgument "Generate a hoogle database"+ , Option "haddock-html" Nothing NoArgument "Generate HTML documentation (the default)"+ , Option "haddock-html-location" Nothing (Argument "URL") "Location of HTML documentation for pre-requisite packages"+ , Option "haddock-for-hackage" Nothing NoArgument "Collection of flags to generate documentation suitable for upload to hackage"+ , Option "haddock-executables" Nothing NoArgument "Run haddock for Executables targets"+ , Option "haddock-tests" Nothing NoArgument "Run haddock for Test Suite targets"+ , Option "haddock-benchmarks" Nothing NoArgument "Run haddock for Benchmark targets"+ , Option "haddock-all" Nothing NoArgument "Run haddock for all targets"+ , Option "haddock-internal" Nothing NoArgument "Run haddock for internal modules and include all symbols"+ , Option "haddock-css" Nothing (Argument "PATH") "Use PATH as the haddock stylesheet"+ , Option "haddock-hyperlink-source" Nothing NoArgument "Hyperlink the documentation to the source code"+ , Option "haddock-quickjump" Nothing NoArgument "Generate an index for interactive documentation navigation"+ , Option "haddock-hscolour-css" Nothing (Argument "PATH") "Use PATH as the HsColour stylesheet"+ , Option "haddock-contents-location" Nothing (Argument "URL") "Bake URL in as the location for the contents page"+ , Option "haddock-base-url" Nothing (Argument "URL") "Base URL for static files."+ , Option "haddock-resources-dir" Nothing (Argument "DIR") "location of Haddocks static / auxiliary files"+ , Option "haddock-output-dir" Nothing (Argument "DIR") "Generate haddock documentation into this directory. This flag is provided as a technology preview and is subject to change in the next releases."+ , Option "haddock-use-unicode" Nothing NoArgument "Pass --use-unicode option to haddock"+ , Option "test-log" Nothing (Argument "TEMPLATE") "Log all test suite results to file (name template can use $pkgid, $compiler, $os, $arch, $test-suite, $result)"+ , Option "test-machine-log" Nothing (Argument "TEMPLATE") "Produce a machine-readable log file (name template can use $pkgid, $compiler, $os, $arch, $result)"+ , Option "test-show-details" Nothing (Argument "FILTER") "'always': always show results of individual test cases. 'never': never show results of individual test cases. 'failures': show results of failing test cases. 'streaming': show results of test cases in real time.'direct': send results of test cases in real time; no log file."+ , Option "test-keep-tix-files" Nothing NoArgument "keep .tix files for HPC between test runs"+ , Option "test-wrapper" Nothing (Argument "FILE") "Run test through a wrapper."+ , Option "test-fail-when-no-test-suites" Nothing NoArgument "Exit with failure when no test suites are found."+ , Option "test-options" Nothing (Argument "TEMPLATES") "give extra options to test executables (split on spaces, use \"\" to prevent splitting; name templates can use $pkgid, $compiler, $os, $arch, $test-suite)"+ , Option "test-option" Nothing (Argument "TEMPLATE") "give extra option to test executables (passed directly as a single argument; name template can use $pkgid, $compiler, $os, $arch, $test-suite)"+ , Option "benchmark-options" Nothing (Argument "TEMPLATES") "give extra options to benchmark executables (split on spaces, use \"\" to prevent splitting; name templates can use $pkgid, $compiler, $os, $arch, $benchmark)"+ , Option "benchmark-option" Nothing (Argument "TEMPLATE") "give extra option to benchmark executables (passed directly as a single argument; name template can use $pkgid, $compiler, $os, $arch, $benchmark)"+ , Option "project-dir" Nothing (Argument "DIR") "Set the path of the project directory"+ , Option "project-file" Nothing (Argument "FILE") "Set the path of the cabal.project file (relative to the project directory when relative)"+ , Option "ignore-project" (Just 'z') NoArgument "Ignore local project configuration (unless --project-dir or --project-file is also set)"+ , Option "repl-no-load" Nothing NoArgument "Disable loading of project modules at REPL startup."+ , Option "repl-options" Nothing (Argument "FLAG") "Use the option(s) for the repl"+ , Option "repl-multi-file" Nothing (Argument "DIR") "Write repl options to this directory rather than starting repl mode"+ , Option "with-repl" Nothing (Argument "PATH") "Give the path to a program to use for REPL"+ , Option "build-depends" (Just 'b') (Argument "DEPENDENCIES") "Include additional packages in the environment presented to GHCi."+ , Option "no-transitive-deps" Nothing NoArgument "Don't automatically include transitive dependencies of requested packages."+ , Option "enable-multi-repl" Nothing NoArgument "Enable multi-component repl sessions"+ , Option "disable-multi-repl" Nothing NoArgument "Disable multi-component repl sessions"+ ]
src/Extract.hs view
@@ -1,25 +1,13 @@-{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-}+{-# LANGUAGE CPP #-} module Extract (Module(..), extract) where -import Prelude hiding (mod, concat)-import Control.Monad-#if __GLASGOW_HASKELL__ < 710-import Control.Applicative-#endif-import Control.Exception+import Imports hiding (mod, concat) import Data.List (partition, isSuffixOf)-import Data.Maybe-#if __GLASGOW_HASKELL__ < 710-import Data.Foldable (concat)-#endif import Control.DeepSeq (deepseq, NFData(rnf)) import Data.Generics -#if __GLASGOW_HASKELL__ < 707-import GHC hiding (flags, Module, Located)-import MonadUtils (liftIO, MonadIO)-#elif __GLASGOW_HASKELL__ < 900+#if __GLASGOW_HASKELL__ < 900 import GHC hiding (Module, Located) import DynFlags import MonadUtils (liftIO)@@ -41,15 +29,6 @@ import System.Directory import System.FilePath -#if __GLASGOW_HASKELL__ < 710-import NameSet (NameSet)-import Coercion (Coercion)-#endif--#if __GLASGOW_HASKELL__ < 805-import FastString (unpackFS)-#endif- import System.Posix.Internals (c_getpid) import GhcUtil (withGhc)@@ -58,13 +37,11 @@ import Util (convertDosLineEndings) import PackageDBs (getPackageDBArgs) -#if __GLASGOW_HASKELL__ >= 806 #if __GLASGOW_HASKELL__ < 900 import DynamicLoading (initializePlugins) #else import GHC.Runtime.Loader (initializePlugins) #endif-#endif #if __GLASGOW_HASKELL__ >= 901 import GHC.Unit.Module.Graph@@ -72,7 +49,9 @@ -- | A wrapper around `SomeException`, to allow for a custom `Show` instance. newtype ExtractError = ExtractError SomeException+#if __GLASGOW_HASKELL__ < 912 deriving Typeable+#endif instance Show ExtractError where show (ExtractError e) =@@ -97,20 +76,11 @@ moduleName :: String , moduleSetup :: Maybe a , moduleContent :: [a]-} deriving (Eq, Functor)+} deriving (Eq, Show, Functor) instance NFData a => NFData (Module a) where rnf (Module name setup content) = name `deepseq` setup `deepseq` content `deepseq` () -#if __GLASGOW_HASKELL__ < 803-type GhcPs = RdrName-#endif--#if __GLASGOW_HASKELL__ < 805-addQuoteInclude :: [String] -> [String] -> [String]-addQuoteInclude includes new = new ++ includes-#endif- -- | Parse a list of modules. parse :: [String] -> IO [ParsedModule] parse args = withGhc args $ \modules_ -> withTempOutputDir $ do@@ -125,7 +95,11 @@ Nothing) mods <- depanal [] False - let sortedMods = flattenSCCs+ let sortedMods =+#if __GLASGOW_HASKELL__ >= 914+ mapMaybe maybeModSummaryFromModuleNodeInfo $+#endif+ flattenSCCs #if __GLASGOW_HASKELL__ >= 901 $ filterToposortToModules #endif@@ -137,15 +111,11 @@ modifySessionDynFlags :: (DynFlags -> DynFlags) -> Ghc () modifySessionDynFlags f = do dflags <- getSessionDynFlags-#if __GLASGOW_HASKELL__ < 707- _ <- setSessionDynFlags (f dflags)-#else -- GHCi 7.7 now uses dynamic linking. let dflags' = case lookup "GHC Dynamic" (compilerInfo dflags) of Just "YES" -> gopt_set dflags Opt_BuildDynamicToo _ -> dflags _ <- setSessionDynFlags (f dflags')-#endif return () withTempOutputDir :: Ghc a -> Ghc a@@ -175,27 +145,19 @@ , includePaths = addQuoteInclude (includePaths d) [f] } -#if __GLASGOW_HASKELL__ >= 806 -- Since GHC 8.6, plugins are initialized on a per module basis loadModPlugins modsum = do _ <- setSessionDynFlags (GHC.ms_hspp_opts modsum) hsc_env <- getSession -# if __GLASGOW_HASKELL__ >= 903- hsc_env' <- liftIO (initializePlugins hsc_env Nothing)- setSession hsc_env'- return $ modsum-# elif __GLASGOW_HASKELL__ >= 901+# if __GLASGOW_HASKELL__ >= 902 hsc_env' <- liftIO (initializePlugins hsc_env) setSession hsc_env'- return $ modsum+ return modsum # else dynflags' <- liftIO (initializePlugins hsc_env (GHC.ms_hspp_opts modsum)) return $ modsum { ms_hspp_opts = dynflags' } # endif-#else- loadModPlugins = return-#endif -- | Extract all docstrings from given list of files/modules. --@@ -204,7 +166,15 @@ extract :: [String] -> IO [Module (Located String)] extract args = do packageDBArgs <- getPackageDBArgs- let args' = args ++ packageDBArgs+ let+ args' = args +++#if __GLASGOW_HASKELL__ >= 810+ -- `ghci` ignores unused packages in certain situation. This ensures+ -- that we don't fail in situations where `ghci` would not.+ "-Wno-unused-packages" :+#endif+ packageDBArgs+ mods <- parse args' let docs = map (fmap (fmap convertDosLineEndings) . extractFromModule) mods @@ -225,6 +195,18 @@ (setup, docs) = partition isSetup (docStringsFromModule m) name = (moduleNameString . GHC.moduleName . ms_mod . pm_mod_summary) m +#if __GLASGOW_HASKELL__ >= 914+maybeModSummaryFromModuleNodeInfo :: ModuleNodeInfo -> Maybe ModSummary+maybeModSummaryFromModuleNodeInfo i = case i of+ ModuleNodeCompile summary -> Just summary+ ModuleNodeFixed _ _ -> Nothing+#endif++#if __GLASGOW_HASKELL__ >= 904+unpackHDS :: HsDocString -> String+unpackHDS = renderHsDocString+#endif+ -- | Extract all docstrings from given module. docStringsFromModule :: ParsedModule -> [(Maybe String, Located String)] docStringsFromModule mod = map (fmap (toLocated . fmap unpackHDS)) docs@@ -232,66 +214,56 @@ source = (unLoc . pm_parsed_source) mod -- we use dlist-style concatenation here+ docs :: [(Maybe String, LHsDocString)] docs = header ++ exports ++ decls -- We process header, exports and declarations separately instead of -- traversing the whole source in a generic way, to ensure that we get -- everything in source order.+#if __GLASGOW_HASKELL__ >= 906+ header = [(Nothing, hsDocString <$> x) | Just x <- [hsmodHaddockModHeader (hsmodExt source)]]+#elif __GLASGOW_HASKELL__ >= 904+ header = [(Nothing, hsDocString <$> x) | Just x <- [hsmodHaddockModHeader (source)]]+#else header = [(Nothing, x) | Just x <- [hsmodHaddockModHeader source]]- exports = [ (Nothing, L (locA loc) doc)-#if __GLASGOW_HASKELL__ < 710- | L loc (IEDoc doc) <- concat (hsmodExports source)-#elif __GLASGOW_HASKELL__ < 805- | L loc (IEDoc doc) <- maybe [] unLoc (hsmodExports source)+#endif+ exports :: [(Maybe String, LHsDocString)]+#if __GLASGOW_HASKELL__ >= 904+ exports = [ (Nothing, L (locA loc) (hsDocString (unLoc doc))) #else- | L loc (IEDoc _ doc) <- maybe [] unLoc (hsmodExports source)+ exports = [ (Nothing, L (locA loc) doc) #endif+ | L loc (IEDoc _ doc) <- maybe [] unLoc (hsmodExports source) ]+ decls :: [(Maybe String, LHsDocString)] decls = extractDocStrings (hsmodDecls source) -type Selector a = a -> ([(Maybe String, LHsDocString)], Bool)--#if __GLASGOW_HASKELL__ < 710--- | Ignore a subtree.-ignore :: Selector a-ignore = const ([], True)-#endif---- | Collect given value and descend into subtree.-select :: a -> ([a], Bool)-select x = ([x], False)- -- | Extract all docstrings from given value. extractDocStrings :: Data a => a -> [(Maybe String, LHsDocString)]-extractDocStrings = everythingBut (++) (([], False) `mkQ` fromLHsDecl- `extQ` fromLDocDecl- `extQ` fromLHsDocString-#if __GLASGOW_HASKELL__ < 710- `extQ` (ignore :: Selector NameSet)- `extQ` (ignore :: Selector PostTcKind)-- -- HsExpr never contains any documentation, but it may contain error thunks.- --- -- Problematic are (non comprehensive):- --- -- * parallel list comprehensions- -- * infix operators- --- `extQ` (ignore :: Selector (HsExpr RdrName))-- -- undefined before type checking- `extQ` (ignore :: Selector Coercion)+extractDocStrings d =+#if __GLASGOW_HASKELL__ >= 904+ let+ docStrs = extractAll extractDocDocString d+ docStrNames = catMaybes $ extractAll extractDocName d+ in+ flip fmap docStrs $ \docStr -> (lookup (getLoc docStr) docStrNames, docStr)+ where+ extractAll z = everything (++) (mkQ [] ((:[]) . z)) -#if __GLASGOW_HASKELL__ >= 706- -- hswb_kvs and hswb_tvs may be error thunks- `extQ` (ignore :: Selector (HsWithBndrs [LHsType RdrName]))- `extQ` (ignore :: Selector (HsWithBndrs [LHsType Name]))- `extQ` (ignore :: Selector (HsWithBndrs (LHsType RdrName)))- `extQ` (ignore :: Selector (HsWithBndrs (LHsType Name)))-#endif+ extractDocDocString :: LHsDoc GhcPs -> LHsDocString+ extractDocDocString = fmap hsDocString -#endif- )+ extractDocName :: DocDecl GhcPs -> Maybe (SrcSpan, String)+ extractDocName docDecl = case docDecl of+ DocCommentNamed name y ->+ Just (getLoc y, name)+ _ ->+ Nothing+#else+ everythingBut (++) (([], False) `mkQ` fromLHsDecl+ `extQ` fromLDocDecl+ `extQ` fromLHsDocString+ ) d where fromLHsDecl :: Selector (LHsDecl GhcPs) fromLHsDecl (L loc decl) = case decl of@@ -299,11 +271,7 @@ -- Top-level documentation has to be treated separately, because it has -- no location information attached. The location information is -- attached to HsDecl instead.-#if __GLASGOW_HASKELL__ < 805- DocD x-#else DocD _ x-#endif -> select (fromDocDecl (locA loc) x) _ -> (extractDocStrings decl, True)@@ -324,10 +292,11 @@ DocCommentNamed name doc -> (Just name, L loc doc) _ -> (Nothing, L loc $ docDeclDoc x) -#if __GLASGOW_HASKELL__ < 805--- | Convert a docstring to a plain string.-unpackHDS :: HsDocString -> String-unpackHDS (HsDocString s) = unpackFS s+type Selector a = a -> ([(Maybe String, LHsDocString)], Bool)++-- | Collect given value and descend into subtree.+select :: a -> ([a], Bool)+select x = ([x], False) #endif #if __GLASGOW_HASKELL__ < 901
src/GhcUtil.hs view
@@ -1,19 +1,16 @@ {-# LANGUAGE CPP #-}-module GhcUtil (withGhc) where+{-# LANGUAGE LambdaCase #-}+module GhcUtil (withGhc, expandUnits) where +import Imports+ import GHC.Paths (libdir)-#if __GLASGOW_HASKELL__ < 707-import Control.Exception-import GHC hiding (flags)-import DynFlags (dopt_set)-#else import GHC #if __GLASGOW_HASKELL__ < 900 import DynFlags (gopt_set) #else import GHC.Driver.Session (gopt_set) #endif-#endif #if __GLASGOW_HASKELL__ < 900 import Panic (throwGhcException)@@ -27,58 +24,28 @@ import GHC.Utils.Monad (liftIO) #endif +import GHC.ResponseFile (expandResponse) import System.Exit (exitFailure) -#if __GLASGOW_HASKELL__ < 702-import StaticFlags (v_opt_C_ready)-import Data.IORef (writeIORef)-#elif __GLASGOW_HASKELL__ < 707-import StaticFlags (saveStaticFlagGlobals, restoreStaticFlagGlobals)-#elif __GLASGOW_HASKELL__ < 801-import StaticFlags (discardStaticFlags)-#endif----- | Save static flag globals, run action, and restore them.-bracketStaticFlags :: IO a -> IO a-#if __GLASGOW_HASKELL__ < 702--- GHC < 7.2 does not provide saveStaticFlagGlobals/restoreStaticFlagGlobals,--- so we need to modifying v_opt_C_ready directly-bracketStaticFlags action = action `finally` writeIORef v_opt_C_ready False-#elif __GLASGOW_HASKELL__ < 707-bracketStaticFlags action = bracket saveStaticFlagGlobals restoreStaticFlagGlobals (const action)-#else-bracketStaticFlags action = action-#endif- -- Catch GHC source errors, print them and exit. handleSrcErrors :: Ghc a -> Ghc a handleSrcErrors action' = flip handleSourceError action' $ \err -> do-#if __GLASGOW_HASKELL__ < 702- printExceptionAndWarnings err-#else printException err-#endif liftIO exitFailure -- | Run a GHC action in Haddock mode withGhc :: [String] -> ([String] -> Ghc a) -> IO a-withGhc flags action = bracketStaticFlags $ do- flags_ <- handleStaticFlags flags-- runGhc (Just libdir) $ do- handleDynamicFlags flags_ >>= handleSrcErrors . action+withGhc flags action = runGhc (Just libdir) $ do+ liftIO (expandUnits flags) >>= handleDynamicFlags >>= handleSrcErrors . action -handleStaticFlags :: [String] -> IO [Located String]-#if __GLASGOW_HASKELL__ < 707-handleStaticFlags flags = fst `fmap` parseStaticFlags (map noLoc flags)-#elif __GLASGOW_HASKELL__ < 801-handleStaticFlags flags = return $ map noLoc $ discardStaticFlags flags-#else-handleStaticFlags flags = return $ map noLoc $ flags-#endif+expandUnits :: [String] -> IO [String]+expandUnits = \ case+ [] -> return []+ "-unit" : file@('@' : _) : args -> (++) <$> expandResponse [file] <*> expandUnits args+ file@('@' : _) : args -> (++) <$> expandResponse [file] <*> expandUnits args+ x : xs -> (:) x <$> expandUnits xs -handleDynamicFlags :: GhcMonad m => [Located String] -> m [String]+handleDynamicFlags :: GhcMonad m => [String] -> m [String] handleDynamicFlags flags = do #if __GLASGOW_HASKELL__ >= 901 logger <- getLogger@@ -86,7 +53,7 @@ #else let parseDynamicFlags' = parseDynamicFlags #endif- (dynflags, locSrcs, _) <- (setHaddockMode `fmap` getSessionDynFlags) >>= (`parseDynamicFlags'` flags)+ (dynflags, locSrcs, _) <- (setHaddockMode `fmap` getSessionDynFlags) >>= (`parseDynamicFlags'` map noLoc flags) _ <- setSessionDynFlags dynflags -- We basically do the same thing as `ghc/Main.hs` to distinguish@@ -98,12 +65,10 @@ _ -> return srcs setHaddockMode :: DynFlags -> DynFlags-#if __GLASGOW_HASKELL__ < 707-setHaddockMode dynflags = (dopt_set dynflags Opt_Haddock) {-#else setHaddockMode dynflags = (gopt_set dynflags Opt_Haddock) {-#endif-#if __GLASGOW_HASKELL__ >= 901+#if __GLASGOW_HASKELL__ >= 906+ backend = noBackend+#elif __GLASGOW_HASKELL__ >= 901 backend = NoBackend #else hscTarget = HscNothing
+ src/Imports.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+module Imports (module Imports) where++import Prelude as Imports+import Data.Monoid as Imports+import Data.Maybe as Imports+import Control.Monad as Imports hiding (forM_)+import Control.Exception as Imports+import Data.Foldable as Imports (forM_)+import Control.Arrow as Imports++import Data.Char+import System.Exit+import System.Process++import Data.Functor as Imports ((<&>))++pass :: Monad m => m ()+pass = return ()++equals :: Eq a => a -> a -> Bool+equals = (==)++strip :: String -> String+strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace++call :: FilePath -> [FilePath] -> IO ()+call name args = rawSystem name args >>= \ case+ ExitSuccess -> pass+ err -> exitWith err++exec :: FilePath -> [FilePath] -> IO ()+exec name args = rawSystem name args >>= exitWith
+ src/Info.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE CPP #-}+module Info (+ versionInfo+, info+, version+#ifdef TEST+, formatInfo+#endif+) where++import Imports++import Data.List+import System.Process+import System.IO.Unsafe++#if __GLASGOW_HASKELL__ < 900+import Config as GHC+#else+import GHC.Settings.Config as GHC+#endif++import Interpreter (ghc)++#ifdef TEST++version :: String+version = "0.0.0"++#else++import Data.Version (showVersion)+import qualified Paths_doctest++version :: String+version = showVersion Paths_doctest.version++#endif++ghcVersion :: String+ghcVersion = GHC.cProjectVersion++versionInfo :: String+versionInfo = unlines [+ "doctest version " ++ version+ , "using version " ++ ghcVersion ++ " of the GHC API"+ , "using " ++ ghc+ ]++info :: String+info = formatInfo $+ ("version", version)+ : ("ghc_version", ghcVersion)+ : ("ghc", ghc)+ : ghcInfo++type Info = [(String, String)]++ghcInfo :: Info+ghcInfo = read $ unsafePerformIO (readProcess ghc ["--info"] "")++formatInfo :: Info -> String+formatInfo xs = " [" ++ (intercalate "\n ," $ map show xs) ++ "\n ]\n"
src/Interpreter.hs view
@@ -1,9 +1,9 @@ {-# LANGUAGE CPP #-}- module Interpreter ( Interpreter+, PreserveIt(..) , safeEval-, safeEvalIt+, safeEvalWith , withInterpreter , ghc , interpreterSupported@@ -14,14 +14,10 @@ , filterExpression ) where +import Imports+ import System.Process import System.Directory (getPermissions, executable)-#if __GLASGOW_HASKELL__ < 710-import Control.Applicative-#endif-import Control.Monad-import Control.Exception hiding (handle)-import Data.Char import GHC.Paths (ghc) import Language.Haskell.GhciWrapper@@ -40,29 +36,26 @@ unless (executable x) $ do fail $ ghc ++ " is not executable!" - maybe False (== "YES") . lookup haveInterpreterKey <$> ghcInfo+ (== Just "YES") . lookup haveInterpreterKey <$> ghcInfo --- | Run an interpreter session.------ Example:------ >>> withInterpreter [] $ \i -> eval i "23 + 42"--- "65\n" withInterpreter- :: [String] -- ^ List of flags, passed to GHC+ :: (String, [String]) -> (Interpreter -> IO a) -- ^ Action to run -> IO a -- ^ Result of action-withInterpreter flags action = do+withInterpreter (command, flags) action = do let args = flags ++ [- "--interactive"- , xTemplateHaskell-#if __GLASGOW_HASKELL__ >= 802+ xTemplateHaskell , "-fdiagnostics-color=never" , "-fno-diagnostics-show-caret"+#if __GLASGOW_HASKELL__ >= 810 && __GLASGOW_HASKELL__ < 904+ , "-Wno-unused-packages" #endif+#if __GLASGOW_HASKELL__ >= 910+ , "-fprint-error-index-links=never"+#endif ]- bracket (new defaultConfig{configGhci = ghc} args) close action+ bracket (new defaultConfig{configGhci = command} args) close action xTemplateHaskell :: String xTemplateHaskell = "-XTemplateHaskell"@@ -71,10 +64,10 @@ -- -- An exception may e.g. be caused on unterminated multiline expressions. safeEval :: Interpreter -> String -> IO (Either String String)-safeEval repl = either (return . Left) (fmap Right . eval repl) . filterExpression+safeEval = safeEvalWith NoPreserveIt -safeEvalIt :: Interpreter -> String -> IO (Either String String)-safeEvalIt repl = either (return . Left) (fmap Right . evalIt repl) . filterExpression+safeEvalWith :: PreserveIt -> Interpreter -> String -> IO (Either String String)+safeEvalWith preserveIt repl = either (return . Left) (fmap Right . evalWith preserveIt repl) . filterExpression filterExpression :: String -> Either String String filterExpression e =@@ -85,9 +78,6 @@ firstLine = strip $ head l lastLine = strip $ last l err = Left "unterminated multi-line command"- where- strip :: String -> String- strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse filterXTemplateHaskell :: String -> String filterXTemplateHaskell input = case words input of
+ src/Language/Haskell/GhciWrapper.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE ViewPatterns #-}+module Language.Haskell.GhciWrapper (+ Interpreter+, Config(..)+, defaultConfig+, PreserveIt(..)+, new+, close+, eval+, evalWith+, evalEcho+) where++import Imports++import System.IO hiding (stdin, stdout, stderr)+import System.Process+import System.Exit+import Data.List (isSuffixOf)++data Config = Config {+ configGhci :: String+, configVerbose :: Bool+, configIgnoreDotGhci :: Bool+} deriving (Eq, Show)++defaultConfig :: Config+defaultConfig = Config {+ configGhci = "ghci"+, configVerbose = False+, configIgnoreDotGhci = True+}++data PreserveIt = NoPreserveIt | PreserveIt+ deriving Eq++-- | Truly random marker, used to separate expressions.+--+-- IMPORTANT: This module relies upon the fact that this marker is unique. It+-- has been obtained from random.org. Do not expect this module to work+-- properly, if you reuse it for any purpose!+marker :: String+marker = show "dcbd2a1e20ae519a1c7714df2859f1890581d57fac96ba3f499412b2f5c928a1"++itMarker :: String+itMarker = "d42472243a0e6fc481e7514cbc9eb08812ed48daa29ca815844d86010b1d113a"++data Interpreter = Interpreter {+ hIn :: Handle+, hOut :: Handle+, process :: ProcessHandle+}++new :: Config -> [String] -> IO Interpreter+new Config{..} args_ = do+ (Just stdin_, Just stdout_, Nothing, processHandle ) <- createProcess (proc configGhci args) {+ std_in = CreatePipe+ , std_out = CreatePipe+ , std_err = Inherit+ }+ setMode stdin_+ setMode stdout_+ let interpreter = Interpreter {hIn = stdin_, hOut = stdout_, process = processHandle}+ evalThrow interpreter "import qualified System.IO"+ evalThrow interpreter "import qualified GHC.IO.Encoding"+ evalThrow interpreter "import qualified GHC.IO.Handle"+ -- The buffering of stdout and stderr is NoBuffering+ evalThrow interpreter "GHC.IO.Handle.hDuplicateTo System.IO.stdout System.IO.stderr"+ -- Now the buffering of stderr is BlockBuffering Nothing+ -- In this situation, GHC 7.7 does not flush the buffer even when+ -- error happens.+ evalThrow interpreter "GHC.IO.Handle.hSetBuffering System.IO.stdout GHC.IO.Handle.LineBuffering"+ evalThrow interpreter "GHC.IO.Handle.hSetBuffering System.IO.stderr GHC.IO.Handle.LineBuffering"++ -- this is required on systems that don't use utf8 as default encoding (e.g.+ -- Windows)+ evalThrow interpreter "GHC.IO.Handle.hSetEncoding System.IO.stdout GHC.IO.Encoding.utf8"+ evalThrow interpreter "GHC.IO.Handle.hSetEncoding System.IO.stderr GHC.IO.Encoding.utf8"++ evalThrow interpreter ":m - System.IO"+ evalThrow interpreter ":m - GHC.IO.Encoding"+ evalThrow interpreter ":m - GHC.IO.Handle"++ return interpreter+ where+ args = args_ ++ catMaybes [+ if configIgnoreDotGhci then Just "-ignore-dot-ghci" else Nothing+ , if configVerbose then Nothing else Just "-v0"+ ]+ setMode h = do+ hSetBinaryMode h False+ hSetBuffering h LineBuffering+ hSetEncoding h utf8++ evalThrow :: Interpreter -> String -> IO ()+ evalThrow interpreter expr = do+ output <- eval interpreter expr+ unless (null output || configVerbose) $ do+ close interpreter+ throwIO (ErrorCall output)++close :: Interpreter -> IO ()+close repl = do+ hClose $ hIn repl++ -- It is crucial not to close `hOut` before calling `waitForProcess`,+ -- otherwise ghci may not cleanly terminate on SIGINT (ctrl-c) and hang+ -- around consuming 100% CPU. This happens when ghci tries to print+ -- something to stdout in its signal handler (e.g. when it is blocked in+ -- threadDelay it writes "Interrupted." on SIGINT).+ e <- waitForProcess $ process repl+ hClose $ hOut repl++ when (e /= ExitSuccess) $ do+ throwIO (userError $ "Language.Haskell.GhciWrapper.close: Interpreter exited with an error (" ++ show e ++ ")")++putExpression :: Interpreter -> PreserveIt -> String -> IO ()+putExpression Interpreter{hIn = stdin} (equals PreserveIt -> preserveIt) e = do+ hPutStrLn stdin e+ when preserveIt $ hPutStrLn stdin $ "let " ++ itMarker ++ " = it"+ hPutStrLn stdin (marker ++ " :: Data.String.String")+ when preserveIt $ hPutStrLn stdin $ "let it = " ++ itMarker+ hFlush stdin++getResult :: Bool -> Interpreter -> IO String+getResult echoMode Interpreter{hOut = stdout} = go+ where+ go = do+ line <- hGetLine stdout+ if marker `isSuffixOf` line+ then do+ let xs = stripMarker line+ echo xs+ return xs+ else do+ echo (line ++ "\n")+ result <- go+ return (line ++ "\n" ++ result)+ stripMarker l = take (length l - length marker) l++ echo :: String -> IO ()+ echo+ | echoMode = putStr+ | otherwise = \ _ -> return ()++-- | Evaluate an expression+eval :: Interpreter -> String -> IO String+eval = evalWith NoPreserveIt++-- | Like 'eval', but try to preserve the @it@ variable+evalWith :: PreserveIt -> Interpreter -> String -> IO String+evalWith preserveIt repl expr = do+ putExpression repl preserveIt expr+ getResult False repl++-- | Evaluate an expression+evalEcho :: Interpreter -> String -> IO String+evalEcho repl expr = do+ putExpression repl NoPreserveIt expr+ getResult True repl
src/Location.hs view
@@ -1,6 +1,8 @@-{-# LANGUAGE CPP, DeriveFunctor #-}+{-# LANGUAGE CPP #-} module Location where +import Imports+ import Control.DeepSeq (deepseq, NFData(rnf)) #if __GLASGOW_HASKELL__ < 900@@ -13,10 +15,6 @@ import GHC.Data.FastString (unpackFS) #endif -#if __GLASGOW_HASKELL__ < 702-import Outputable (showPpr)-#endif- -- | A thing with a location attached. data Located a = Located Location a deriving (Eq, Show, Functor)@@ -61,13 +59,7 @@ -- | Convert a GHC source span to a location. toLocation :: SrcSpan -> Location-#if __GLASGOW_HASKELL__ < 702-toLocation loc- | isGoodSrcLoc start = Location (unpackFS $ srcLocFile start) (srcLocLine start)- | otherwise = (UnhelpfulLocation . showPpr) start- where- start = srcSpanStart loc-#elif __GLASGOW_HASKELL__ < 900+#if __GLASGOW_HASKELL__ < 900 toLocation loc = case loc of UnhelpfulSpan str -> UnhelpfulLocation (unpackFS str) RealSrcSpan sp -> Location (unpackFS . srcSpanFile $ sp) (srcSpanStartLine sp)
src/Options.hs view
@@ -1,42 +1,34 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveFunctor #-} module Options ( Result(..) , Run(..)-, defaultMagic-, defaultFastMode-, defaultPreserveIt-, defaultVerbose+, Config(..)+, defaultConfig , parseOptions #ifdef TEST+, defaultRun , usage , info , versionInfo+, nonInteractiveGhcOptions #endif ) where -import Prelude ()-import Prelude.Compat+import Imports import Control.Monad.Trans.RWS (RWS, execRWS) import qualified Control.Monad.Trans.RWS as RWS -import Control.Monad (when)-import Data.List.Compat (intercalate, stripPrefix)-import Data.Monoid (Endo (Endo))+import Data.List (stripPrefix) -#if __GLASGOW_HASKELL__ < 900-import Config as GHC-#else-import GHC.Settings.Config as GHC-#endif+import GHC.Paths (ghc) -import Interpreter (ghc)+import Info usage :: String usage = unlines [ "Usage:"- , " doctest [ --fast | --preserve-it | --no-magic | --verbose | GHC OPTION | MODULE ]..."+ , " doctest [ --fast | --preserve-it | --fail-fast | --no-magic | --verbose | GHC OPTION | MODULE ]..." , " doctest --help" , " doctest --version" , " doctest --info"@@ -44,128 +36,123 @@ , "Options:" , " --fast disable :reload between example groups" , " --preserve-it preserve the `it` variable between examples"+ , " --fail-fast abort on first failure"+ , " --no-magic disable magic mode" , " --verbose print each test as it is run" , " --help display this help and exit" , " --version output version information and exit" , " --info output machine-readable version information and exit" ] -version :: String-#ifdef CURRENT_PACKAGE_VERSION-version = CURRENT_PACKAGE_VERSION-#else-version = "unknown"-#endif--ghcVersion :: String-ghcVersion = GHC.cProjectVersion--versionInfo :: String-versionInfo = unlines [- "doctest version " ++ version- , "using version " ++ ghcVersion ++ " of the GHC API"- , "using " ++ ghc- ]--info :: String-info = "[ " ++ (intercalate "\n, " . map show $ [- ("version", version)- , ("ghc_version", ghcVersion)- , ("ghc", ghc)- ]) ++ "\n]\n"--data Result a = Output String | Result a+data Result a = ProxyToGhc [String] | Output String | Result a deriving (Eq, Show, Functor) type Warning = String data Run = Run { runWarnings :: [Warning]-, runOptions :: [String] , runMagicMode :: Bool-, runFastMode :: Bool-, runPreserveIt :: Bool-, runVerbose :: Bool+, runConfig :: Config } deriving (Eq, Show) -defaultMagic :: Bool-defaultMagic = True--defaultFastMode :: Bool-defaultFastMode = False+data Config = Config {+ ghcOptions :: [String]+, fastMode :: Bool+, preserveIt :: Bool+, failFast :: Bool+, verbose :: Bool+, repl :: (String, [String])+} deriving (Eq, Show) -defaultPreserveIt :: Bool-defaultPreserveIt = False+defaultConfig :: Config+defaultConfig = Config {+ ghcOptions = []+, fastMode = False+, preserveIt = False+, failFast = False+, verbose = False+, repl = (ghc, ["--interactive"])+} -defaultVerbose :: Bool-defaultVerbose = False+nonInteractiveGhcOptions :: [String]+nonInteractiveGhcOptions = [+ "--numeric-version"+ , "--supported-languages"+ , "--info"+ , "--print-global-package-db"+ , "--print-libdir"+ , "-c"+ , "-o"+ , "--make"+ , "--abi-hash"+ ] defaultRun :: Run defaultRun = Run { runWarnings = []-, runOptions = []-, runMagicMode = defaultMagic-, runFastMode = defaultFastMode-, runPreserveIt = defaultPreserveIt-, runVerbose = defaultVerbose+, runMagicMode = False+, runConfig = defaultConfig } modifyWarnings :: ([String] -> [String]) -> Run -> Run modifyWarnings f run = run { runWarnings = f (runWarnings run) } setOptions :: [String] -> Run -> Run-setOptions opts run = run { runOptions = opts }+setOptions ghcOptions run@Run{..} = run { runConfig = runConfig { ghcOptions } } setMagicMode :: Bool -> Run -> Run setMagicMode magic run = run { runMagicMode = magic } setFastMode :: Bool -> Run -> Run-setFastMode fast run = run { runFastMode = fast }+setFastMode fastMode run@Run{..} = run { runConfig = runConfig { fastMode } } setPreserveIt :: Bool -> Run -> Run-setPreserveIt preserveIt run = run { runPreserveIt = preserveIt }+setPreserveIt preserveIt run@Run{..} = run { runConfig = runConfig { preserveIt } } +setFailFastMode :: Bool -> Run -> Run+setFailFastMode failFast run@Run{..} = run { runConfig = runConfig { failFast } }+ setVerbose :: Bool -> Run -> Run-setVerbose verbose run = run { runVerbose = verbose }+setVerbose verbose run@Run{..} = run { runConfig = runConfig { verbose } } parseOptions :: [String] -> Result Run parseOptions args- | "--help" `elem` args = Output usage- | "--info" `elem` args = Output info- | "--version" `elem` args = Output versionInfo- | otherwise = case execRWS parse () args of- (xs, Endo setter) ->- Result (setOptions xs $ setter defaultRun)- where- parse :: RWS () (Endo Run) [String] ()- parse = do- stripNoMagic- stripFast- stripPreserveIt- stripVerbose- stripOptGhc--stripNoMagic :: RWS () (Endo Run) [String] ()-stripNoMagic = stripFlag (setMagicMode False) "--no-magic"+ | on "--info" = Output info+ | on "--interactive" = runRunOptionsParser (discard "--interactive" args) defaultRun $ do+ commonRunOptions+ | on `any` nonInteractiveGhcOptions = ProxyToGhc args+ | on "--help" = Output usage+ | on "--version" = Output versionInfo+ | otherwise = runRunOptionsParser args defaultRun {runMagicMode = True} $ do+ commonRunOptions+ parseFlag "--no-magic" (setMagicMode False)+ parseOptGhc+ where+ on option = option `elem` args -stripFast :: RWS () (Endo Run) [String] ()-stripFast = stripFlag (setFastMode True) "--fast"+type RunOptionsParser = RWS () (Endo Run) [String] () -stripPreserveIt :: RWS () (Endo Run) [String] ()-stripPreserveIt = stripFlag (setPreserveIt True) "--preserve-it"+runRunOptionsParser :: [String] -> Run -> RunOptionsParser -> Result Run+runRunOptionsParser args def parse = case execRWS parse () args of+ (xs, Endo setter) ->+ Result (setOptions xs $ setter def) -stripVerbose :: RWS () (Endo Run) [String] ()-stripVerbose = stripFlag (setVerbose True) "--verbose"+commonRunOptions :: RunOptionsParser+commonRunOptions = do+ parseFlag "--fast" (setFastMode True)+ parseFlag "--preserve-it" (setPreserveIt True)+ parseFlag "--fail-fast" (setFailFastMode True)+ parseFlag "--verbose" (setVerbose True) -stripFlag :: (Run -> Run) -> String -> RWS () (Endo Run) [String] ()-stripFlag setter flag = do+parseFlag :: String -> (Run -> Run) -> RunOptionsParser+parseFlag flag setter = do args <- RWS.get when (flag `elem` args) $ RWS.tell (Endo setter)- RWS.put (filter (/= flag) args)+ RWS.put (discard flag args) -stripOptGhc :: RWS () (Endo Run) [String] ()-stripOptGhc = do+parseOptGhc :: RunOptionsParser+parseOptGhc = do issueWarning <- RWS.state go when issueWarning $ RWS.tell $ Endo $ modifyWarnings (++ [warning])@@ -176,3 +163,6 @@ opt : rest -> maybe (fmap (opt :)) (\x (_, xs) -> (True, x : xs)) (stripPrefix "--optghc=" opt) (go rest) warning = "WARNING: --optghc is deprecated, doctest now accepts arbitrary GHC options\ndirectly."++discard :: String -> [String] -> [String]+discard flag = filter (/= flag)
src/PackageDBs.hs view
@@ -1,57 +1,39 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE PatternGuards #-} -- | Manage GHC package databases-module PackageDBs- ( PackageDBs (..)- , ArgStyle (..)- , dbArgs- , buildArgStyle- , getPackageDBsFromEnv- , getPackageDBArgs- ) where+module PackageDBs (+ getPackageDBArgs+#ifdef TEST+, PackageDBs (..)+, getPackageDBsFromEnv+#endif+) where +import Imports+ import System.Environment (getEnvironment) import System.FilePath (splitSearchPath, searchPathSeparator) -- | Full stack of GHC package databases data PackageDBs = PackageDBs { includeUser :: Bool- -- | Unsupported on GHC < 7.6 , includeGlobal :: Bool , extraDBs :: [FilePath] } deriving (Show, Eq) --- | Package database handling switched between GHC 7.4 and 7.6-data ArgStyle = Pre76 | Post76- deriving (Show, Eq)- -- | Determine command line arguments to be passed to GHC to set databases correctly ----- >>> dbArgs Post76 (PackageDBs False True [])+-- >>> dbArgs (PackageDBs False True []) -- ["-no-user-package-db"] ----- >>> dbArgs Pre76 (PackageDBs True True ["somedb"])--- ["-package-conf","somedb"]-dbArgs :: ArgStyle -> PackageDBs -> [String]-dbArgs Post76 (PackageDBs user global extras) =+-- >>> dbArgs (PackageDBs True True ["somedb"])+-- ["-package-db","somedb"]+dbArgs :: PackageDBs -> [String]+dbArgs (PackageDBs user global extras) = (if user then id else ("-no-user-package-db":)) $ (if global then id else ("-no-global-package-db":)) $ concatMap (\extra -> ["-package-db", extra]) extras-dbArgs Pre76 (PackageDBs _ False _) =- error "Global package database must be included with GHC < 7.6"-dbArgs Pre76 (PackageDBs user True extras) =- (if user then id else ("-no-user-package-conf":)) $- concatMap (\extra -> ["-package-conf", extra]) extras --- | The argument style to be used with the current GHC version-buildArgStyle :: ArgStyle-#if __GLASGOW_HASKELL__ >= 706-buildArgStyle = Post76-#else-buildArgStyle = Pre76-#endif- -- | Determine the PackageDBs based on the environment. getPackageDBsFromEnv :: IO PackageDBs getPackageDBsFromEnv = do@@ -79,4 +61,4 @@ getPackageDBArgs :: IO [String] getPackageDBArgs = do dbs <- getPackageDBsFromEnv- return $ dbArgs buildArgStyle dbs+ return $ dbArgs dbs
src/Parse.hs view
@@ -1,29 +1,27 @@-{-# LANGUAGE PatternGuards #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} module Parse ( Module (..) , DocTest (..)-, Interaction , Expression , ExpectedResult , ExpectedLine (..) , LineChunk (..)-, getDocTests+, extractDocTests+, parseModules --- * exported for testing+#ifdef TEST , parseInteractions , parseProperties , mkLineChunks+#endif ) where +import Imports+ import Data.Char (isSpace) import Data.List (isPrefixOf, stripPrefix)-import Data.Maybe import Data.String-#if __GLASGOW_HASKELL__ < 710-import Control.Applicative-#endif import Extract import Location @@ -48,12 +46,15 @@ type Interaction = (Expression, ExpectedResult) - -- | -- Extract 'DocTest's from all given modules and all modules included by the -- given modules.-getDocTests :: [String] -> IO [Module [Located DocTest]] -- ^ Extracted 'DocTest's-getDocTests args = parseModules <$> extract args+--+-- @+-- extractDocTests = fmap `parseModules` . `extract`+-- @+extractDocTests :: [String] -> IO [Module [Located DocTest]] -- ^ Extracted 'DocTest's+extractDocTests = fmap parseModules . extract parseModules :: [Module (Located String)] -> [Module [Located DocTest]] parseModules = filter (not . isEmpty) . map parseModule@@ -173,8 +174,3 @@ then (0, c : replicate count '.' ++ acc, res) else (0, c : acc, res) finish (count, acc, res) = mkChunk (replicate count '.' ++ acc) ++ res----- | Remove leading and trailing whitespace.-strip :: String -> String-strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse
src/Property.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE PatternGuards #-} module Property ( runProperty , PropertyResult (..)@@ -9,8 +8,9 @@ #endif ) where +import Imports+ import Data.List-import Data.Maybe import Data.Foldable import Util@@ -67,7 +67,5 @@ -- | Remove quotes from given name, if any. unquote ('`':xs) = init xs-#if __GLASGOW_HASKELL__ >= 707 unquote ('\8216':xs) = init xs-#endif unquote xs = xs
src/Run.hs view
@@ -1,17 +1,28 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-} module Run ( doctest+, doctestWithRepl++, Config(..)+, defaultConfig+, doctestWith++, Result+, Summary(..)+, formatSummary+, isSuccess+, evaluateResult+, doctestWithResult++, runDocTests #ifdef TEST-, doctestWithOptions-, Summary , expandDirs #endif ) where -import Prelude ()-import Prelude.Compat+import Imports -import Control.Monad (when, unless) import System.Directory (doesFileExist, doesDirectoryExist, getDirectoryContents) import System.Environment (getEnvironment) import System.Exit (exitFailure, exitSuccess)@@ -27,10 +38,16 @@ import GHC.Utils.Panic #endif +#if __GLASGOW_HASKELL__ < 904+import GhcUtil (expandUnits)+#endif+ import PackageDBs import Parse-import Options+import Options hiding (Result(..))+import qualified Options import Runner+import Location import qualified Interpreter -- | Run doctest with given list of arguments.@@ -38,6 +55,7 @@ -- Example: -- -- >>> doctest ["-iexample/src", "example/src/Example.hs"]+-- ... -- Examples: 2 Tried: 2 Errors: 0 Failures: 0 -- -- This can be used to create a Cabal test suite that runs doctest for your@@ -46,9 +64,19 @@ -- If a directory is given, it is traversed to find all .hs and .lhs files -- inside of it, ignoring hidden entries. doctest :: [String] -> IO ()-doctest args0 = case parseOptions args0 of- Output s -> putStr s- Result (Run warnings args_ magicMode fastMode preserveIt verbose) -> do+doctest = doctestWithRepl (repl defaultConfig)++doctestWithRepl :: (String, [String]) -> [String] -> IO ()+#if __GLASGOW_HASKELL__ < 904+-- GHC versions prior to 9.4.1 don't support response files. For that reason+-- we want to expand early, so that GHCi gets expanded args.+doctestWithRepl repl = expandUnits >=> parseOptions >>> \ case+#else+doctestWithRepl repl = parseOptions >>> \ case+#endif+ Options.ProxyToGhc args -> exec Interpreter.ghc args+ Options.Output s -> putStr s+ Options.Result (Run warnings magicMode config) -> do mapM_ (hPutStrLn stderr) warnings hFlush stderr @@ -57,22 +85,14 @@ hPutStrLn stderr "WARNING: GHC does not support --interactive, skipping tests" exitSuccess - args <- case magicMode of- False -> return args_+ opts <- case magicMode of+ False -> return (ghcOptions config) True -> do- expandedArgs <- concat <$> mapM expandDirs args_+ expandedArgs <- concat <$> mapM expandDirs (ghcOptions config) packageDBArgs <- getPackageDBArgs addDistArgs <- getAddDistArgs return (addDistArgs $ packageDBArgs ++ expandedArgs)-- r <- doctestWithOptions fastMode preserveIt verbose args `E.catch` \e -> do- case fromException e of- Just (UsageError err) -> do- hPutStrLn stderr ("doctest: " ++ err)- hPutStrLn stderr "Try `doctest --help' for more information."- exitFailure- _ -> E.throwIO e- when (not $ isSuccess r) exitFailure+ doctestWith config{repl, ghcOptions = opts} -- | Expand a reference to a directory to all .hs and .lhs files within it. expandDirs :: String -> IO [String]@@ -106,10 +126,7 @@ getAddDistArgs :: IO ([String] -> [String]) getAddDistArgs = do env <- getEnvironment- let dist =- case lookup "HASKELL_DIST_DIR" env of- Nothing -> "dist"- Just x -> x+ let dist = fromMaybe "dist" $ lookup "HASKELL_DIST_DIR" env autogen = dist ++ "/build/autogen/" cabalMacros = autogen ++ "cabal_macros.h" @@ -125,14 +142,30 @@ else id) rest else return id -isSuccess :: Summary -> Bool-isSuccess s = sErrors s == 0 && sFailures s == 0+doctestWith :: Config -> IO ()+doctestWith = doctestWithResult >=> evaluateResult -doctestWithOptions :: Bool -> Bool -> Bool -> [String] -> IO Summary-doctestWithOptions fastMode preserveIt verbose args = do+type Result = Summary - -- get examples from Haddock comments- modules <- getDocTests args+evaluateResult :: Result -> IO ()+evaluateResult r = unless (isSuccess r) exitFailure - Interpreter.withInterpreter args $ \repl -> withCP65001 $ do- runModules fastMode preserveIt verbose repl modules+doctestWithResult :: Config -> IO Result+doctestWithResult config = do+ (extractDocTests (ghcOptions config) >>= runDocTests config) `E.catch` \e -> do+ case fromException e of+ Just (UsageError err) -> do+ hPutStrLn stderr ("doctest: " ++ err)+ hPutStrLn stderr "Try `doctest --help' for more information."+ exitFailure+ _ -> E.throwIO e++runDocTests :: Config -> [Module [Located DocTest]] -> IO Result+runDocTests Config{..} modules = do+ Interpreter.withInterpreter ((<> ghcOptions) <$> repl) $ \ interpreter -> withCP65001 $ do+ runModules+ (if fastMode then FastMode else NoFastMode)+ (if preserveIt then PreserveIt else NoPreserveIt)+ (if failFast then FailFast else NoFailFast)+ (if verbose then Verbose else NonVerbose)+ interpreter modules
src/Runner.hs view
@@ -1,32 +1,39 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-} module Runner ( runModules+, FastMode(..)+, PreserveIt(..)+, FailFast(..)+, Verbose(..) , Summary(..)+, isSuccess+, formatSummary #ifdef TEST , Report-, ReportState (..)+, ReportState(..)+, runReport+, Interactive(..) , report-, report_+, reportTransient #endif ) where -import Prelude hiding (putStr, putStrLn, error)--#if __GLASGOW_HASKELL__ < 710-import Data.Monoid hiding ((<>))-import Control.Applicative-#endif+import Prelude ()+import Imports hiding (putStr, putStrLn, error) -import Control.Monad hiding (forM_) import Text.Printf (printf)-import System.IO (hPutStrLn, hPutStr, stderr, hIsTerminalDevice)-import Data.Foldable (forM_)+import System.IO hiding (putStr, putStrLn) -import Control.Monad.Trans.State+import Control.Monad.Trans.Class+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.State (StateT, evalStateT)+import qualified Control.Monad.Trans.State as State import Control.Monad.IO.Class+import Data.IORef -import Interpreter (Interpreter)+import Interpreter (Interpreter, PreserveIt(..), safeEvalWith) import qualified Interpreter import Parse import Location@@ -35,115 +42,137 @@ -- | Summary of a test run. data Summary = Summary {- sExamples :: Int-, sTried :: Int-, sErrors :: Int-, sFailures :: Int+ sExamples :: !Int+, sTried :: !Int+, sErrors :: !Int+, sFailures :: !Int } deriving Eq --- | Format a summary. instance Show Summary where- show (Summary examples tried errors failures) =- printf "Examples: %d Tried: %d Errors: %d Failures: %d" examples tried errors failures+ show = formatSummary +isSuccess :: Summary -> Bool+isSuccess s = sErrors s == 0 && sFailures s == 0 +formatSummary :: Summary -> String+formatSummary (Summary examples tried errors failures) =+ printf "Examples: %d Tried: %d Errors: %d Failures: %d" examples tried errors failures+ -- | Sum up summaries. instance Monoid Summary where mempty = Summary 0 0 0 0-#if MIN_VERSION_base(4,11,0) instance Semigroup Summary where- (<>)-#else- mappend-#endif- (Summary x1 x2 x3 x4) (Summary y1 y2 y3 y4) = Summary (x1 + y1) (x2 + y2) (x3 + y3) (x4 + y4)+ Summary x1 x2 x3 x4 <> Summary y1 y2 y3 y4 = Summary (x1 + y1) (x2 + y2) (x3 + y3) (x4 + y4) +withLineBuffering :: Handle -> IO c -> IO c+withLineBuffering h action = bracket (hGetBuffering h) (hSetBuffering h) $ \ _ -> do+ hSetBuffering h LineBuffering+ action+ -- | Run all examples from a list of modules.-runModules :: Bool -> Bool -> Bool -> Interpreter -> [Module [Located DocTest]] -> IO Summary-runModules fastMode preserveIt verbose repl modules = do- isInteractive <- hIsTerminalDevice stderr- ReportState _ _ _ s <- (`execStateT` ReportState 0 isInteractive verbose mempty {sExamples = c}) $ do- forM_ modules $ runModule fastMode preserveIt repl+runModules :: FastMode -> PreserveIt -> FailFast -> Verbose -> Interpreter -> [Module [Located DocTest]] -> IO Summary+runModules fastMode preserveIt failFast verbose repl modules = withLineBuffering stderr $ do - verboseReport "# Final summary:"- gets (show . reportStateSummary) >>= report+ interactive <- hIsTerminalDevice stderr <&> \ case+ False -> NonInteractive+ True -> Interactive - return s+ summary <- newIORef mempty {sExamples = n}++ let+ reportFinalResult :: IO ()+ reportFinalResult = do+ final <- readIORef summary+ hPutStrLn stderr (formatSummary final)++ run :: IO ()+ run = runReport (ReportState interactive failFast verbose summary) $ do+ reportProgress+ forM_ modules $ runModule fastMode preserveIt repl+ verboseReport "# Final summary:"++ run `finally` reportFinalResult++ readIORef summary where- c = (sum . map count) modules+ n :: Int+ n = sum (map countExpressions modules) --- | Count number of expressions in given module.-count :: Module [Located DocTest] -> Int-count (Module _ setup tests) = sum (map length tests) + maybe 0 length setup+countExpressions :: Module [Located DocTest] -> Int+countExpressions (Module _ setup tests) = sum (map length tests) + maybe 0 length setup --- | A monad for generating test reports.-type Report = StateT ReportState IO+type Report = MaybeT (StateT ReportState IO) +data Interactive = NonInteractive | Interactive++data FastMode = NoFastMode | FastMode++data FailFast = NoFailFast | FailFast++data Verbose = NonVerbose | Verbose+ data ReportState = ReportState {- reportStateCount :: Int -- ^ characters on the current line-, reportStateInteractive :: Bool -- ^ should intermediate results be printed?-, reportStateVerbose :: Bool-, reportStateSummary :: Summary -- ^ test summary+ reportStateInteractive :: Interactive+, reportStateFailFast :: FailFast+, reportStateVerbose :: Verbose+, reportStateSummary :: IORef Summary } +runReport :: ReportState -> Report () -> IO ()+runReport st = void . flip evalStateT st . runMaybeT++getSummary :: Report Summary+getSummary = gets reportStateSummary >>= liftIO . readIORef++gets :: (ReportState -> a) -> Report a+gets = lift . State.gets+ -- | Add output to the report. report :: String -> Report ()-report msg = do- overwrite msg-- -- add a newline, this makes the output permanent- liftIO $ hPutStrLn stderr ""- modify (\st -> st {reportStateCount = 0})+report = liftIO . hPutStrLn stderr -- | Add intermediate output to the report. -- -- This will be overwritten by subsequent calls to `report`/`report_`. -- Intermediate out may not contain any newlines.-report_ :: String -> Report ()-report_ msg = do- f <- gets reportStateInteractive- when f $ do- overwrite msg- modify (\st -> st {reportStateCount = length msg})---- | Add output to the report, overwrite any intermediate out.-overwrite :: String -> Report ()-overwrite msg = do- n <- gets reportStateCount- let str | 0 < n = "\r" ++ msg ++ replicate (n - length msg) ' '- | otherwise = msg- liftIO (hPutStr stderr str)+reportTransient :: String -> Report ()+reportTransient msg = gets reportStateInteractive >>= \ case+ NonInteractive -> pass+ Interactive -> liftIO $ do+ hPutStr stderr msg+ hFlush stderr+ hPutStr stderr $ '\r' : (replicate (length msg) ' ') ++ "\r" -- | Run all examples from given module.-runModule :: Bool -> Bool -> Interpreter -> Module [Located DocTest] -> Report ()+runModule :: FastMode -> PreserveIt -> Interpreter -> Module [Located DocTest] -> Report () runModule fastMode preserveIt repl (Module module_ setup examples) = do - Summary _ _ e0 f0 <- gets reportStateSummary+ Summary _ _ e0 f0 <- getSummary forM_ setup $ runTestGroup preserveIt repl reload - Summary _ _ e1 f1 <- gets reportStateSummary+ Summary _ _ e1 f1 <- getSummary -- only run tests, if setup does not produce any errors/failures when (e0 == e1 && f0 == f1) $- forM_ examples $- runTestGroup preserveIt repl setup_+ forM_ examples $ runTestGroup preserveIt repl setup_ where reload :: IO () reload = do- unless fastMode $- -- NOTE: It is important to do the :reload first! See- -- https://ghc.haskell.org/trac/ghc/ticket/5904, which results in a- -- panic on GHC 7.4.1 if you do the :reload second.- void $ Interpreter.safeEval repl ":reload"+ case fastMode of+ NoFastMode -> void $ Interpreter.safeEval repl ":reload"+ FastMode -> pass void $ Interpreter.safeEval repl $ ":m *" ++ module_ - when preserveIt $- -- Evaluate a dumb expression to populate the 'it' variable NOTE: This is- -- one reason why we cannot have safeEval = safeEvalIt: 'it' isn't set in- -- a fresh GHCi session.- void $ Interpreter.safeEval repl $ "()"+ case preserveIt of+ NoPreserveIt -> pass+ PreserveIt -> do+ -- Evaluate a dumb expression to populate the 'it' variable.+ --+ -- NOTE: This is one reason why we cannot just always use PreserveIt:+ -- 'it' isn't set in a fresh GHCi session.+ void $ Interpreter.safeEval repl $ "()" setup_ :: IO () setup_ = do@@ -176,29 +205,35 @@ updateSummary (Summary 0 1 0 0) verboseReport :: String -> Report ()-verboseReport xs = do- verbose <- gets reportStateVerbose- when verbose $ report xs+verboseReport msg = gets reportStateVerbose >>= \ case+ NonVerbose -> pass+ Verbose -> report msg updateSummary :: Summary -> Report () updateSummary summary = do- ReportState n f v s <- get- put (ReportState n f v $ s `mappend` summary)+ ref <- gets reportStateSummary+ liftIO $ modifyIORef' ref $ mappend summary+ reportProgress+ gets reportStateFailFast >>= \ case+ NoFailFast -> pass+ FailFast -> unless (isSuccess summary) abort +abort :: Report ()+abort = MaybeT $ return Nothing+ reportProgress :: Report ()-reportProgress = do- verbose <- gets reportStateVerbose- when (not verbose) $ gets (show . reportStateSummary) >>= report_+reportProgress = gets reportStateVerbose >>= \ case+ NonVerbose -> do+ summary <- getSummary+ reportTransient (formatSummary summary)+ Verbose -> pass -- | Run given test group. -- -- The interpreter state is zeroed with @:reload@ first. This means that you -- can reuse the same 'Interpreter' for several test groups.-runTestGroup :: Bool -> Interpreter -> IO () -> [Located DocTest] -> Report ()+runTestGroup :: PreserveIt -> Interpreter -> IO () -> [Located DocTest] -> Report () runTestGroup preserveIt repl setup tests = do-- reportProgress- liftIO setup runExampleGroup preserveIt repl examples @@ -220,10 +255,12 @@ examples :: [Located Interaction] examples = [Located loc (e, r) | Located loc (Example e r) <- tests] +type Interaction = (Expression, ExpectedResult)+ -- | -- Execute all expressions from given example in given 'Interpreter' and verify -- the output.-runExampleGroup :: Bool -> Interpreter -> [Located Interaction] -> Report ()+runExampleGroup :: PreserveIt -> Interpreter -> [Located Interaction] -> Report () runExampleGroup preserveIt repl = go where go ((Located loc (expression, expected)) : xs) = do@@ -239,8 +276,3 @@ reportSuccess go xs go [] = return ()--safeEvalWith :: Bool -> Interpreter -> String -> IO (Either String String)-safeEvalWith preserveIt- | preserveIt = Interpreter.safeEvalIt- | otherwise = Interpreter.safeEval
src/Runner/Example.hs view
@@ -3,6 +3,8 @@ , mkResult ) where +import Imports+ import Data.Char import Data.List (isPrefixOf) import Util
src/Test/DocTest.hs view
@@ -1,5 +1,4 @@ module Test.DocTest ( doctest ) where--import Run+import Test.DocTest.Internal.Run
+ src/Test/DocTest/Internal/Cabal.hs view
@@ -0,0 +1,10 @@+module Test.DocTest.Internal.Cabal (+ doctest+) where++import Imports++import qualified Cabal++doctest :: [String] -> IO ()+doctest = Cabal.externalCommand
+ src/Test/DocTest/Internal/Extract.hs view
@@ -0,0 +1,4 @@+module Test.DocTest.Internal.Extract (+ module Extract+) where+import Extract
+ src/Test/DocTest/Internal/Location.hs view
@@ -0,0 +1,4 @@+module Test.DocTest.Internal.Location (+ module Location+) where+import Location
+ src/Test/DocTest/Internal/Parse.hs view
@@ -0,0 +1,4 @@+module Test.DocTest.Internal.Parse (+ module Parse+) where+import Parse
+ src/Test/DocTest/Internal/Run.hs view
@@ -0,0 +1,4 @@+module Test.DocTest.Internal.Run (+ module Run+) where+import Run
src/Util.hs view
@@ -1,4 +1,7 @@ module Util where++import Imports+ import Data.Char convertDosLineEndings :: String -> String
+ test/Cabal/OptionsSpec.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE CPP #-}+module Cabal.OptionsSpec (spec) where++import Imports++import Test.Hspec++import System.IO+import System.IO.Silently+import System.Exit+import System.Process+import Data.Set ((\\))+import qualified Data.Set as Set++import qualified Cabal.ReplOptionsSpec as Repl++import Cabal.Options++spec :: Spec+spec = do+ describe "replOnlyOptions" $ do+ it "is the set of options that are unique to 'cabal repl'" $ do+ build <- Set.fromList . lines <$> readProcess "cabal" ["build", "--list-options"] ""+ repl <- Set.fromList . lines <$> readProcess "cabal" ["repl", "--list-options"] ""+ Set.toList replOnlyOptions `shouldMatchList` Set.toList (repl \\ build)++ describe "rejectUnsupportedOptions" $ do+ it "produces error messages that are consistent with 'cabal repl'" $ do+ let+ shouldFail :: HasCallStack => String -> IO a -> Expectation+ shouldFail command action = do+ hCapture_ [stderr] (action `shouldThrow` (== ExitFailure 1))+ `shouldReturn` "Error: cabal: unrecognized '" <> command <> "' option `--installdir'\n"++#ifndef mingw32_HOST_OS+ shouldFail "repl" $ call "cabal" ["repl", "--installdir"]+#endif+ shouldFail "doctest" $ rejectUnsupportedOptions ["--installdir"]++ context "with --list-options" $ do+ it "lists supported command-line options" $ do+ repl <- Set.fromList . lines <$> readProcess "cabal" ["repl", "--list-options"] ""+ doctest <- Set.fromList . lines <$> capture_ (rejectUnsupportedOptions ["--list-options"] `shouldThrow` (== ExitSuccess))+ Set.toList (doctest \\ repl) `shouldMatchList` []+ Set.toList (repl \\ doctest) `shouldMatchList` Set.toList Repl.unsupported++ describe "discardReplOptions" $ do+ it "discards 'cabal repl'-only options" $ do+ discardReplOptions [+ "-w", "ghc-9.10"+ , "--build-depends=foo"+ , "--build-depends", "foo"+ , "-bfoo"+ , "-b", "foo"+ , "--disable-optimization"+ , "--enable-multi-repl"+ , "--repl-options", "foo"+ , "--repl-options=foo"+ , "--allow-newer"+ ] `shouldBe` ["--with-compiler=ghc-9.10", "--disable-optimization", "--allow-newer"]
+ test/Cabal/PathsSpec.hs view
@@ -0,0 +1,22 @@+module Cabal.PathsSpec (spec) where++import Imports++import Test.Hspec++import System.Directory++import Cabal ()+import Cabal.Paths++spec :: Spec+spec = do+ describe "paths" $ do+ it "returns the path to 'ghc'" $ do+ (paths "cabal" [] >>= doesFileExist . ghc) `shouldReturn` True++ it "returns the path to 'ghc-pkg'" $ do+ (paths "cabal" [] >>= doesFileExist . ghcPkg) `shouldReturn` True++ it "returns the path to Cabal's cache directory" $ do+ (paths "cabal" [] >>= doesDirectoryExist . cache) `shouldReturn` True
+ test/Cabal/ReplOptionsSpec.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ViewPatterns #-}+module Cabal.ReplOptionsSpec (spec, unsupported) where++import Imports++import Test.Hspec++import Data.List+import System.Process+import Data.Set (Set)+import qualified Data.Set as Set++import Cabal.ReplOptions++phony :: [String]+phony = [+ "with-PROG"+ , "PROG-option"+ , "PROG-options"+ ]++undocumented :: Set String+undocumented = Set.fromList [+ "--enable-optimisation"+ , "--disable-optimisation"+ , "--haddock-hyperlink-sources"+ , "--haddock-hyperlinked-source"+ ]++unsupported :: Set String+unsupported = undocumented <> Set.fromList (map ("--" <>) phony)++spec :: Spec+spec = do+ describe "options" $ do+ it "is the list of documented 'repl' options" $ do+ documentedOptions <- parseOptions <$> readProcess "cabal" ["help", "repl"] ""+ options `shouldBe` filter (optionName >>> (`notElem` phony)) documentedOptions++ it "is consistent with 'cabal repl --list-options'" $ do+ let+ optionNames :: Option -> [String]+ optionNames option = reverse $ "--" <> optionName option : case optionShortName option of+ Nothing -> []+ Just c -> [['-', c]]+ + repl <- filter (`Set.notMember` unsupported) . lines <$> readProcess "cabal" ["repl", "--list-options"] ""+ concatMap optionNames options `shouldBe` repl++parseOptions :: String -> [Option]+parseOptions = map parseOption . takeOptions+ where+ parseOption :: String -> Option+ parseOption input = case input of+ longAndHelp@('-':'-':_) -> parseLongOption Nothing longAndHelp+ '-':short:',':' ':longAndHelp -> parseLongOption (Just short) longAndHelp+ '-':short:'[':(breakOn ']' ->+ (_arg, ']':',':' ':longAndHelp)) -> parseLongOption (Just short) longAndHelp+ '-':short:' ':(breakOn ' ' ->+ (arg, ' ':'o':'r':' ':(stripPrefix ('-':short:arg) ->+ Just (',':' ':longAndHelp)))) -> parseLongOption (Just short) longAndHelp+ _ -> err+ where+ parseLongOption :: Maybe Char -> String -> Option+ parseLongOption short longAndHelp = case breakOnAny " [=" longAndHelp of+ ('-':'-':long, ' ':help) -> accept long NoArgument help+ ('-':'-':long, '[':'=': (breakOn ']' ->+ (arg, ']':help))) -> accept long (OptionalArgument arg) help+ ('-':'-':long, '=':(breakOn ' ' ->+ (arg, ' ':help))) -> accept long (Argument arg) help+ _ -> err+ where+ accept :: String -> Argument -> String -> Option+ accept long arg help = Option long short arg (strip help)++ err :: HasCallStack => Option+ err = error input++ breakOn c = break (== c)+ breakOnAny xs = break (`elem` xs)++ takeOptions :: String -> [String]+ takeOptions input = map strip . joinLines $ case break (== "Flags for repl:") (lines input) of+ (_, "Flags for repl:" : xs) -> case break (== "") xs of+ (ys, "" : _) -> ys+ _ -> undefined+ _ -> undefined++ joinLines :: [String] -> [String]+ joinLines = go+ where+ go = \ case+ x : y : ys | isOption y -> x : go (y : ys)+ x : y : ys -> go $ (x ++ ' ' : strip y) : ys+ x : xs -> x : xs+ [] -> []++ isOption = isPrefixOf " -"
test/ExtractSpec.hs view
@@ -4,6 +4,8 @@ module ExtractSpec (main, spec) where +import Imports+ import Test.Hspec import Test.HUnit @@ -17,8 +19,6 @@ import Extract import Location import System.FilePath--import Orphans () shouldGive :: HasCallStack => (String, String) -> [Module String] -> Assertion (d, m) `shouldGive` expected = do
+ test/InfoSpec.hs view
@@ -0,0 +1,17 @@+module InfoSpec (spec) where++import Imports++import Test.Hspec++import System.Process++import Info (formatInfo)+import Interpreter (ghc)++spec :: Spec+spec = do+ describe "formatInfo" $ do+ it "formats --info output" $ do+ info <- readProcess ghc ["--info"] ""+ formatInfo (read info) `shouldBe` info
test/InterpreterSpec.hs view
@@ -1,14 +1,14 @@-module InterpreterSpec (main, spec) where+module InterpreterSpec (spec) where -import Prelude ()-import Prelude.Compat+import Imports import Test.Hspec -import Interpreter (interpreterSupported, haveInterpreterKey, ghcInfo, withInterpreter, safeEval, filterExpression)+import Interpreter (Interpreter, interpreterSupported, haveInterpreterKey, ghcInfo, ghc, safeEval, filterExpression)+import qualified Interpreter -main :: IO ()-main = hspec spec+withInterpreter :: (Interpreter -> IO a) -> IO a+withInterpreter = Interpreter.withInterpreter (Interpreter.ghc, ["--interactive"]) spec :: Spec spec = do@@ -23,10 +23,10 @@ (||) <$> (== Just "YES") <*> (== Just "NO") describe "safeEval" $ do- it "evaluates an expression" $ withInterpreter [] $ \ghci -> do+ it "evaluates an expression" $ withInterpreter $ \ ghci -> do Interpreter.safeEval ghci "23 + 42" `shouldReturn` Right "65\n" - it "returns Left on unterminated multiline command" $ withInterpreter [] $ \ghci -> do+ it "returns Left on unterminated multiline command" $ withInterpreter $ \ ghci -> do Interpreter.safeEval ghci ":{\n23 + 42" `shouldReturn` Left "unterminated multi-line command" describe "filterExpression" $ do
+ test/Language/Haskell/GhciWrapperSpec.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE CPP #-}+module Language.Haskell.GhciWrapperSpec (main, spec) where++import Imports++import Test.Hspec+import System.IO.Silently++import Data.List++import Language.Haskell.GhciWrapper (Interpreter, Config(..), defaultConfig, PreserveIt(..))+import qualified Language.Haskell.GhciWrapper as Interpreter++main :: IO ()+main = hspec spec++withInterpreterConfig :: Config -> [String] -> (Interpreter -> IO a) -> IO a+withInterpreterConfig config args = bracket (Interpreter.new config args) Interpreter.close++withInterpreterArgs :: [String] -> ((String -> IO String) -> IO a) -> IO a+withInterpreterArgs args action = withInterpreterConfig defaultConfig args $ action . Interpreter.eval++withInterpreter :: ((String -> IO String) -> IO a) -> IO a+withInterpreter = withInterpreterArgs []++spec :: Spec+spec = do+ describe "evalEcho" $ do+ it "prints result to stdout" $ do+ withInterpreterConfig defaultConfig [] $ \ghci -> do+ (capture $ Interpreter.evalEcho ghci ("putStr" ++ show "foo\nbar")) `shouldReturn` ("foo\nbar", "foo\nbar")++ describe "evalWith" $ do+ context "with PreserveIt" $ do+ it "preserves it" $ do+ withInterpreterConfig defaultConfig [] $ \ghci -> do+ Interpreter.evalWith PreserveIt ghci "23" `shouldReturn` "23\n"+ Interpreter.eval ghci "it" `shouldReturn` "23\n"++ describe "eval" $ do+ it "shows literals" $ withInterpreter $ \ghci -> do+ ghci "23" `shouldReturn` "23\n"++ it "shows string literals containing Unicode" $ withInterpreter $ \ghci -> do+ ghci "\"λ\"" `shouldReturn` "\"\\955\"\n"++ it "evaluates simple expressions" $ withInterpreter $ \ghci -> do+ ghci "23 + 42" `shouldReturn` "65\n"++ it "supports let bindings" $ withInterpreter $ \ghci -> do+ ghci "let x = 10" `shouldReturn` ""+ ghci "x" `shouldReturn` "10\n"++ it "allows import statements" $ withInterpreter $ \ghci -> do+ ghci "import Data.Maybe" `shouldReturn` ""+ ghci "fromJust (Just 20)" `shouldReturn` "20\n"++ it "captures stdout" $ withInterpreter $ \ghci -> do+ ghci "putStr \"foo\"" `shouldReturn` "foo"++ it "captures stdout (Unicode)" $ withInterpreter $ \ghci -> do+ ghci "putStrLn \"λ\"" `shouldReturn` "λ\n"++ it "captures stdout (empty line)" $ withInterpreter $ \ghci -> do+ ghci "putStrLn \"\"" `shouldReturn` "\n"++ it "captures stdout (multiple lines)" $ withInterpreter $ \ghci -> do+ ghci "putStrLn \"foo\" >> putStrLn \"bar\" >> putStrLn \"baz\""+ `shouldReturn` "foo\nbar\nbaz\n"++ it "captures stderr" $ withInterpreter $ \ghci -> do+ ghci "import System.IO" `shouldReturn` ""+ ghci "hPutStrLn stderr \"foo\"" `shouldReturn` "foo\n"++ it "captures stderr (Unicode)" $ withInterpreter $ \ghci -> do+ ghci "import System.IO" `shouldReturn` ""+ ghci "hPutStrLn stderr \"λ\"" `shouldReturn` "λ\n"++ it "shows exceptions" $ withInterpreter $ \ghci -> do+ ghci "import Control.Exception" `shouldReturn` ""+#if __GLASGOW_HASKELL__ >= 912+ ghci "throwIO DivideByZero" `shouldReturn` "*** Exception: divide by zero\n\nHasCallStack backtrace:\n throwIO, called at <interactive>:25:1 in interactive:Ghci22\n\n"+#else+ ghci "throwIO DivideByZero" `shouldReturn` "*** Exception: divide by zero\n"+#endif++ it "shows exceptions (ExitCode)" $ withInterpreter $ \ghci -> do+ ghci "import System.Exit" `shouldReturn` ""+ ghci "exitWith $ ExitFailure 10" `shouldReturn` "*** Exception: ExitFailure 10\n"++ it "gives an error message for identifiers that are not in scope" $ withInterpreter $ \ghci -> do+ ghci "foo" >>= (`shouldSatisfy` isInfixOf "Variable not in scope: foo")++ context "when configVerbose is True" $ do+ it "prints prompt" $ do+ withInterpreterConfig defaultConfig{configVerbose = True} [] $ \ghci -> do+ Interpreter.eval ghci "print 23" >>= (`shouldSatisfy`+ (`elem` [ "Prelude> 23\nPrelude> "+ , "ghci> 23\nghci> "+ ]))++ context "with -XOverloadedStrings, -Wall and -Werror" $ do+ it "does not fail on marker expression (bug fix)" $ withInterpreter $ \ghci -> do+ ghci ":seti -XOverloadedStrings -Wall -Werror" `shouldReturn` ""+ ghci "putStrLn \"foo\"" `shouldReturn` "foo\n"++ context "with NoImplicitPrelude" $ do+ it "works" $ withInterpreterArgs ["-XNoImplicitPrelude"] $ \ghci -> do+ ghci "putStrLn \"foo\"" >>= (`shouldContain` "Variable not in scope: putStrLn")+ ghci "23" `shouldReturn` "23\n"++ context "with a strange String type" $ do+ it "works" $ withInterpreter $ \ghci -> do+ ghci "type String = Int" `shouldReturn` ""+ ghci "putStrLn \"foo\"" `shouldReturn` "foo\n"
test/LocationSpec.hs view
@@ -2,6 +2,8 @@ module LocationSpec (main, spec) where +import Imports+ import Test.Hspec import Location
test/MainSpec.hs view
@@ -2,15 +2,14 @@ {-# LANGUAGE ConstraintKinds #-} module MainSpec (main, spec) where +import Imports+ import Test.Hspec import Test.HUnit (assertEqual, Assertion) -import Control.Exception import System.Directory (getCurrentDirectory, setCurrentDirectory) import System.FilePath-import Options-import Runner (Summary(..))-import Run hiding (doctest)+import Run hiding (doctest, doctestWith) import System.IO.Silently import System.IO @@ -20,16 +19,21 @@ setCurrentDirectory workingDir action --- | Construct a doctest specific 'Assertion'. doctest :: HasCallStack => FilePath -> [String] -> Summary -> Assertion-doctest = doctestWithPreserveIt defaultPreserveIt+doctest = doctestWith False False -doctestWithPreserveIt :: HasCallStack => Bool -> FilePath -> [String] -> Summary -> Assertion-doctestWithPreserveIt preserveIt workingDir args expected = do- actual <- withCurrentDirectory ("test/integration" </> workingDir) (hSilence [stderr] $ doctestWithOptions defaultFastMode preserveIt defaultVerbose args)- assertEqual label expected actual+doctestWithPreserveIt :: HasCallStack => FilePath -> [String] -> Summary -> Assertion+doctestWithPreserveIt = doctestWith True False++doctestWithFailFast :: HasCallStack => FilePath -> [String] -> Summary -> Assertion+doctestWithFailFast = doctestWith False True++doctestWith :: HasCallStack => Bool -> Bool -> FilePath -> [String] -> Summary -> Assertion+doctestWith preserveIt failFast workingDir ghcOptions expected = do+ actual <- withCurrentDirectory ("test/integration" </> workingDir) (hSilence [stderr] $ doctestWithResult defaultConfig {ghcOptions, preserveIt, failFast})+ assertEqual label (formatSummary expected) (formatSummary actual) where- label = workingDir ++ " " ++ show args+ label = workingDir ++ " " ++ show ghcOptions cases :: Int -> Summary cases n = Summary n n 0 0@@ -45,20 +49,34 @@ (cases 1) it "it-variable" $ do- doctestWithPreserveIt True "." ["it/Foo.hs"]+ doctestWithPreserveIt "." ["it/Foo.hs"] (cases 5) it "it-variable in $setup" $ do- doctestWithPreserveIt True "." ["it/Setup.hs"]+ doctestWithPreserveIt "." ["it/Setup.hs"] (cases 5) it "failing" $ do doctest "." ["failing/Foo.hs"] (cases 1) {sFailures = 1} - it "skips subsequent examples from the same group if an example fails" $+ it "skips subsequent examples from the same group if an example fails" $ do doctest "." ["failing-multiple/Foo.hs"] (cases 4) {sTried = 2, sFailures = 1}++ context "without --fail-fast" $ do+ it "continuous even if some tests fail" $ do+ doctest "fail-fast" ["Foo.hs"]+ (cases 4) {sTried = 4, sFailures = 1}++ context "with --fail-fast" $ do+ it "stops after the first failure" $ do+ doctestWithFailFast "fail-fast" ["Foo.hs"]+ (cases 4) {sTried = 2, sFailures = 1}++ it "stops after failures in $setup" $ do+ doctestWithFailFast "fail-fast" ["SetupFoo.hs"]+ (cases 6) {sTried = 1, sFailures = 1} it "testImport" $ do doctest "testImport" ["ModuleA.hs"]
test/OptionsSpec.hs view
@@ -1,25 +1,55 @@ module OptionsSpec (spec) where -import Prelude ()-import Prelude.Compat+import Imports +import Data.List+ import Test.Hspec-import Test.QuickCheck+import Test.QuickCheck hiding (verbose) import Options +newtype NonInteractive = NonInteractive String+ deriving (Eq, Show)++instance Arbitrary NonInteractive where+ arbitrary = NonInteractive <$> elements (nonInteractiveGhcOptions \\ ["--info"])+ spec :: Spec spec = do describe "parseOptions" $ do- let warning = ["WARNING: --optghc is deprecated, doctest now accepts arbitrary GHC options\ndirectly."]+ let+ run :: [String] -> Run+ run ghcOptions = defaultRun {+ runWarnings = ["WARNING: --optghc is deprecated, doctest now accepts arbitrary GHC options\ndirectly."]+ , runMagicMode = True+ , runConfig = defaultConfig { ghcOptions }+ }+ it "strips --optghc" $- property $ \xs ys ->- parseOptions (xs ++ ["--optghc", "foobar"] ++ ys) `shouldBe` Result (Run warning (xs ++ ["foobar"] ++ ys) defaultMagic defaultFastMode defaultPreserveIt defaultVerbose)+ parseOptions ["--optghc", "foobar"] `shouldBe` Result (run ["foobar"]) it "strips --optghc=" $- property $ \xs ys ->- parseOptions (xs ++ ["--optghc=foobar"] ++ ys) `shouldBe` Result (Run warning (xs ++ ["foobar"] ++ ys) defaultMagic defaultFastMode defaultPreserveIt defaultVerbose)+ parseOptions ["--optghc=foobar"] `shouldBe` Result (run ["foobar"]) + context "with ghc options that are not valid with --interactive" $ do+ it "returns ProxyToGhc" $ do+ property $ \ (NonInteractive x) xs -> do+ let options = x : xs+ parseOptions options `shouldBe` ProxyToGhc options++ context "with --interactive" $ do+ let options = ["--interactive", "--foo", "--bar"]++ it "disables magic mode" $ do+ runMagicMode <$> parseOptions options `shouldBe` Result False++ it "filters out --interactive" $ do+ ghcOptions . runConfig <$> parseOptions options `shouldBe` Result ["--foo", "--bar"]++ it "accepts --fast" $ do+ fastMode . runConfig <$> parseOptions ("--fast" : options) `shouldBe` Result True+ describe "--no-magic" $ do context "without --no-magic" $ do it "enables magic mode" $ do@@ -32,21 +62,30 @@ describe "--fast" $ do context "without --fast" $ do it "disables fast mode" $ do- runFastMode <$> parseOptions [] `shouldBe` Result False+ fastMode . runConfig <$> parseOptions [] `shouldBe` Result False context "with --fast" $ do- it "enabled fast mode" $ do- runFastMode <$> parseOptions ["--fast"] `shouldBe` Result True+ it "enables fast mode" $ do+ fastMode . runConfig <$> parseOptions ["--fast"] `shouldBe` Result True describe "--preserve-it" $ do context "without --preserve-it" $ do it "does not preserve the `it` variable" $ do- runPreserveIt <$> parseOptions [] `shouldBe` Result False+ preserveIt . runConfig <$> parseOptions [] `shouldBe` Result False context "with --preserve-it" $ do it "preserves the `it` variable" $ do- runPreserveIt <$> parseOptions ["--preserve-it"] `shouldBe` Result True+ preserveIt . runConfig <$> parseOptions ["--preserve-it"] `shouldBe` Result True + describe "--fail-fast" $ do+ context "without --fail-fast" $ do+ it "disables fail-fast mode" $ do+ failFast . runConfig <$> parseOptions [] `shouldBe` Result False++ context "with --fail-fast" $ do+ it "enables fail-fast mode" $ do+ failFast . runConfig <$> parseOptions ["--fail-fast"] `shouldBe` Result True+ context "with --help" $ do it "outputs usage information" $ do parseOptions ["--help"] `shouldBe` Output usage@@ -62,8 +101,8 @@ describe "--verbose" $ do context "without --verbose" $ do it "is not verbose by default" $ do- runVerbose <$> parseOptions [] `shouldBe` Result False+ verbose . runConfig <$> parseOptions [] `shouldBe` Result False context "with --verbose" $ do it "parses verbose option" $ do- runVerbose <$> parseOptions ["--verbose"] `shouldBe` Result True+ verbose . runConfig <$> parseOptions ["--verbose"] `shouldBe` Result True
− test/Orphans.hs
@@ -1,16 +0,0 @@-{-# LANGUAGE StandaloneDeriving, FlexibleInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-module Orphans where--import Parse-import Location---- The generic form------ > deriving instance Show a => Show (Module a)------ fails with GHC 7.0.1 due to an overlapping instance (leaked by the GHC API),--- this is why we derive the things we need individually.-deriving instance Show (Module String)-deriving instance Show (Module [DocTest])-deriving instance Show (Module [Located DocTest])
test/PackageDBsSpec.hs view
@@ -1,12 +1,11 @@ module PackageDBsSpec (main, spec) where -import Prelude ()-import Prelude.Compat+import Imports import qualified Control.Exception as E import Data.List (intercalate) import PackageDBs-import System.Environment.Compat+import System.Environment import System.FilePath (searchPathSeparator) import Test.Hspec
test/ParseSpec.hs view
@@ -1,6 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} module ParseSpec (main, spec) where +import Imports+ import Test.Hspec import Data.String import Data.String.Builder (Builder, build)@@ -9,8 +11,6 @@ import Parse import Location -import Orphans ()- main :: IO () main = hspec spec @@ -31,9 +31,9 @@ spec :: Spec spec = do- describe "getDocTests" $ do+ describe "extractDocTests" $ do it "extracts properties from a module" $ do- getDocTests ["test/parse/property/Fib.hs"] `shouldGive` do+ extractDocTests ["test/parse/property/Fib.hs"] `shouldGive` do module_ "Fib" $ do group $ do prop_ "foo"@@ -41,7 +41,7 @@ prop_ "baz" it "extracts examples from a module" $ do- getDocTests ["test/parse/simple/Fib.hs"] `shouldGive` do+ extractDocTests ["test/parse/simple/Fib.hs"] `shouldGive` do module_ "Fib" $ do group $ do ghci "putStrLn \"foo\""@@ -52,7 +52,7 @@ "baz" it "extracts examples from documentation for non-exported names" $ do- getDocTests ["test/parse/non-exported/Fib.hs"] `shouldGive` do+ extractDocTests ["test/parse/non-exported/Fib.hs"] `shouldGive` do module_ "Fib" $ do group $ do ghci "putStrLn \"foo\""@@ -63,7 +63,7 @@ "baz" it "extracts multiple examples from a module" $ do- getDocTests ["test/parse/multiple-examples/Foo.hs"] `shouldGive` do+ extractDocTests ["test/parse/multiple-examples/Foo.hs"] `shouldGive` do module_ "Foo" $ do group $ do ghci "foo"@@ -73,17 +73,17 @@ "42" it "returns an empty list, if documentation contains no examples" $ do- getDocTests ["test/parse/no-examples/Fib.hs"] >>= (`shouldBe` [])+ extractDocTests ["test/parse/no-examples/Fib.hs"] >>= (`shouldBe` []) it "sets setup code to Nothing, if it does not contain any tests" $ do- getDocTests ["test/parse/setup-empty/Foo.hs"] `shouldGive` do+ extractDocTests ["test/parse/setup-empty/Foo.hs"] `shouldGive` do module_ "Foo" $ do group $ do ghci "foo" "23" it "keeps modules that only contain setup code" $ do- getDocTests ["test/parse/setup-only/Foo.hs"] `shouldGive` do+ extractDocTests ["test/parse/setup-only/Foo.hs"] `shouldGive` do tell [Module "Foo" (Just [Example "foo" ["23"]]) []] describe "parseInteractions (an internal function)" $ do
test/PropertySpec.hs view
@@ -1,14 +1,17 @@-{-# LANGUAGE CPP, OverloadedStrings #-}-module PropertySpec (main, spec) where+{-# LANGUAGE OverloadedStrings #-}+module PropertySpec (spec) where +import Imports+ import Test.Hspec import Data.String.Builder import Property-import Interpreter (withInterpreter)+import Interpreter (Interpreter)+import qualified Interpreter -main :: IO ()-main = hspec spec+withInterpreter :: (Interpreter -> IO a) -> IO a+withInterpreter = Interpreter.withInterpreter (Interpreter.ghc, ["--interactive"]) isFailure :: PropertyResult -> Bool isFailure (Failure _) = True@@ -17,61 +20,54 @@ spec :: Spec spec = do describe "runProperty" $ do- it "reports a failing property" $ withInterpreter [] $ \repl -> do+ it "reports a failing property" $ withInterpreter $ \repl -> do runProperty repl "False" `shouldReturn` Failure "*** Failed! Falsified (after 1 test):" - it "runs a Bool property" $ withInterpreter [] $ \repl -> do+ it "runs a Bool property" $ withInterpreter $ \repl -> do runProperty repl "True" `shouldReturn` Success - it "runs a Bool property with an explicit type signature" $ withInterpreter [] $ \repl -> do+ it "runs a Bool property with an explicit type signature" $ withInterpreter $ \repl -> do runProperty repl "True :: Bool" `shouldReturn` Success - it "runs an implicitly quantified property" $ withInterpreter [] $ \repl -> do+ it "runs an implicitly quantified property" $ withInterpreter $ \repl -> do runProperty repl "(reverse . reverse) xs == (xs :: [Int])" `shouldReturn` Success it "runs an implicitly quantified property even with GHC 7.4" $-#if __GLASGOW_HASKELL__ == 702- pendingWith "This triggers a bug in GHC 7.2.*."- -- try e.g.- -- >>> 23- -- >>> :t is-#else -- ghc will include a suggestion (did you mean `id` instead of `is`) in -- the error message- withInterpreter [] $ \repl -> do+ withInterpreter $ \repl -> do runProperty repl "foldr (+) 0 is == sum (is :: [Int])" `shouldReturn` Success-#endif - it "runs an explicitly quantified property" $ withInterpreter [] $ \repl -> do+ it "runs an explicitly quantified property" $ withInterpreter $ \repl -> do runProperty repl "\\xs -> (reverse . reverse) xs == (xs :: [Int])" `shouldReturn` Success - it "allows to mix implicit and explicit quantification" $ withInterpreter [] $ \repl -> do+ it "allows to mix implicit and explicit quantification" $ withInterpreter $ \repl -> do runProperty repl "\\x -> x + y == y + x" `shouldReturn` Success - it "reports the value for which a property fails" $ withInterpreter [] $ \repl -> do+ it "reports the value for which a property fails" $ withInterpreter $ \repl -> do runProperty repl "x == 23" `shouldReturn` Failure "*** Failed! Falsified (after 1 test):\n0" - it "reports the values for which a property that takes multiple arguments fails" $ withInterpreter [] $ \repl -> do+ it "reports the values for which a property that takes multiple arguments fails" $ withInterpreter $ \repl -> do let vals x = case x of (Failure r) -> tail (lines r); _ -> error "Property did not fail!" vals `fmap` runProperty repl "x == True && y == 10 && z == \"foo\"" `shouldReturn` ["False", "0", show ("" :: String)] - it "defaults ambiguous type variables to Integer" $ withInterpreter [] $ \repl -> do+ it "defaults ambiguous type variables to Integer" $ withInterpreter $ \repl -> do runProperty repl "reverse xs == xs" >>= (`shouldSatisfy` isFailure) describe "freeVariables" $ do- it "finds a free variables in a term" $ withInterpreter [] $ \repl -> do+ it "finds a free variables in a term" $ withInterpreter $ \repl -> do freeVariables repl "x" `shouldReturn` ["x"] - it "ignores duplicates" $ withInterpreter [] $ \repl -> do+ it "ignores duplicates" $ withInterpreter $ \repl -> do freeVariables repl "x == x" `shouldReturn` ["x"] - it "works for terms with multiple names" $ withInterpreter [] $ \repl -> do+ it "works for terms with multiple names" $ withInterpreter $ \repl -> do freeVariables repl "\\z -> x + y + z == foo 23" `shouldReturn` ["x", "y", "foo"] - it "works for names that contain a prime" $ withInterpreter [] $ \repl -> do+ it "works for names that contain a prime" $ withInterpreter $ \repl -> do freeVariables repl "x' == y''" `shouldReturn` ["x'", "y''"] - it "works for names that are similar to other names that are in scope" $ withInterpreter [] $ \repl -> do+ it "works for names that are similar to other names that are in scope" $ withInterpreter $ \repl -> do freeVariables repl "length_" `shouldReturn` ["length_"] describe "parseNotInScope" $ do
test/RunSpec.hs view
@@ -1,15 +1,16 @@ {-# LANGUAGE CPP #-} module RunSpec (main, spec) where -import Prelude ()-import Prelude.Compat+import Imports import Test.Hspec import System.Exit import qualified Control.Exception as E+import System.FilePath import System.Directory (getCurrentDirectory, setCurrentDirectory)-import Data.List.Compat (isPrefixOf, sort)+import System.IO.Temp (withSystemTempDirectory)+import Data.List (isPrefixOf, sort) import System.IO.Silently import System.IO (stderr)@@ -17,9 +18,6 @@ import Run -doctestWithDefaultOptions :: [String] -> IO Summary-doctestWithDefaultOptions = doctestWithOptions Options.defaultFastMode Options.defaultPreserveIt Options.defaultVerbose- withCurrentDirectory :: FilePath -> IO a -> IO a withCurrentDirectory workingDir action = do E.bracket getCurrentDirectory setCurrentDirectory $ \_ -> do@@ -37,6 +35,17 @@ removeLoadedPackageEnvironment = id #endif +verboseFibOutput :: String+verboseFibOutput = unlines [+ "### Started execution at test/integration/testSimple/Fib.hs:5."+ , "### example:"+ , "fib 10"+ , "### Successful!"+ , ""+ , "# Final summary:"+ , "Examples: 1 Tried: 1 Errors: 0 Failures: 0"+ ]+ spec :: Spec spec = do describe "doctest" $ do@@ -72,17 +81,18 @@ , "Try `doctest --help' for more information." ] + it "interprets GHC response files" $ do+ withSystemTempDirectory "hspec" $ \ dir -> do+ let file = dir </> "response-file"+ writeFile file $ unlines [+ "test/integration/testSimple/Fib.hs"+ ]+ (r, ()) <- hCapture [stderr] $ doctest ["--verbose", '@':file]+ removeLoadedPackageEnvironment r `shouldBe` verboseFibOutput+ it "prints verbose description of a specification" $ do (r, ()) <- hCapture [stderr] $ doctest ["--verbose", "test/integration/testSimple/Fib.hs"]- removeLoadedPackageEnvironment r `shouldBe` unlines [- "### Started execution at test/integration/testSimple/Fib.hs:5."- , "### example:"- , "fib 10"- , "### Successful!"- , ""- , "# Final summary:"- , "Examples: 1 Tried: 1 Errors: 0 Failures: 0"- ]+ removeLoadedPackageEnvironment r `shouldBe` verboseFibOutput it "prints verbose description of a property" $ do (r, ()) <- hCapture [stderr] $ doctest ["--verbose", "test/integration/property-bool/Foo.hs"]@@ -117,33 +127,56 @@ hSilence [stderr] $ doctest ["-fdiagnostics-color=always", "test/integration/color/Foo.hs"] #endif - describe "doctestWithOptions" $ do+ describe "doctestWithResult" $ do context "on parse error" $ do- let action = withCurrentDirectory "test/integration/parse-error" (doctestWithDefaultOptions ["Foo.hs"])+ let+ action :: IO Result+ action = withCurrentDirectory "test/integration/parse-error" $ do+ doctestWithResult defaultConfig {+ ghcOptions = [+ "Foo.hs" + -- This is necessary due to:+ --+ -- https://gitlab.haskell.org/ghc/ghc/-/commit/88f38b03025386f0f1e8f5861eed67d80495168a+ --+ -- It will be fixed by:+ --+ -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/15995+ --+ , "-fdiagnostics-color=never"+#if __GLASGOW_HASKELL__ >= 910+ , "-fprint-error-index-links=never"+#endif+ ]+ }+ it "aborts with (ExitFailure 1)" $ do hSilence [stderr] action `shouldThrow` (== ExitFailure 1) it "prints a useful error message" $ do (r, _) <- hCapture [stderr] (E.try action :: IO (Either ExitCode Summary))-#if __GLASGOW_HASKELL__ < 706- r `shouldBe` "\nFoo.hs:6:1: parse error (possibly incorrect indentation)\n"-#else--#if __GLASGOW_HASKELL__ < 800- r `shouldBe` "\nFoo.hs:6:1:\n parse error (possibly incorrect indentation or mismatched brackets)\n"+ removeLoadedPackageEnvironment r `shouldBe` unlines (+#if __GLASGOW_HASKELL__ < 910+ "" :+#endif+#if __GLASGOW_HASKELL__ >= 906+ [ "Foo.hs:6:1: error: [GHC-58481]" #else- removeLoadedPackageEnvironment r `shouldBe` "\nFoo.hs:6:1: error:\n parse error (possibly incorrect indentation or mismatched brackets)\n"+ [ "Foo.hs:6:1: error:" #endif-+ , " parse error (possibly incorrect indentation or mismatched brackets)"+#if __GLASGOW_HASKELL__ >= 910+ , "" #endif+ ]) describe "expandDirs" $ do it "expands a directory" $ do res <- expandDirs "example" sort res `shouldBe`- [ "example/src/Example.hs"- , "example/test/doctests.hs"+ [ "example" </> "src" </> "Example.hs"+ , "example" </> "test" </> "doctests.hs" ] it "ignores files" $ do res <- expandDirs "doctest.cabal"
test/Runner/ExampleSpec.hs view
@@ -1,8 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Runner.ExampleSpec (main, spec) where -import Prelude ()-import Prelude.Compat+import Imports import Data.String import Test.Hspec
test/RunnerSpec.hs view
@@ -1,91 +1,44 @@ {-# LANGUAGE CPP, OverloadedStrings #-}-module RunnerSpec (main, spec) where+module RunnerSpec (spec) where -import Test.Hspec+import Imports -#if __GLASGOW_HASKELL__ < 710-import Data.Monoid-#endif+import Test.Hspec +import Data.IORef import System.IO-import System.IO.Silently (hCapture)-import Control.Monad.Trans.State+import System.IO.Silently (hCapture_) import Runner -main :: IO ()-main = hspec spec--capture :: Report a -> IO String-capture = fmap fst . hCapture [stderr] . (`execStateT` ReportState 0 True False mempty)---- like capture, but with interactivity set to False-capture_ :: Report a -> IO String-capture_ = fmap fst . hCapture [stderr] . (`execStateT` ReportState 0 False False mempty)+capture :: Interactive -> Report () -> IO String+capture interactive action = do+ ref <- newIORef mempty+ hCapture_ [stderr] (runReport (ReportState interactive NoFailFast NonVerbose ref) action) spec :: Spec spec = do- describe "report" $ do- context "when mode is interactive" $ do- it "writes to stderr" $ do- capture $ do+ capture Interactive $ do report "foobar" `shouldReturn` "foobar\n" - it "overwrites any intermediate output" $ do- capture $ do- report_ "foo"- report "bar"- `shouldReturn` "foo\rbar\n"-- it "blank out intermediate output if necessary" $ do- capture $ do- report_ "foobar"- report "baz"- `shouldReturn` "foobar\rbaz \n"- context "when mode is non-interactive" $ do it "writes to stderr" $ do- capture_ $ do+ capture NonInteractive $ do report "foobar" `shouldReturn` "foobar\n" describe "report_" $ do- context "when mode is interactive" $ do- it "writes intermediate output to stderr" $ do- capture $ do- report_ "foobar"- `shouldReturn` "foobar"-- it "overwrites any intermediate output" $ do- capture $ do- report_ "foo"- report_ "bar"- `shouldReturn` "foo\rbar"-- it "blank out intermediate output if necessary" $ do- capture $ do- report_ "foobar"- report_ "baz"- `shouldReturn` "foobar\rbaz "+ it "writes transient output to stderr" $ do+ capture Interactive $ do+ reportTransient "foobar"+ `shouldReturn` "foobar\r \r" context "when mode is non-interactive" $ do it "is ignored" $ do- capture_ $ do- report_ "foobar"+ capture NonInteractive $ do+ reportTransient "foobar" `shouldReturn` ""-- it "does not influence a subsequent call to `report`" $ do- capture_ $ do- report_ "foo"- report "bar"- `shouldReturn` "bar\n"-- it "does not require `report` to blank out any intermediate output" $ do- capture_ $ do- report_ "foobar"- report "baz"- `shouldReturn` "baz\n"
test/UtilSpec.hs view
@@ -1,5 +1,7 @@ module UtilSpec (main, spec) where +import Imports+ import Test.Hspec import Util
− test/doctests.hs
@@ -1,12 +0,0 @@-module Main where--import Test.DocTest--main :: IO ()-main = doctest [- "-packageghc"- , "-isrc"- , "-ighci-wrapper/src"- , "src/Run.hs"- , "src/PackageDBs.hs"- ]
+ test/integration/fail-fast/Bar.hs view
@@ -0,0 +1,8 @@+module Bar where++-- | bar+-- a passing test+-- >>> bar+-- 42+bar :: Int+bar = 42
+ test/integration/fail-fast/Foo.hs view
@@ -0,0 +1,24 @@+module Foo where++import Bar++-- | A passing example+--+-- >>> 23+-- 23+test1 :: a+test1 = undefined++-- | A failing example+--+-- >>> 23+-- 42+test2 :: a+test2 = undefined++-- | Another passing example+--+-- >>> 23+-- 23+test3 :: a+test3 = undefined
+ test/integration/fail-fast/SetupBar.hs view
@@ -0,0 +1,12 @@+module SetupBar where++-- $setup+-- >>> 23+-- 23++-- | bar+-- a passing test+-- >>> bar+-- 42+bar :: Int+bar = 42
+ test/integration/fail-fast/SetupFoo.hs view
@@ -0,0 +1,29 @@+module SetupFoo where++import SetupBar+++-- $setup+-- >>> 24+-- 23++-- | A passing example+--+-- >>> 23+-- 23+test1 :: a+test1 = undefined++-- | A failing example+--+-- >>> 23+-- 42+test2 :: a+test2 = undefined++-- | Another passing example+--+-- >>> 23+-- 23+test3 :: a+test3 = undefined