packages feed

doctest 0.9.13 → 0.25.0

raw patch · 129 files changed

Files

+ CHANGES.markdown view
@@ -0,0 +1,224 @@+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-*`++Changes in 0.18.2+  - GHC 9.2 compatibility. (#305, thanks to Ryan Scott and Matthew Pickering)++Changes in 0.18.1+  - GHC 9.0 compatibility. (#275)++Changes in 0.18+  - Don't use unqualified references to `stderr` or `stdout` which may collide with definitions in user code. (#201)+  - Remove support for cabal-install sandboxes. They have been obsoleted in practice by Nix-style builds in cabal-install (i.e., the `v2-*` commands) and stack.++Changes in 0.17+  - #266:+    - doctest now annotates its internal marker string as a `String`, to prevent misbehaviour in `OverloadedStrings` environments. This has a theoretical chance of breakage; if you're affected, please open an issue.+    - `evalEcho` no longer preserves `it`.++Changes in 0.16.3+  - Add a cursor to highlight the differing portion between the+    expected and actual output. (#249)+  - GHC 8.10 compatibility. (#247, #257)++Changes in 0.16.2+  - Add doctest's necessary-for-operation options to GHC's command+    line at the end, so that they over-ride anything provided by the+    user. (#233)+  - Allow GHC 8.8.++Changes in 0.16.1+  - Fix loading plugins in doctests. (#224)+  - Require QuickCheck 2.13.1 or newer.+  - Remove dependency on `with-location`++Changes in 0.16.0.1+  - Bump bounds to allow GHC 8.6. (#210)++Changes in 0.16.0+  - Output format has changed to (hopefully) be more machine consumable. (#200)++Changes in 0.15.0+  - Add `--verbose` for printing each test as it is run++Changes in 0.14.1+  - Add test assets to source tarball (see #189)++Changes in 0.14.0+  - GHC 8.4 compatibility.++Changes in 0.13.0+  - Add `--preserve-it` for allowing the `it` variable to be preserved between examples++Changes in 0.12.0+  - Preserve the 'it' variable between examples++Changes in 0.11.4+  - Add `--fast`, which disables running `:reload` between example groups++Changes in 0.11.3+  - Add `--info`+  - Add `--no-magic`++Changes in 0.11.2+  - Make `...` match zero lines++Changes in 0.11.1+ - Fix an issue with Unicode output on Windows (see #149)++Changes in 0.11.0+ - Support for GHC 8.0.1-rc2++Changes in 0.10.1+ - Automatically expand directories into contained Haskell source files (thanks @snoyberg)+ - Add cabal_macros.h and autogen dir by default (thanks @snoyberg)++Changes in 0.10.0+ - Support HASKELL_PACKAGE_SANDBOXES (thanks @snoyberg)++Changes in 0.9.13+ - Add ellipsis as wildcard++Changes in 0.9.12+ - Add support for GHC 7.10++Changes in 0.9.11+ - Defaults ambiguous type variables to Integer (#74)++Changes in 0.9.10+ - Add support for the upcoming GHC 7.8 release++Changes in 0.9.9+ - Add support for multi-line statements++Changes in 0.9.8+ - Support for GHC HEAD (7.7)++Changes in 0.9.7+ - Ignore trailing whitespace when matching example output++Changes in 0.9.6+ - Fail gracefully if GHCi is not supported (#46)++Changes in 0.9.5+ - Fix a GHC panic with GHC 7.6.1 (#41)++Changes in 0.9.4+ - Respect HASKELL_PACKAGE_SANDBOX (#39)+ - Print path to ghc on --version++Changes in 0.9.3+ - Properly handle additional object files (#38)++Changes in 0.9.2+ - Add support for QuickCheck properties++Changes in 0.9.1+ - Fix an issue with GHC 7.6.1 and type families++Changes in 0.9.0+ - Add support for setup code (see README).+ - There is no distinction between example/interaction anymore.  Each+   expression is counted as an example in the summary.++Changes in 0.8.0+ - Doctest now directly accepts arbitrary GHC options, prefixing GHC options+   with --optghc is no longer necessary++Changes in 0.7.0+ - Print source location for failing tests+ - Output less clutter on failing examples+ - Expose Doctest's functionality through a very simplistic API, which can be+   used for cabal integration++Changes in 0.6.1+ - Fix a parser bug with CR+LF line endings++Changes in 0.6.0+ - Support for ghc-7.4+ - Doctest now comes with it's own parser and does not depend on Haddock+   anymore++Changes in 0.5.2+ - Proper handling of singular/plural when printing stats+ - Improve handling of invalid command line options++Changes in 0.5.1+ - Adapted for ghc-7.2++Changes in 0.5.0+ - Print number of interactions to stderr before running tests+ - Exit with exitFailure on failed tests+ - Improve documentation+ - Give a useful error message if ghc is not executable
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2009-2015 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.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,114 +1,304 @@-name:             doctest-version:          0.9.13-synopsis:         Test interactive Haskell examples-description:      The doctest program checks examples in source code comments.-                  It is modeled after doctest for Python-                  (<http://docs.python.org/library/doctest.html>).-                  .-                  Documentation is at-                  <https://github.com/sol/doctest#readme>.-category:         Testing-bug-reports:      https://github.com/sol/doctest/issues-homepage:         https://github.com/sol/doctest#readme-license:          MIT-license-file:     LICENSE-copyright:        (c) 2009-2015 Simon Hengel-author:           Simon Hengel <sol@typeful.net>-maintainer:       Simon Hengel <sol@typeful.net>-build-type:       Simple-cabal-version:    >= 1.8-extra-source-files: example/example.cabal-                  , example/src/Example.hs-                  , example/test/doctests.hs+cabal-version: 1.12 +-- This file has been generated from package.yaml by hpack version 0.39.1.+--+-- see: https://github.com/sol/hpack++name:           doctest+version:        0.25.0+synopsis:       Test interactive Haskell examples+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+bug-reports:    https://github.com/sol/doctest/issues+homepage:       https://github.com/sol/doctest#readme+license:        MIT+license-file:   LICENSE+copyright:      (c) 2009-2026 Simon Hengel+author:         Simon Hengel <sol@typeful.net>+maintainer:     Simon Hengel <sol@typeful.net>+build-type:     Simple+extra-source-files:+    example/example.cabal+    example/src/Example.hs+    example/test/doctests.hs+    test/parse/multiple-examples/Foo.hs+    test/parse/no-examples/Fib.hs+    test/parse/non-exported/Fib.hs+    test/parse/property/Fib.hs+    test/parse/setup-empty/Foo.hs+    test/parse/setup-only/Foo.hs+    test/parse/simple/Fib.hs+    test/extract/argument-list/Foo.hs+    test/extract/comment-order/Foo.hs+    test/extract/declaration/Foo.hs+    test/extract/dos-line-endings/Foo.hs+    test/extract/export-list/Foo.hs+    test/extract/imported-module/Bar.hs+    test/extract/imported-module/Baz.hs+    test/extract/module-header/Foo.hs+    test/extract/named-chunks/Foo.hs+    test/extract/regression/Fixity.hs+    test/extract/regression/ForeignImport.hs+    test/extract/regression/ParallelListComp.hs+    test/extract/regression/ParallelListCompClass.hs+    test/extract/regression/RewriteRules.hs+    test/extract/regression/RewriteRulesWithSigs.hs+    test/extract/setup/Foo.hs+    test/extract/th/Bar.hs+    test/extract/th/Foo.hs+    test/extract/type-class-args/Foo.hs+    test/extract/type-class/Foo.hs+    test/extract/type-families/Foo.hs+    test/integration/bugfixImportHierarchical/ModuleA.hs+    test/integration/bugfixImportHierarchical/ModuleB.hs+    test/integration/bugfixMultipleModules/ModuleA.hs+    test/integration/bugfixMultipleModules/ModuleB.hs+    test/integration/bugfixOutputToStdErr/Fib.hs+    test/integration/bugfixWorkingDirectory/description+    test/integration/bugfixWorkingDirectory/examples/Fib.hs+    test/integration/bugfixWorkingDirectory/Fib.hs+    test/integration/color/Foo.hs+    test/integration/custom-package-conf/Bar.hs+    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+    test/integration/it/Setup.hs+    test/integration/local-stderr-binding/A.hs+    test/integration/multiline/Multiline.hs+    test/integration/parse-error/Foo.hs+    test/integration/property-bool-with-type-signature/Foo.hs+    test/integration/property-bool/Foo.hs+    test/integration/property-failing/Foo.hs+    test/integration/property-implicitly-quantified/Foo.hs+    test/integration/property-quantified/Foo.hs+    test/integration/property-setup/Foo.hs+    test/integration/setup-skip-on-failure/Foo.hs+    test/integration/setup/Foo.hs+    test/integration/system-io-imported/A.hs+    test/integration/template-haskell-bugfix/Main.hs+    test/integration/template-haskell-bugfix/Printf.hs+    test/integration/template-haskell/Foo.hs+    test/integration/test-options/Foo.hs+    test/integration/testBlankline/Fib.hs+    test/integration/testCombinedExample/Fib.hs+    test/integration/testCommentLocation/Foo.hs+    test/integration/testCPP/Foo.hs+    test/integration/testDocumentationForArguments/Fib.hs+    test/integration/testFailOnMultiline/Fib.hs+    test/integration/testImport/ModuleA.hs+    test/integration/testImport/ModuleB.hs+    test/integration/testPutStr/Fib.hs+    test/integration/testSimple/Fib.hs+    test/integration/trailing-whitespace/Foo.hs+    test/integration/with-cbits/Bar.hs+    test/integration/with-cbits/foo.c+    CHANGES.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-  exposed-modules:-      Test.DocTest-  ghc-options:-      -Wall+  ghc-options: -Wall   hs-source-dirs:       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-    , Interpreter-    , Location-    , Help-    , Parse-    , Paths_doctest-    , Property-    , Runner-    , Runner.Example-    , Run-    , Util-    , Sandbox+      GhcUtil+      Imports+      Info+      Interpreter+      Language.Haskell.GhciWrapper+      Location+      Options+      PackageDBs+      Parse+      Property+      Run+      Runner+      Runner.Example+      Util+      Paths_doctest   build-depends:-      base          == 4.*-    , ghc           >= 7.0 && < 7.12-    , syb           >= 0.3 && < 0.5+      base >=4.12 && <5+    , code-page >=0.1+    , containers     , deepseq     , directory+    , exceptions     , filepath+    , ghc >=8.6 && <9.16+    , ghc-paths >=0.1.0.9     , process-    , ghc-paths     >= 0.1.0.9+    , 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 cabal-doctest+  main-is: driver/cabal-doctest.hs+  other-modules:+      Paths_doctest+  default-extensions:+      NamedFieldPuns+      RecordWildCards+      DeriveFunctor+      NoImplicitPrelude+  ghc-options: -Wall -threaded+  build-depends:+      base >=4.12 && <5+    , doctest+  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+ executable doctest-  main-is:-      Main.hs-  ghc-options:-      -Wall -threaded-  hs-source-dirs:-      driver+  main-is: driver/doctest.hs+  other-modules:+      Paths_doctest+  ghc-options: -Wall -threaded+  default-extensions:+      NamedFieldPuns+      RecordWildCards+      DeriveFunctor+      NoImplicitPrelude   build-depends:-      base          == 4.*+      base >=4.12 && <5     , doctest+  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-  type:-      exitcode-stdio-1.0-  ghc-options:-      -Wall -threaded-  cpp-options:-      -DTEST+  main-is: Spec.hs+  other-modules:+      Cabal.OptionsSpec+      Cabal.PathsSpec+      Cabal.ReplOptionsSpec+      ExtractSpec+      InfoSpec+      InterpreterSpec+      Language.Haskell.GhciWrapperSpec+      LocationSpec+      MainSpec+      OptionsSpec+      PackageDBsSpec+      ParseSpec+      PropertySpec+      Runner.ExampleSpec+      RunnerSpec+      RunSpec+      UtilSpec+      Cabal+      Cabal.Options+      Cabal.Paths+      Cabal.ReplOptions+      Extract+      GhcUtil+      Imports+      Info+      Interpreter+      Language.Haskell.GhciWrapper+      Location+      Options+      PackageDBs+      Parse+      Property+      Run+      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+      Paths_doctest+  type: exitcode-stdio-1.0+  ghc-options: -Wall -threaded+  cpp-options: -DTEST   hs-source-dirs:-      src, test+      test+      src+  default-extensions:+      NamedFieldPuns+      RecordWildCards+      DeriveFunctor+      NoImplicitPrelude   c-sources:       test/integration/with-cbits/foo.c+  build-tool-depends:+      hspec-discover:hspec-discover   build-depends:-      base-    , ghc-    , syb+      HUnit+    , QuickCheck >=2.13.1+    , base >=4.12 && <5+    , code-page >=0.1+    , containers     , deepseq     , directory+    , exceptions     , filepath+    , ghc >=8.6 && <9.16+    , ghc-paths >=0.1.0.9+    , hspec >=2.3.0+    , hspec-core >=2.3.0+    , mockery     , process-    , ghc-paths+    , silently >=1.2.4+    , stringbuilder >=0.4+    , syb >=0.3+    , temporary     , transformers--    , base-compat   >= 0.4.2-    , HUnit-    , hspec         >= 1.5.1-    , QuickCheck    >= 2.5-    , stringbuilder >= 0.4-    , silently      >= 1.2.4-    , setenv--test-suite doctests-  main-is:-      doctests.hs-  type:-      exitcode-stdio-1.0-  ghc-options:-      -Wall -threaded-  hs-source-dirs:-      test-  build-depends:-      base-    , doctest+  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
+ 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,36 +1,33 @@-{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-}+{-# LANGUAGE CPP #-} module Extract (Module(..), extract) where -import           Prelude hiding (mod, concat)-import           Control.Monad-import           Control.Applicative-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)-#else+#if __GLASGOW_HASKELL__ < 900 import           GHC hiding (Module, Located) import           DynFlags import           MonadUtils (liftIO)+#else+import           GHC hiding (Module, Located)+import           GHC.Driver.Session+import           GHC.Utils.Monad (liftIO) #endif++#if __GLASGOW_HASKELL__ < 900+import           Digraph (flattenSCCs) import           Exception (ExceptionMonad)+#else+import           GHC.Data.Graph.Directed (flattenSCCs)+import           GHC.Utils.Exception (ExceptionMonad)+import           Control.Monad.Catch (generalBracket)+#endif+ import           System.Directory import           System.FilePath-#if __GLASGOW_HASKELL__ < 710-import           NameSet (NameSet)-#endif-import           Coercion (Coercion)-import           FastString (unpackFS)-import           Digraph (flattenSCCs)  import           System.Posix.Internals (c_getpid) @@ -38,11 +35,23 @@ import           Location hiding (unLoc)  import           Util (convertDosLineEndings)-import           Sandbox (getSandboxArguments)+import           PackageDBs (getPackageDBArgs) +#if __GLASGOW_HASKELL__ < 900+import           DynamicLoading (initializePlugins)+#else+import           GHC.Runtime.Loader (initializePlugins)+#endif++#if __GLASGOW_HASKELL__ >= 901+import           GHC.Unit.Module.Graph+#endif+ -- | 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) =@@ -67,54 +76,46 @@   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` ()  -- | Parse a list of modules.-parse :: [String] -> IO [TypecheckedModule]+parse :: [String] -> IO [ParsedModule] parse args = withGhc args $ \modules_ -> withTempOutputDir $ do    -- ignore additional object files   let modules = filter (not . isSuffixOf ".o") modules_ -  mapM (`guessTarget` Nothing) modules >>= setTargets+  setTargets =<< forM modules (\ m -> guessTarget m+#if __GLASGOW_HASKELL__ >= 903+                Nothing+#endif+                Nothing)   mods <- depanal [] False -  mods' <- if needsTemplateHaskell mods then enableCompilation mods else return mods--  let sortedMods = flattenSCCs (topSortModuleGraph False mods' Nothing)-  reverse <$> mapM (parseModule >=> typecheckModule >=> loadModule) sortedMods-  where-    -- copied from Haddock/Interface.hs-    enableCompilation :: ModuleGraph -> Ghc ModuleGraph-    enableCompilation modGraph = do-#if __GLASGOW_HASKELL__ < 707-      let enableComp d = d { hscTarget = defaultObjectTarget }-#else-      let enableComp d = let platform = targetPlatform d-                         in d { hscTarget = defaultObjectTarget platform }+  let sortedMods =+#if __GLASGOW_HASKELL__ >= 914+                   mapMaybe maybeModSummaryFromModuleNodeInfo $ #endif-      modifySessionDynFlags enableComp-      -- We need to update the DynFlags of the ModSummaries as well.-      let upd m = m { ms_hspp_opts = enableComp (ms_hspp_opts m) }-      let modGraph' = map upd modGraph-      return modGraph'+                   flattenSCCs+#if __GLASGOW_HASKELL__ >= 901+                     $ filterToposortToModules+#endif+                     $ topSortModuleGraph False mods Nothing+  reverse <$> mapM (loadModPlugins >=> parseModule) sortedMods+  where      -- copied from Haddock/GhcUtils.hs     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@@ -131,25 +132,51 @@     -- | A variant of 'gbracket' where the return value from the first computation     -- is not required.     gbracket_ :: ExceptionMonad m => m a -> m b -> m c -> m c+#if __GLASGOW_HASKELL__ < 900     gbracket_ before_ after thing = gbracket before_ (const after) (const thing)+#else+    gbracket_ before_ after thing = fst <$> generalBracket before_ (\ _ _ -> after) (const thing)+#endif      setOutputDir f d = d {         objectDir  = Just f       , hiDir      = Just f       , stubDir    = Just f-      , includePaths = f : includePaths d+      , includePaths = addQuoteInclude (includePaths d) [f]       } +    -- 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__ >= 902+      hsc_env' <- liftIO (initializePlugins hsc_env)+      setSession hsc_env'+      return modsum+# else+      dynflags' <- liftIO (initializePlugins hsc_env (GHC.ms_hspp_opts modsum))+      return $ modsum { ms_hspp_opts = dynflags' }+# endif+ -- | Extract all docstrings from given list of files/modules. -- -- This includes the docstrings of all local modules that are imported from -- those modules (possibly indirect). extract :: [String] -> IO [Module (Located String)] extract args = do-  sandboxArgs <- getSandboxArguments-  let args'  = args ++ sandboxArgs+  packageDBArgs <- getPackageDBArgs+  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 . tm_parsed_module) mods+  let docs = map (fmap (fmap convertDosLineEndings) . extractFromModule) mods    (docs `deepseq` return docs) `catches` [       -- Re-throw AsyncException, otherwise execution will not terminate on@@ -168,87 +195,94 @@     (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 unpackDocString)) docs+docStringsFromModule mod = map (fmap (toLocated . fmap unpackHDS)) docs   where     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]]-#if __GLASGOW_HASKELL__ < 710-    exports = [(Nothing, L loc doc) | L loc (IEDoc doc) <- concat (hsmodExports source)]+#endif+    exports :: [(Maybe String, LHsDocString)]+#if __GLASGOW_HASKELL__ >= 904+    exports = [ (Nothing, L (locA loc) (hsDocString (unLoc doc))) #else-    exports = [(Nothing, L loc doc) | 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)---- | Ignore a subtree.-ignore :: Selector a-ignore = const ([], True)---- | 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)-#endif--  -- 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))+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)) -  -- undefined before type checking-  `extQ` (ignore :: Selector Coercion)+    extractDocDocString :: LHsDoc GhcPs -> LHsDocString+    extractDocDocString = fmap hsDocString -#if __GLASGOW_HASKELL__ >= 706-#if __GLASGOW_HASKELL__ < 710-  -- 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)))+    extractDocName :: DocDecl GhcPs -> Maybe (SrcSpan, String)+    extractDocName docDecl = case docDecl of+      DocCommentNamed name y ->+        Just (getLoc y, name)+      _ ->+        Nothing #else-  -- hswb_kvs and hswb_tvs may be error thunks-  `extQ` (ignore :: Selector (HsWithBndrs RdrName [LHsType RdrName]))-  `extQ` (ignore :: Selector (HsWithBndrs Name    [LHsType Name]))-  `extQ` (ignore :: Selector (HsWithBndrs RdrName (LHsType RdrName)))-  `extQ` (ignore :: Selector (HsWithBndrs Name    (LHsType Name)))-#endif-#endif-  )+  everythingBut (++) (([], False) `mkQ` fromLHsDecl+  `extQ` fromLDocDecl+  `extQ` fromLHsDocString+  ) d   where-    fromLHsDecl :: Selector (LHsDecl RdrName)+    fromLHsDecl :: Selector (LHsDecl GhcPs)     fromLHsDecl (L loc decl) = case decl of        -- Top-level documentation has to be treated separately, because it has       -- no location information attached.  The location information is       -- attached to HsDecl instead.-      DocD x -> select (fromDocDecl loc x)+      DocD _ x+               -> select (fromDocDecl (locA loc) x)        _ -> (extractDocStrings decl, True) -    fromLDocDecl :: Selector LDocDecl-    fromLDocDecl (L loc x) = select (fromDocDecl loc x)+    fromLDocDecl :: Selector+#if __GLASGOW_HASKELL__ >= 901+                             (LDocDecl GhcPs)+#else+                             LDocDecl+#endif+    fromLDocDecl (L loc x) = select (fromDocDecl (locA loc) x)      fromLHsDocString :: Selector LHsDocString     fromLHsDocString x = select (Nothing, x)@@ -258,6 +292,14 @@       DocCommentNamed name doc -> (Just name, L loc doc)       _                        -> (Nothing, L loc $ docDeclDoc x) --- | Convert a docstring to a plain string.-unpackDocString :: HsDocString -> String-unpackDocString (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+locA :: SrcSpan -> SrcSpan+locA = id+#endif
src/GhcUtil.hs view
@@ -1,70 +1,59 @@ {-# 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-import           Panic (throwGhcException) -import           MonadUtils (liftIO)-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)+#if __GLASGOW_HASKELL__ < 900+import           Panic (throwGhcException) #else-import           StaticFlags (discardStaticFlags)+import           GHC.Utils.Panic (throwGhcException) #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)+#if __GLASGOW_HASKELL__ < 900+import           MonadUtils (liftIO) #else-bracketStaticFlags action = action+import           GHC.Utils.Monad (liftIO) #endif +import           GHC.ResponseFile (expandResponse)+import           System.Exit (exitFailure)+ -- 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+withGhc flags action = runGhc (Just libdir) $ do+  liftIO (expandUnits flags) >>= handleDynamicFlags >>= handleSrcErrors . action -  runGhc (Just libdir) $ do-    handleDynamicFlags flags_ >>= handleSrcErrors . action+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 -handleStaticFlags :: [String] -> IO [Located String]-#if __GLASGOW_HASKELL__ < 707-handleStaticFlags flags = fst `fmap` parseStaticFlags (map noLoc flags)+handleDynamicFlags :: GhcMonad m => [String] -> m [String]+handleDynamicFlags flags = do+#if __GLASGOW_HASKELL__ >= 901+  logger <- getLogger+  let parseDynamicFlags' = parseDynamicFlags logger #else-handleStaticFlags flags = return $ map noLoc $ discardStaticFlags flags+  let parseDynamicFlags' = parseDynamicFlags #endif--handleDynamicFlags :: GhcMonad m => [Located String] -> m [String]-handleDynamicFlags flags = do-  (dynflags, locSrcs, _) <- (setHaddockMode `fmap` getSessionDynFlags) >>= flip 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@@ -76,12 +65,14 @@     _       -> 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__ >= 906+      backend   = noBackend+#elif __GLASGOW_HASKELL__ >= 901+      backend   = NoBackend+#else       hscTarget = HscNothing+#endif     , ghcMode   = CompManager     , ghcLink   = NoLink     }
− src/Help.hs 
@@ -1,27 +0,0 @@-module Help (-  usage-, printVersion-) where--import           Paths_doctest (version)-import           Data.Version (showVersion)-import           Config as GHC-import           Interpreter (ghc)--usage :: String-usage = unlines [-          "Usage:"-        , "  doctest [ GHC OPTION | MODULE ]..."-        , "  doctest --help"-        , "  doctest --version"-        , ""-        , "Options:"-        , "  --help     display this help and exit"-        , "  --version  output version information and exit"-        ]--printVersion :: IO ()-printVersion = do-  putStrLn ("doctest version " ++ showVersion version)-  putStrLn ("using version " ++ GHC.cProjectVersion ++ " of the GHC API")-  putStrLn ("using " ++ ghc)
+ 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,7 +1,9 @@+{-# LANGUAGE CPP #-} module Interpreter (   Interpreter-, eval+, PreserveIt(..) , safeEval+, safeEvalWith , withInterpreter , ghc , interpreterSupported@@ -9,34 +11,16 @@ -- exported for testing , ghcInfo , haveInterpreterKey+, filterExpression ) where -import           System.IO+import           Imports+ import           System.Process-import           System.Exit import           System.Directory (getPermissions, executable)-import           Control.Monad (when, unless)-import           Control.Applicative-import           Control.Exception hiding (handle)-import           Data.Char-import           Data.List- import           GHC.Paths (ghc)-import           Sandbox (getSandboxArguments) --- | 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"--data Interpreter = Interpreter {-    hIn  :: Handle-  , hOut :: Handle-  , process :: ProcessHandle-  }+import           Language.Haskell.GhciWrapper  haveInterpreterKey :: String haveInterpreterKey = "Have interpreter"@@ -52,147 +36,51 @@   unless (executable x) $ do     fail $ ghc ++ " is not executable!" -  maybe False (== "YES") . lookup haveInterpreterKey <$> ghcInfo--newInterpreter :: [String] -> IO Interpreter-newInterpreter flags = do-  sandboxFlags <- getSandboxArguments-  let myFlags = ghciFlags ++ flags ++ sandboxFlags-  -- get examples from Haddock comments-  (Just stdin_, Just stdout_, Nothing, processHandle ) <- createProcess $ (proc ghc myFlags) {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 System.IO"-  _ <- eval interpreter "import GHC.IO.Handle"-  -- The buffering of stdout and stderr is NoBuffering-  _ <- eval interpreter "hDuplicateTo stdout 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 "hSetBuffering stdout LineBuffering"-  _ <- eval interpreter "hSetBuffering stderr LineBuffering"--  -- this is required on systems that don't use utf8 as default encoding (e.g.-  -- Windows)-  _ <- eval interpreter "hSetEncoding stdout utf8"-  _ <- eval interpreter "hSetEncoding stderr utf8"--  return interpreter-  where-    ghciFlags = ["-v0", "--interactive", "-ignore-dot-ghci"]-    setMode handle = do-      hSetBinaryMode handle False-      hSetBuffering handle LineBuffering-      hSetEncoding handle utf8-+  (== 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 = bracket (newInterpreter flags) closeInterpreter---closeInterpreter :: Interpreter -> IO ()-closeInterpreter 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+withInterpreter (command, flags) action = do+  let+    args = flags ++ [+        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 = command} args) close action -  when (e /= ExitSuccess) $ error $ "Interpreter exited with an error: " ++ show e-  return ()+xTemplateHaskell :: String+xTemplateHaskell = "-XTemplateHaskell" -putExpression :: Interpreter -> String -> IO ()-putExpression repl e = do-  hPutStrLn stdin_ $ filterExpression e-  hPutStrLn stdin_ marker-  hFlush stdin_-  return ()-  where-    stdin_ = hIn repl+-- | Evaluate an expression; return a Left value on exceptions.+--+-- An exception may e.g. be caused on unterminated multiline expressions.+safeEval :: Interpreter -> String -> IO (Either String String)+safeEval = safeEvalWith NoPreserveIt +safeEvalWith :: PreserveIt -> Interpreter -> String -> IO (Either String String)+safeEvalWith preserveIt repl = either (return . Left) (fmap Right . evalWith preserveIt repl) . filterExpression --- | Fail on unterminated multiline commands.------ Examples:------ >>> filterExpression ""--- ""------ >>> filterExpression "foobar"--- "foobar"------ >>> filterExpression ":{"--- "*** Exception: unterminated multiline command------ >>> filterExpression "  :{  "--- "*** Exception: unterminated multiline command------ >>> filterExpression "  :{  \nfoobar"--- "*** Exception: unterminated multiline command------ >>> filterExpression "  :{  \nfoobar \n  :}  "--- "  :{  \nfoobar \n  :}  "----filterExpression :: String -> String+filterExpression :: String -> Either String String filterExpression e =   case lines e of-    [] -> e-    l  -> if firstLine == ":{" && lastLine /= ":}" then fail_ else e+    [] -> Right e+    l  -> if firstLine == ":{" && lastLine /= ":}" then err else Right (filterXTemplateHaskell e)       where         firstLine = strip $ head l         lastLine  = strip $ last l-        fail_ = error "unterminated multiline command"-  where-    strip :: String -> String-    strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse---getResult :: Interpreter -> IO String-getResult repl = do-  line <- hGetLine stdout_-  if marker `isSuffixOf` line-    then-      return $ stripMarker line-    else do-      result <- getResult repl-      return $ line ++ '\n' : result-  where-    stdout_ = hOut repl-    stripMarker l = take (length l - length marker) l---- | Evaluate an expresion-eval-  :: Interpreter-  -> String       -- Expression-  -> IO String    -- Result-eval repl expr = do-  putExpression repl expr-  getResult repl---- | Evaluate an expression; return a Left value on exceptions.------ An exception may e.g. be caused on unterminated multiline expressions.-safeEval :: Interpreter -> String -> IO (Either String String)-safeEval repl expression = (Right `fmap` Interpreter.eval repl expression) `catches` [-  -- Re-throw AsyncException, otherwise execution will not terminate on-  -- SIGINT (ctrl-c).  All AsyncExceptions are re-thrown (not just-  -- UserInterrupt) because all of them indicate severe conditions and-  -- should not occur during normal test runs.-  Handler $ \e -> throw (e :: AsyncException),+        err = Left "unterminated multi-line command" -  Handler $ \e -> (return . Left . show) (e :: SomeException)-  ]+filterXTemplateHaskell :: String -> String+filterXTemplateHaskell input = case words input of+  [":set", setting] | setting == xTemplateHaskell -> ""+  ":set" : xs | xTemplateHaskell `elem` xs -> unwords $ ":set" : filter (/= xTemplateHaskell) xs+  _ -> input
+ 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,13 +1,18 @@-{-# LANGUAGE CPP, DeriveFunctor #-}+{-# LANGUAGE CPP #-} module Location where +import           Imports+ import           Control.DeepSeq (deepseq, NFData(rnf))++#if __GLASGOW_HASKELL__ < 900 import           SrcLoc hiding (Located) import qualified SrcLoc as GHC import           FastString (unpackFS)--#if __GLASGOW_HASKELL__ < 702-import           Outputable (showPpr)+#else+import           GHC.Types.SrcLoc hiding (Located)+import qualified GHC.Types.SrcLoc as GHC+import           GHC.Data.FastString (unpackFS) #endif  -- | A thing with a location attached.@@ -54,14 +59,12 @@  -- | 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-#else+#if __GLASGOW_HASKELL__ < 900 toLocation loc = case loc of   UnhelpfulSpan str -> UnhelpfulLocation (unpackFS str)   RealSrcSpan sp    -> Location (unpackFS . srcSpanFile $ sp) (srcSpanStartLine sp)+#else+toLocation loc = case loc of+  UnhelpfulSpan str -> UnhelpfulLocation (unpackFS $ unhelpfulSpanFS str)+  RealSrcSpan sp _  -> Location (unpackFS . srcSpanFile $ sp) (srcSpanStartLine sp) #endif
+ src/Options.hs view
@@ -0,0 +1,168 @@+{-# LANGUAGE CPP #-}+module Options (+  Result(..)+, Run(..)+, Config(..)+, defaultConfig+, parseOptions+#ifdef TEST+, defaultRun+, usage+, info+, versionInfo+, nonInteractiveGhcOptions+#endif+) where++import           Imports++import           Control.Monad.Trans.RWS (RWS, execRWS)+import qualified Control.Monad.Trans.RWS as RWS++import           Data.List (stripPrefix)++import           GHC.Paths (ghc)++import           Info++usage :: String+usage = unlines [+    "Usage:"+  , "  doctest [ --fast | --preserve-it | --fail-fast | --no-magic | --verbose | GHC OPTION | MODULE ]..."+  , "  doctest --help"+  , "  doctest --version"+  , "  doctest --info"+  , ""+  , "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"+  ]++data Result a = ProxyToGhc [String] | Output String | Result a+  deriving (Eq, Show, Functor)++type Warning = String++data Run = Run {+  runWarnings :: [Warning]+, runMagicMode :: Bool+, runConfig :: Config+} deriving (Eq, Show)++data Config = Config {+  ghcOptions :: [String]+, fastMode :: Bool+, preserveIt :: Bool+, failFast :: Bool+, verbose :: Bool+, repl :: (String, [String])+} deriving (Eq, Show)++defaultConfig :: Config+defaultConfig = Config {+  ghcOptions = []+, fastMode = False+, preserveIt = False+, failFast = False+, verbose = False+, repl = (ghc, ["--interactive"])+}++nonInteractiveGhcOptions :: [String]+nonInteractiveGhcOptions = [+    "--numeric-version"+  , "--supported-languages"+  , "--info"+  , "--print-global-package-db"+  , "--print-libdir"+  , "-c"+  , "-o"+  , "--make"+  , "--abi-hash"+  ]++defaultRun :: Run+defaultRun = Run {+  runWarnings = []+, runMagicMode = False+, runConfig = defaultConfig+}++modifyWarnings :: ([String] -> [String]) -> Run -> Run+modifyWarnings f run = run { runWarnings = f (runWarnings run) }++setOptions :: [String] -> Run -> Run+setOptions ghcOptions run@Run{..} = run { runConfig = runConfig { ghcOptions } }++setMagicMode :: Bool -> Run -> Run+setMagicMode magic run = run { runMagicMode = magic }++setFastMode :: Bool -> Run -> Run+setFastMode fastMode run@Run{..} = run { runConfig = runConfig { fastMode } }++setPreserveIt :: Bool -> Run -> Run+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{..} = run { runConfig = runConfig { verbose } }++parseOptions :: [String] -> Result Run+parseOptions args+  | 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++type RunOptionsParser = RWS () (Endo Run) [String] ()++runRunOptionsParser :: [String] -> Run -> RunOptionsParser -> Result Run+runRunOptionsParser args def parse = case execRWS parse () args of+  (xs, Endo setter) ->+    Result (setOptions xs $ setter def)++commonRunOptions :: RunOptionsParser+commonRunOptions = do+  parseFlag "--fast" (setFastMode True)+  parseFlag "--preserve-it" (setPreserveIt True)+  parseFlag "--fail-fast" (setFailFastMode True)+  parseFlag "--verbose" (setVerbose True)++parseFlag :: String -> (Run -> Run) -> RunOptionsParser+parseFlag flag setter = do+  args <- RWS.get+  when (flag `elem` args) $+    RWS.tell (Endo setter)+  RWS.put (discard flag args)++parseOptGhc :: RunOptionsParser+parseOptGhc = do+  issueWarning <- RWS.state go+  when issueWarning $+    RWS.tell $ Endo $ modifyWarnings (++ [warning])+  where+    go args = case args of+      [] -> (False, [])+      "--optghc" : opt : rest -> (True, opt : snd (go rest))+      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
@@ -0,0 +1,64 @@+{-# LANGUAGE CPP #-}+-- | Manage GHC package databases+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+    , includeGlobal :: Bool+    , extraDBs :: [FilePath]+    }+    deriving (Show, Eq)++-- | Determine command line arguments to be passed to GHC to set databases correctly+--+-- >>> dbArgs (PackageDBs False True [])+-- ["-no-user-package-db"]+--+-- >>> 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++-- | Determine the PackageDBs based on the environment.+getPackageDBsFromEnv :: IO PackageDBs+getPackageDBsFromEnv = do+    env <- getEnvironment+    return $ case () of+        ()+            | Just packageDBs <- lookup "GHC_PACKAGE_PATH" env+                -> fromEnvMulti packageDBs+            | otherwise+                -> PackageDBs True True []+  where+    fromEnvMulti s = PackageDBs+        { includeUser = False+        , includeGlobal = global+        , extraDBs = splitSearchPath s'+        }+      where+        (s', global) =+            case reverse s of+                c:rest | c == searchPathSeparator -> (reverse rest, True)+                _ -> (s, False)++-- | Get the package DB flags for the current GHC version and from the+-- environment.+getPackageDBArgs :: IO [String]+getPackageDBArgs = do+      dbs <- getPackageDBsFromEnv+      return $ dbArgs dbs
src/Parse.hs view
@@ -1,27 +1,27 @@-{-# LANGUAGE PatternGuards #-}+{-# 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-import           Data.Maybe+import           Data.List (isPrefixOf, stripPrefix) import           Data.String-import           Control.Applicative- import           Extract import           Location @@ -46,13 +46,18 @@  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 = do-  filter (not . isEmpty) . map parseModule <$> 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   where     isEmpty (Module _ setup tests) = null tests && isNothing setup @@ -169,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
@@ -8,7 +8,10 @@ #endif ) where +import           Imports+ import           Data.List+import           Data.Foldable  import           Util import           Interpreter (Interpreter)@@ -24,10 +27,9 @@  runProperty :: Interpreter -> Expression -> IO PropertyResult runProperty repl expression = do-  _ <- Interpreter.eval repl "import Test.QuickCheck ((==>))"-  _ <- Interpreter.eval repl "import Test.QuickCheck.All (polyQuickCheck)"-  _ <- Interpreter.eval repl "import Language.Haskell.TH (mkName)"-  _ <- Interpreter.eval repl ":set -XTemplateHaskell"+  _ <- Interpreter.safeEval repl "import Test.QuickCheck ((==>))"+  _ <- Interpreter.safeEval repl "import Test.QuickCheck.All (polyQuickCheck)"+  _ <- Interpreter.safeEval repl "import Language.Haskell.TH (mkName)"   r <- freeVariables repl expression >>=        (Interpreter.safeEval repl . quickCheck expression)   case r of@@ -53,19 +55,17 @@  -- | Parse and return all variables that are not in scope from a ghc error -- message.------ >>> parseNotInScope "<interactive>:4:1: Not in scope: `foo'"--- ["foo"] parseNotInScope :: String -> [String]-parseNotInScope = nub . map extractVariable . filter ("Not in scope: " `isInfixOf`) . lines+parseNotInScope = nub . mapMaybe extractVariable . lines   where     -- | Extract variable name from a "Not in scope"-error.-    extractVariable :: String -> String-    extractVariable = unquote . takeWhileEnd (/= ' ')+    extractVariable :: String -> Maybe String+    extractVariable x+      | "Not in scope: " `isInfixOf` x = Just . unquote . takeWhileEnd (/= ' ') $ x+      | Just y <- (asum $ map (stripPrefix "Variable not in scope: ") (tails x)) = Just (takeWhile (/= ' ') y)+      | otherwise = Nothing      -- | 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,98 +1,171 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-} module Run (   doctest+, doctestWithRepl++, Config(..)+, defaultConfig+, doctestWith++, Result+, Summary(..)+, formatSummary+, isSuccess+, evaluateResult+, doctestWithResult++, runDocTests #ifdef TEST-, doctest_-, Summary-, stripOptGhc+, expandDirs #endif ) where -import           Data.List-import           Control.Monad (when, unless)+import           Imports++import           System.Directory (doesFileExist, doesDirectoryExist, getDirectoryContents)+import           System.Environment (getEnvironment) import           System.Exit (exitFailure, exitSuccess)+import           System.FilePath ((</>), takeExtension) import           System.IO-import           System.Environment (getEnvironment)+import           System.IO.CodePage (withCP65001) -import           Control.Applicative import qualified Control.Exception as E++#if __GLASGOW_HASKELL__ < 900 import           Panic+#else+import           GHC.Utils.Panic+#endif +#if __GLASGOW_HASKELL__ < 904+import           GhcUtil (expandUnits)+#endif++import           PackageDBs import           Parse-import           Help+import           Options hiding (Result(..))+import qualified Options import           Runner+import           Location import qualified Interpreter -ghcPackageDbFlag :: String-#if __GLASGOW_HASKELL__ >= 706-ghcPackageDbFlag = "-package-db"-#else-ghcPackageDbFlag = "-package-conf"-#endif- -- | Run doctest with given list of arguments. -- -- 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 -- project.+--+-- 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 args-  | "--help"    `elem` args = putStr usage-  | "--version" `elem` args = printVersion-  | otherwise = do-      -- Look up the HASKELL_PACKAGE_SANDBOX environment variable and, if-      -- present, add it to the list of package databases GHC searches.-      -- Intended to make testing from inside sandboxes such as cabal-dev-      -- simpler.-      packageConf <- lookup "HASKELL_PACKAGE_SANDBOX" <$> getEnvironment-      let addPackageConf = case packageConf of-            Nothing -> id-            Just p  -> \rest -> ghcPackageDbFlag : p : rest-      -      i <- Interpreter.interpreterSupported-      unless i $ do-        hPutStrLn stderr "WARNING: GHC does not support --interactive, skipping tests"-        exitSuccess+doctest = doctestWithRepl (repl defaultConfig) -      let (f, args_) = stripOptGhc args-      when f $ do-        hPutStrLn stderr "WARNING: --optghc is deprecated, doctest now accepts arbitrary GHC options\ndirectly."-        hFlush stderr-      r <- doctest_ (addPackageConf 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+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 -isSuccess :: Summary -> Bool-isSuccess s = sErrors s == 0 && sFailures s == 0+    i <- Interpreter.interpreterSupported+    unless i $ do+      hPutStrLn stderr "WARNING: GHC does not support --interactive, skipping tests"+      exitSuccess --- |--- Strip --optghc from GHC options.  This is for backward compatibility with--- previous versions of doctest.------ A boolean is returned with the stripped arguments.  It is True if striping--- occurred.-stripOptGhc :: [String] -> (Bool, [String])-stripOptGhc = go+    opts <- case magicMode of+      False -> return (ghcOptions config)+      True -> do+        expandedArgs <- concat <$> mapM expandDirs (ghcOptions config)+        packageDBArgs <- getPackageDBArgs+        addDistArgs <- getAddDistArgs+        return (addDistArgs $ packageDBArgs ++ expandedArgs)+    doctestWith config{repl, ghcOptions = opts}++-- | Expand a reference to a directory to all .hs and .lhs files within it.+expandDirs :: String -> IO [String]+expandDirs fp0 = do+    isDir <- doesDirectoryExist fp0+    if isDir+        then findHaskellFiles fp0+        else return [fp0]   where-    go args = case args of-      []                      -> (False, [])-      "--optghc" : opt : rest -> (True, opt : snd (go rest))-      opt : rest              -> maybe (fmap (opt :)) (\x (_, xs) -> (True, x :xs)) (stripPrefix "--optghc=" opt) (go rest)+    findHaskellFiles dir = do+        contents <- getDirectoryContents dir+        concat <$> mapM go (filter (not . hidden) contents)+      where+        go name = do+            isDir <- doesDirectoryExist fp+            if isDir+                then findHaskellFiles fp+                else if isHaskellFile fp+                        then return [fp]+                        else return []+          where+            fp = dir </> name -doctest_ :: [String] -> IO Summary-doctest_ args = do+    hidden ('.':_) = True+    hidden _ = False -  -- get examples from Haddock comments-  modules <- getDocTests args+    isHaskellFile fp = takeExtension fp `elem` [".hs", ".lhs"] -  Interpreter.withInterpreter args $ \repl -> do-    runModules repl modules+-- | Get the necessary arguments to add the @cabal_macros.h@ file and autogen+-- directory, if present.+getAddDistArgs :: IO ([String] -> [String])+getAddDistArgs = do+    env <- getEnvironment+    let dist = fromMaybe "dist" $ lookup "HASKELL_DIST_DIR" env+        autogen = dist ++ "/build/autogen/"+        cabalMacros = autogen ++ "cabal_macros.h"++    dirExists <- doesDirectoryExist autogen+    if dirExists+        then do+            fileExists <- doesFileExist cabalMacros+            return $ \rest ->+                  concat ["-i", dist, "/build/autogen/"]+                : "-optP-include"+                : (if fileExists+                    then (concat ["-optP", dist, "/build/autogen/cabal_macros.h"]:)+                    else id) rest+        else return id++doctestWith :: Config -> IO ()+doctestWith = doctestWithResult >=> evaluateResult++type Result = Summary++evaluateResult :: Result -> IO ()+evaluateResult r = unless (isSuccess r) exitFailure++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-#endif+import           Prelude ()+import           Imports hiding (putStr, putStrLn, error) -import           Control.Applicative-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,173 +42,236 @@  -- | 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-  (Summary x1 x2 x3 x4) `mappend` (Summary y1 y2 y3 y4) = Summary (x1 + y1) (x2 + y2) (x3 + y3) (x4 + y4)+instance Semigroup Summary where+  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 :: Interpreter -> [Module [Located DocTest]] -> IO Summary-runModules repl modules = do-  isInteractive <- hIsTerminalDevice stderr-  ReportState _ _ s <- (`execStateT` ReportState 0 isInteractive mempty {sExamples = c}) $ do-    forM_ modules $ runModule repl+runModules :: FastMode -> PreserveIt -> FailFast -> Verbose -> Interpreter -> [Module [Located DocTest]] -> IO Summary+runModules fastMode preserveIt failFast verbose repl modules = withLineBuffering stderr $ do -    -- report 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?-, 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 :: Interpreter -> Module [Located DocTest] -> Report ()-runModule repl (Module module_ setup examples) = do+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 repl reload+    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 repl setup_+    forM_ examples $ runTestGroup preserveIt repl setup_   where     reload :: IO ()     reload = do-      -- NOTE: It is important to do the :reload first!  There was some odd bug-      -- with a previous version of GHC (7.4.1?).-      void $ Interpreter.eval repl   ":reload"-      void $ Interpreter.eval repl $ ":m *" ++ module_+      case fastMode of+        NoFastMode -> void $ Interpreter.safeEval repl ":reload"+        FastMode -> pass+      void $ Interpreter.safeEval repl $ ":m *" ++ module_ +      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       reload       forM_ setup $ \l -> forM_ l $ \(Located _ x) -> case x of         Property _  -> return ()-        Example e _ -> void $ Interpreter.eval repl e+        Example e _ -> void $ safeEvalWith preserveIt repl e -reportFailure :: Location -> Expression -> Report ()-reportFailure loc expression = do-  report (printf "### Failure in %s: expression `%s'" (show loc) expression)+reportStart :: Location -> Expression -> String -> Report ()+reportStart loc expression testType = do+  verboseReport (printf "### Started execution at %s.\n### %s:\n%s" (show loc) testType expression)++reportFailure :: Location -> Expression -> [String] -> Report ()+reportFailure loc expression err = do+  report (printf "%s: failure in expression `%s'" (show loc) expression)+  mapM_ report err+  report ""   updateSummary (Summary 0 1 0 1)  reportError :: Location -> Expression -> String -> Report () reportError loc expression err = do-  report (printf "### Error in %s: expression `%s'" (show loc) expression)+  report (printf "%s: error in expression `%s'" (show loc) expression)   report err+  report ""   updateSummary (Summary 0 1 1 0)  reportSuccess :: Report ()-reportSuccess =+reportSuccess = do+  verboseReport "### Successful!\n"   updateSummary (Summary 0 1 0 0) +verboseReport :: String -> Report ()+verboseReport msg = gets reportStateVerbose >>= \ case+  NonVerbose -> pass+  Verbose -> report msg+ updateSummary :: Summary -> Report () updateSummary summary = do-  ReportState n f s <- get-  put (ReportState n f $ 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 = 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 :: Interpreter -> IO () -> [Located DocTest] -> Report ()-runTestGroup repl setup tests = do--  -- report intermediate summary-  gets (show . reportStateSummary) >>= report_-+runTestGroup :: PreserveIt -> Interpreter -> IO () -> [Located DocTest] -> Report ()+runTestGroup preserveIt repl setup tests = do   liftIO setup-  runExampleGroup repl examples+  runExampleGroup preserveIt repl examples    forM_ properties $ \(loc, expression) -> do-    r <- liftIO $ do-      setup-      runProperty repl expression+    r <- do+      liftIO setup+      reportStart loc expression "property"+      liftIO $ runProperty repl expression     case r of       Success ->         reportSuccess       Error err -> do         reportError loc expression err       Failure msg -> do-        reportFailure loc expression-        report msg+        reportFailure loc expression [msg]   where     properties = [(loc, p) | Located loc (Property p) <- tests]      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 :: Interpreter -> [Located Interaction] -> Report ()-runExampleGroup repl = go+runExampleGroup :: PreserveIt -> Interpreter -> [Located Interaction] -> Report ()+runExampleGroup preserveIt repl = go   where     go ((Located loc (expression, expected)) : xs) = do-      r <- fmap lines <$> liftIO (Interpreter.safeEval repl expression)+      reportStart loc expression "example"+      r <- fmap lines <$> liftIO (safeEvalWith preserveIt repl expression)       case r of         Left err -> do           reportError loc expression err         Right actual -> case mkResult expected actual of           NotEqual err -> do-            reportFailure loc expression-            mapM_ report err+            reportFailure loc expression err           Equal -> do             reportSuccess             go xs
src/Runner/Example.hs view
@@ -3,63 +3,151 @@ , mkResult ) where +import           Imports+ import           Data.Char-import           Data.List+import           Data.List (isPrefixOf) import           Util  import           Parse +maxBy :: (Ord a) => (b -> a) -> b -> b -> b+maxBy f x y = case compare (f x) (f y) of+  LT -> y+  EQ -> x+  GT -> x+ data Result = Equal | NotEqual [String]   deriving (Eq, Show)  mkResult :: ExpectedResult -> [String] -> Result-mkResult expected actual-  | expected `matches` actual = Equal-  | otherwise = NotEqual (formatNotEqual expected actual)+mkResult expected_ actual_ =+  case expected `matches` actual of+  Full            -> Equal+  Partial partial -> NotEqual (formatNotEqual expected actual partial)   where-    chunksMatch :: [LineChunk] -> String -> Bool-    chunksMatch [] "" = True-    chunksMatch [LineChunk xs] ys = stripEnd xs == stripEnd ys+    -- use show to escape special characters in output lines if any output line+    -- contains any unsafe character+    escapeOutput+      | any (not . isSafe) $ concat (expectedAsString ++ actual_) = init . tail . show . stripEnd+      | otherwise = id++    actual :: [String]+    actual = fmap escapeOutput actual_++    expected :: ExpectedResult+    expected = fmap (transformExcpectedLine escapeOutput) expected_++    expectedAsString :: [String]+    expectedAsString = map (\x -> case x of+        ExpectedLine str -> concatMap lineChunkToString str+        WildCardLine -> "..." ) expected_++    isSafe :: Char -> Bool+    isSafe c = c == ' ' || (isPrint c && (not . isSpace) c)++    chunksMatch :: [LineChunk] -> String -> Match ChunksDivergence+    chunksMatch [] "" = Full+    chunksMatch [LineChunk xs] ys =+      if stripEnd xs == stripEnd ys+      then Full+      else Partial $ matchingPrefix xs ys     chunksMatch (LineChunk x : xs) ys =-        x `isPrefixOf` ys && xs `chunksMatch` drop (length x) ys+      if x `isPrefixOf` ys+      then fmap (prependText x) $ (xs `chunksMatch` drop (length x) ys)+      else Partial $ matchingPrefix x ys     chunksMatch zs@(WildCardChunk : xs) (_:ys) =-        xs `chunksMatch` ys || zs `chunksMatch` ys-    chunksMatch _ _ = False+      -- Prefer longer matches.+      fmap prependWildcard $ maxBy+        (fmap $ length . matchText)+        (chunksMatch xs ys)+        (chunksMatch zs ys)+    chunksMatch [WildCardChunk] [] = Full+    chunksMatch (WildCardChunk:_) [] = Partial (ChunksDivergence "" "")+    chunksMatch [] (_:_) = Partial (ChunksDivergence "" "") -    matches :: ExpectedResult -> [String] -> Bool-    matches [] [] = True-    matches [] _  = False-    matches _  [] = False-    matches (ExpectedLine x : xs) (y:ys) =-        x `chunksMatch` y && xs `matches` ys-    matches zs@(WildCardLine : xs) (_:ys) =-        xs `matches` ys || zs `matches` ys+    matchingPrefix xs ys =+      let common = fmap fst (takeWhile (\(x, y) -> x == y) (xs `zip` ys)) in+      ChunksDivergence common common +    matches :: ExpectedResult -> [String] -> Match LinesDivergence+    matches (ExpectedLine x : xs) (y : ys) =+      case x `chunksMatch` y of+      Full -> fmap incLineNo $ xs `matches` ys+      Partial partial -> Partial (LinesDivergence 1 (expandedWildcards partial))+    matches zs@(WildCardLine : xs) us@(_ : ys) =+      -- Prefer longer matches, and later ones of equal length.+      let matchWithoutWC = xs `matches` us in+      let matchWithWC    = fmap incLineNo (zs `matches` ys) in+      let key (LinesDivergence lineNo line) = (length line, lineNo) in+      maxBy (fmap key) matchWithoutWC matchWithWC+    matches [WildCardLine] [] = Full+    matches [] [] = Full+    matches [] _  = Partial (LinesDivergence 1 "")+    matches _  [] = Partial (LinesDivergence 1 "") -formatNotEqual :: ExpectedResult -> [String] -> [String]-formatNotEqual expected_ actual = formatLines "expected: " expected ++ formatLines " but got: " actual+-- Note: order of constructors matters, so that full matches sort as+-- greater than partial.+data Match a = Partial a | Full+  deriving (Eq, Ord, Show)++instance Functor Match where+  fmap f (Partial a) = Partial (f a)+  fmap _ Full = Full++data ChunksDivergence = ChunksDivergence { matchText :: String, expandedWildcards :: String }+  deriving (Show)++prependText :: String -> ChunksDivergence -> ChunksDivergence+prependText s (ChunksDivergence mt wct) = ChunksDivergence (s++mt) (s++wct)++prependWildcard :: ChunksDivergence -> ChunksDivergence+prependWildcard (ChunksDivergence mt wct) = ChunksDivergence mt ('.':wct)++data LinesDivergence = LinesDivergence { _mismatchLineNo :: Int, _partialLine :: String }+  deriving (Show)++incLineNo :: LinesDivergence -> LinesDivergence+incLineNo (LinesDivergence lineNo partialLineMatch) = LinesDivergence (lineNo + 1) partialLineMatch++formatNotEqual :: ExpectedResult -> [String] -> LinesDivergence -> [String]+formatNotEqual expected_ actual partial = formatLines "expected: " expected ++ formatLines " but got: " (lineMarker wildcard partial actual)   where     expected :: [String]     expected = map (\x -> case x of         ExpectedLine str -> concatMap lineChunkToString str         WildCardLine -> "..." ) expected_ -    -- use show to escape special characters in output lines if any output line-    -- contains any unsafe character-    escapeOutput-      | any (not . isSafe) (concat $ expected ++ actual) = map show-      | otherwise = id--    isSafe :: Char -> Bool-    isSafe c = c == ' ' || (isPrint c && (not . isSpace) c)-     formatLines :: String -> [String] -> [String]-    formatLines message xs = case escapeOutput xs of+    formatLines message xs = case xs of       y:ys -> (message ++ y) : map (padding ++) ys       []   -> [message]       where         padding = replicate (length message) ' ' +    wildcard :: Bool+    wildcard = any (\x -> case x of+        ExpectedLine xs -> any (\y -> case y of { WildCardChunk -> True; _ -> False }) xs+        WildCardLine -> True ) expected_+ lineChunkToString :: LineChunk -> String lineChunkToString WildCardChunk = "..." lineChunkToString (LineChunk str) = str++transformExcpectedLine :: (String -> String) -> ExpectedLine -> ExpectedLine+transformExcpectedLine f (ExpectedLine xs) =+  ExpectedLine $ fmap (\el -> case el of+    LineChunk s -> LineChunk $ f s+    WildCardChunk -> WildCardChunk+  ) xs+transformExcpectedLine _ WildCardLine = WildCardLine++lineMarker :: Bool -> LinesDivergence -> [String] -> [String]+lineMarker wildcard (LinesDivergence row expanded) actual =+  let (pre, post) = splitAt row actual in+  pre +++  [(if wildcard && length expanded > 30+    -- show expanded pattern if match is long, to help understanding what matched what+    then expanded+    else replicate (length expanded) ' ') ++ "^"] +++  post
− src/Sandbox.hs 
@@ -1,81 +0,0 @@-{-# LANGUAGE BangPatterns #-}--module Sandbox (getSandboxArguments, getPackageDbDir) where--import Control.Applicative ((<$>))-import Control.Exception as E (catch, SomeException, throwIO)-import Data.Char (isSpace)-import Data.List (isPrefixOf, tails)-import System.Directory (getCurrentDirectory, doesFileExist)-import System.FilePath ((</>), takeDirectory, takeFileName)--configFile :: String-configFile = "cabal.sandbox.config"--pkgDbKey :: String-pkgDbKey = "package-db:"--pkgDbKeyLen :: Int-pkgDbKeyLen = length pkgDbKey--getSandboxArguments :: IO [String]-getSandboxArguments = (sandboxArguments <$> getPkgDb) `E.catch` handler-  where-    getPkgDb = getCurrentDirectory >>= getSandboxConfigFile >>= getPackageDbDir-    handler :: SomeException -> IO [String]-    handler _ = return []---- | Find a sandbox config file by tracing ancestor directories.---   Exception is thrown if not found-getSandboxConfigFile :: FilePath -> IO FilePath-getSandboxConfigFile dir = do-    let cfile = dir </> configFile-    exist <- doesFileExist cfile-    if exist then-        return cfile-      else do-        let dir' = takeDirectory dir-        if dir == dir' then-            throwIO $ userError "sandbox config file not found"-          else-            getSandboxConfigFile dir'---- | Extract a package db directory from the sandbox config file.---   Exception is thrown if the sandbox config file is broken.-getPackageDbDir :: FilePath -> IO FilePath-getPackageDbDir sconf = do-    -- Be strict to ensure that an error can be caught.-    !path <- extractValue . parse <$> readFile sconf-    return path-  where-    parse = head . filter ("package-db:" `isPrefixOf`) . lines-    extractValue = fst . break isSpace . dropWhile isSpace . drop pkgDbKeyLen---- | Adding necessary GHC options to the package db.---   Exception is thrown if the string argument is incorrect.------ >>> sandboxArguments "/foo/bar/i386-osx-ghc-7.6.3-packages.conf.d"--- ["-no-user-package-db","-package-db","/foo/bar/i386-osx-ghc-7.6.3-packages.conf.d"]--- >>> sandboxArguments "/foo/bar/i386-osx-ghc-7.4.1-packages.conf.d"--- ["-no-user-package-conf","-package-conf","/foo/bar/i386-osx-ghc-7.4.1-packages.conf.d"]-sandboxArguments :: FilePath -> [String]-sandboxArguments pkgDb = [noUserPkgDbOpt, pkgDbOpt, pkgDb]-  where-    ver = extractGhcVer pkgDb-    (pkgDbOpt,noUserPkgDbOpt)-      | ver < 706 = ("-package-conf","-no-user-package-conf")-      | otherwise = ("-package-db",  "-no-user-package-db")---- | Extracting GHC version from the path of package db.---   Exception is thrown if the string argument is incorrect.------ >>> extractGhcVer "/foo/bar/i386-osx-ghc-7.6.3-packages.conf.d"--- 706-extractGhcVer :: String -> Int-extractGhcVer dir = ver-  where-    file = takeFileName dir-    findVer = drop 4 . head . filter ("ghc-" `isPrefixOf`) . tails-    (verStr1,_:left) = break (== '.') $ findVer file-    (verStr2,_)      = break (== '.') left-    ver = read verStr1 * 100 + read verStr2
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
@@ -0,0 +1,95 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}++module ExtractSpec (main, spec) where++import           Imports++import           Test.Hspec+import           Test.HUnit+++#if __GLASGOW_HASKELL__ < 900+import           Panic (GhcException (..))+#else+import           GHC.Utils.Panic (GhcException (..))+#endif++import           Extract+import           Location+import           System.FilePath++shouldGive :: HasCallStack => (String, String) -> [Module String] -> Assertion+(d, m) `shouldGive` expected = do+  r <- map (fmap unLoc) `fmap` extract ["-i" ++ dir, dir </> m]+  r `shouldBe` expected+  where dir = "test/extract" </> d++main :: IO ()+main = hspec spec++spec :: Spec+spec = do++  describe "extract" $ do+    it "extracts documentation for a top-level declaration" $ do+      ("declaration", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" Some documentation"]]++    it "extracts documentation from argument list" $ do+      ("argument-list", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" doc for arg1", " doc for arg2"]]++    it "extracts documentation for a type class function" $ do+      ("type-class", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" Convert given value to a string."]]++    it "extracts documentation from the argument list of a type class function" $ do+      ("type-class-args", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" foo", " bar"]]++    it "extracts documentation from the module header" $ do+      ("module-header", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" Some documentation"]]++    it "extracts documentation from imported modules" $ do+      ("imported-module", "Bar.hs") `shouldGive` [Module "Bar" Nothing [" documentation for bar"], Module "Baz" Nothing [" documentation for baz"]]++    it "extracts documentation from export list" $ do+      ("export-list", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" documentation from export list"]]++    it "extracts documentation from named chunks" $ do+      ("named-chunks", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" named chunk foo", "\n named chunk bar"]]++    it "returns docstrings in the same order they appear in the source" $ do+      ("comment-order", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" module header", " export list 1", " export list 2", " foo", " named chunk", " bar"]]++    it "extracts $setup code" $ do+      ("setup", "Foo.hs") `shouldGive` [Module "Foo" (Just "\n some setup code") [" foo", " bar", " baz"]]++    it "fails on invalid flags" $ do+      extract ["--foobar", "test/Foo.hs"] `shouldThrow` (\e -> case e of UsageError "unrecognized option `--foobar'" -> True; _ -> False)++  describe "extract (regression tests)" $ do+    it "works with infix operators" $ do+      ("regression", "Fixity.hs") `shouldGive` [Module "Fixity" Nothing []]++    it "works with parallel list comprehensions" $ do+      ("regression", "ParallelListComp.hs") `shouldGive` [Module "ParallelListComp" Nothing []]++    it "works with list comprehensions in instance definitions" $ do+      ("regression", "ParallelListCompClass.hs") `shouldGive` [Module "ParallelListCompClass" Nothing []]++    it "works with foreign imports" $ do+      ("regression", "ForeignImport.hs") `shouldGive` [Module "ForeignImport" Nothing []]++    it "works for rewrite rules" $ do+      ("regression", "RewriteRules.hs") `shouldGive` [Module "RewriteRules" Nothing [" doc for foo"]]++    it "works for rewrite rules with type signatures" $ do+      ("regression", "RewriteRulesWithSigs.hs") `shouldGive` [Module "RewriteRulesWithSigs" Nothing [" doc for foo"]]++    it "strips CR from dos line endings" $ do+      ("dos-line-endings", "Foo.hs") `shouldGive` [Module "Foo" Nothing ["\n foo\n bar\n baz"]]++    it "works with a module that splices in an expression from an other module" $ do+      ("th", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" some documentation"], Module "Bar" Nothing []]++    it "works for type families and GHC 7.6.1" $ do+      ("type-families", "Foo.hs") `shouldGive` [Module "Foo" Nothing []]
+ 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
@@ -0,0 +1,40 @@+module InterpreterSpec (spec) where++import           Imports++import           Test.Hspec++import           Interpreter (Interpreter, interpreterSupported, haveInterpreterKey, ghcInfo, ghc, safeEval, filterExpression)+import qualified Interpreter++withInterpreter :: (Interpreter -> IO a) -> IO a+withInterpreter = Interpreter.withInterpreter (Interpreter.ghc, ["--interactive"])++spec :: Spec+spec = do+  describe "interpreterSupported" $ do+    it "indicates whether GHCi is supported on current platform" $ do+      (Interpreter.interpreterSupported >> return ()) `shouldReturn` ()++  describe "ghcInfo" $ do+    it ("includes " ++ show haveInterpreterKey) $ do+      info <- ghcInfo+      lookup haveInterpreterKey info `shouldSatisfy`+        (||) <$> (== Just "YES") <*> (== Just "NO")++  describe "safeEval" $ 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+      Interpreter.safeEval ghci ":{\n23 + 42" `shouldReturn` Left "unterminated multi-line command"++  describe "filterExpression" $ do+    it "removes :set -XTemplateHaskell" $ do+      filterExpression ":set -XTemplateHaskell" `shouldBe` Right ""++    it "filters -XTemplateHaskell" $ do+      filterExpression ":set -XTemplateHaskell -XCPP" `shouldBe` Right ":set -XCPP"++    it "leaves :set-statement that do not set -XTemplateHaskell alone " $ do+      filterExpression ":set -XFoo   -XBar" `shouldBe` Right ":set -XFoo   -XBar"
+ 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
@@ -0,0 +1,53 @@+{-# LANGUAGE CPP #-}++module LocationSpec (main, spec) where++import           Imports++import           Test.Hspec++import           Location++#if __GLASGOW_HASKELL__ < 900+import           SrcLoc+import           FastString (fsLit)+#else+import           GHC.Types.SrcLoc+import           GHC.Data.FastString (fsLit)+#endif++main :: IO ()+main = hspec spec++spec :: Spec+spec = do++  describe "toLocation" $ do++    it "works for a regular SrcSpan" $ do+      toLocation (mkSrcSpan (mkSrcLoc (fsLit "Foo.hs") 2 5) (mkSrcLoc (fsLit "Foo.hs") 10 20))+        `shouldBe` Location "Foo.hs" 2++    it "works for a single-line SrcSpan" $ do+      toLocation (mkSrcSpan (mkSrcLoc (fsLit "Foo.hs") 2 5) (mkSrcLoc (fsLit "Foo.hs") 2 10))+        `shouldBe` Location "Foo.hs" 2++    it "works for a SrcSpan that corresponds to single point" $ do+      (toLocation . srcLocSpan) (mkSrcLoc (fsLit "Foo.hs") 10 20)+        `shouldBe` Location "Foo.hs" 10++    it "works for a bad SrcSpan" $ do+      toLocation noSrcSpan `shouldBe` UnhelpfulLocation "<no location info>"++    it "works for a SrcLoc with bad locations" $ do+      toLocation (mkSrcSpan noSrcLoc noSrcLoc)+        `shouldBe` UnhelpfulLocation "<no location info>"++  describe "enumerate" $ do+    it "replicates UnhelpfulLocation" $ do+      let loc = UnhelpfulLocation "foo"+      (take 10 $ enumerate loc) `shouldBe` replicate 10 loc++    it "enumerates Location" $ do+      let loc = Location "Foo.hs" 23+      (take 3 $ enumerate loc) `shouldBe` [Location "Foo.hs" 23, Location "Foo.hs" 24, Location "Foo.hs" 25]
+ test/MainSpec.hs view
@@ -0,0 +1,204 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-}+module MainSpec (main, spec) where++import           Imports++import           Test.Hspec+import           Test.HUnit (assertEqual, Assertion)++import           System.Directory (getCurrentDirectory, setCurrentDirectory)+import           System.FilePath+import           Run hiding (doctest, doctestWith)+import           System.IO.Silently+import           System.IO++withCurrentDirectory :: FilePath -> IO a -> IO a+withCurrentDirectory workingDir action = do+  bracket getCurrentDirectory setCurrentDirectory $ \_ -> do+    setCurrentDirectory workingDir+    action++doctest :: HasCallStack => FilePath -> [String] -> Summary -> Assertion+doctest = doctestWith False False++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 ghcOptions++cases :: Int -> Summary+cases n = Summary n n 0 0++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "doctest" $ do+    it "testSimple" $ do+      doctest "." ["testSimple/Fib.hs"]+        (cases 1)++    it "it-variable" $ do+      doctestWithPreserveIt "." ["it/Foo.hs"]+        (cases 5)++    it "it-variable in $setup" $ do+      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" $ 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"]+        (cases 3)+      doctest ".." ["-iintegration/testImport", "integration/testImport/ModuleA.hs"]+        (cases 3)++    it "testCommentLocation" $ do+      doctest "." ["testCommentLocation/Foo.hs"]+        (cases 11)++    it "testPutStr" $ do+      doctest "testPutStr" ["Fib.hs"]+        (cases 3)++    it "fails on multi-line expressions, introduced with :{" $ do+      doctest "testFailOnMultiline" ["Fib.hs"]+        (cases 2) {sErrors = 2}++    it "testBlankline" $ do+      doctest "testBlankline" ["Fib.hs"]+        (cases 1)++    it "examples from the same Haddock comment share the same scope" $ do+      doctest "testCombinedExample" ["Fib.hs"]+        (cases 4)++    it "testDocumentationForArguments" $ do+      doctest "testDocumentationForArguments" ["Fib.hs"]+        (cases 1)++    it "template-haskell" $ do+      doctest "template-haskell" ["Foo.hs"]+        (cases 2)++    it "handles source files with CRLF line endings" $ do+      doctest "dos-line-endings" ["Fib.hs"]+        (cases 1)++    it "runs $setup before each test group" $ do+      doctest "setup" ["Foo.hs"]+        (cases 2)++    it "skips subsequent tests from a module, if $setup fails" $ do+      doctest "setup-skip-on-failure" ["Foo.hs"]+        (cases 3) {sTried = 1, sFailures = 1}++    -- Andreas, 2021-02-27, see issue #294.+    -- This test case contains a hard-wired path that does not work+    -- with v2-cabal.+    -- I tested it under v2-cabal with a very non-portable path.+    -- Deactivating the test case until a systematic solution is found...+    --+    -- it "works with additional object files" $ do+    --   -- -- Path for v1-cabal:+    --   -- doctest "with-cbits" ["Bar.hs", "../../../dist/build/spec/spec-tmp/test/integration/with-cbits/foo.o"]+    --   -- -- Path for v2-cabal with ghc-9.0.1+    --   -- doctest "with-cbits" ["Bar.hs", "../../../dist-newstyle/build/x86_64-osx/ghc-9.0.1/doctest-0.19/t/spec/build/spec/spec-tmp/Test/integration/with-cbits/foo.o"]+    --     (cases 1)++    it "ignores trailing whitespace when matching test output" $ do+      doctest "trailing-whitespace" ["Foo.hs"]+        (cases 1)++  describe "doctest as a runner for QuickCheck properties" $ do+    it "runs a boolean property" $ do+      doctest "property-bool" ["Foo.hs"]+        (cases 1)++    it "runs an explicitly quantified property" $ do+      doctest "property-quantified" ["Foo.hs"]+        (cases 1)++    it "runs an implicitly quantified property" $ do+      doctest "property-implicitly-quantified" ["Foo.hs"]+        (cases 1)++    it "reports a failing property" $ do+      doctest "property-failing" ["Foo.hs"]+        (cases 1) {sFailures = 1}++    it "runs a boolean property with an explicit type signature" $ do+      doctest "property-bool-with-type-signature" ["Foo.hs"]+        (cases 1)++    it "runs $setup before each property" $ do+      doctest "property-setup" ["Foo.hs"]+        (cases 3)++  describe "doctest (regression tests)" $ do+    it "bugfixWorkingDirectory" $ do+      doctest "bugfixWorkingDirectory" ["Fib.hs"]+        (cases 1)+      doctest "bugfixWorkingDirectory" ["examples/Fib.hs"]+        (cases 2)++    it "bugfixOutputToStdErr" $ do+      doctest "bugfixOutputToStdErr" ["Fib.hs"]+        (cases 2)++    it "bugfixImportHierarchical" $ do+      doctest "bugfixImportHierarchical" ["ModuleA.hs", "ModuleB.hs"]+        (cases 3)++    it "bugfixMultipleModules" $ do+      doctest "bugfixMultipleModules" ["ModuleA.hs"]+        (cases 5)++    it "testCPP" $ do+      doctest "testCPP" ["-cpp", "Foo.hs"]+        (cases 1) {sFailures = 1}+      doctest "testCPP" ["-cpp", "-DFOO", "Foo.hs"]+        (cases 1)++    it "template-haskell-bugfix" $ do+      doctest "template-haskell-bugfix" ["Main.hs"]+        (cases 2)++    it "doesn't clash with user bindings of stdout/stderr" $ do+      doctest "local-stderr-binding" ["A.hs"]+        (cases 1)++    it "doesn't get confused by doctests using System.IO imports" $ do+      doctest "system-io-imported" ["A.hs"]+        (cases 1)
+ test/OptionsSpec.hs view
@@ -0,0 +1,108 @@+module OptionsSpec (spec) where++import           Imports++import           Data.List++import           Test.Hspec+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+      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" $+      parseOptions ["--optghc", "foobar"] `shouldBe` Result (run ["foobar"])++    it "strips --optghc=" $+      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+          runMagicMode <$> parseOptions [] `shouldBe` Result True++      context "with --no-magic" $ do+        it "disables magic mode" $ do+          runMagicMode <$> parseOptions ["--no-magic"] `shouldBe` Result False++    describe "--fast" $ do+      context "without --fast" $ do+        it "disables fast mode" $ do+          fastMode . runConfig <$> parseOptions [] `shouldBe` Result False++      context "with --fast" $ do+        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+          preserveIt . runConfig <$> parseOptions [] `shouldBe` Result False++      context "with --preserve-it" $ do+        it "preserves the `it` variable" $ do+          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++    context "with --version" $ do+      it "outputs version information" $ do+        parseOptions ["--version"] `shouldBe` Output versionInfo++    context "with --info" $ do+      it "outputs machine readable version information" $ do+        parseOptions ["--info"] `shouldBe` Output info++    describe "--verbose" $ do+      context "without --verbose" $ do+        it "is not verbose by default" $ do+          verbose . runConfig <$> parseOptions [] `shouldBe` Result False++      context "with --verbose" $ do+        it "parses verbose option" $ do+          verbose . runConfig <$> parseOptions ["--verbose"] `shouldBe` Result True
+ test/PackageDBsSpec.hs view
@@ -0,0 +1,40 @@+module PackageDBsSpec (main, spec) where++import           Imports++import qualified Control.Exception         as E+import           Data.List                 (intercalate)+import           PackageDBs+import           System.Environment+import           System.FilePath           (searchPathSeparator)+import           Test.Hspec++import           Test.Mockery.Directory++main :: IO ()+main = hspec spec++withEnv :: String -> String -> IO a -> IO a+withEnv k v action = E.bracket save restore $ \_ -> do+  setEnv k v >> action+  where+    save    = lookup k <$> getEnvironment+    restore = maybe (unsetEnv k) (setEnv k)++clearEnv :: IO a -> IO a+clearEnv =+    withEnv "GHC_PACKAGE_PATH" ""++combineDirs :: [FilePath] -> String+combineDirs = intercalate [searchPathSeparator]++spec :: Spec+spec = around_ clearEnv $ do+  describe "getPackageDBsFromEnv" $ do+    around_ (inTempDirectory) $ do+      it "uses global and user when no env used" $ do+        getPackageDBsFromEnv `shouldReturn` PackageDBs True True []++      it "respects GHC_PACKAGE_PATH" $+        withEnv "GHC_PACKAGE_PATH" (combineDirs ["foo", "bar", ""]) $ do+          getPackageDBsFromEnv `shouldReturn` PackageDBs False True ["foo", "bar"]
+ test/ParseSpec.hs view
@@ -0,0 +1,205 @@+{-# LANGUAGE OverloadedStrings #-}+module ParseSpec (main, spec) where++import           Imports++import           Test.Hspec+import           Data.String+import           Data.String.Builder (Builder, build)+import           Control.Monad.Trans.Writer++import           Parse+import           Location++main :: IO ()+main = hspec spec++group :: Writer [DocTest] () -> Writer [[DocTest]] ()+group g = tell [execWriter g]++ghci :: Expression -> Builder -> Writer [DocTest] ()+ghci expressions expected = tell [Example expressions $ (map fromString . lines . build) expected]++prop_ :: Expression -> Writer [DocTest] ()+prop_ e = tell [Property e]++module_ :: String -> Writer [[DocTest]] () -> Writer [Module [DocTest]] ()+module_ name gs = tell [Module name Nothing $ execWriter gs]++shouldGive :: IO [Module [Located DocTest]] -> Writer [Module [DocTest]] () -> Expectation+shouldGive action expected = map (fmap $ map unLoc) `fmap` action `shouldReturn` execWriter expected++spec :: Spec+spec = do+  describe "extractDocTests" $ do+    it "extracts properties from a module" $ do+      extractDocTests ["test/parse/property/Fib.hs"] `shouldGive` do+        module_ "Fib" $ do+          group $ do+            prop_ "foo"+            prop_ "bar"+            prop_ "baz"++    it "extracts examples from a module" $ do+      extractDocTests ["test/parse/simple/Fib.hs"] `shouldGive` do+        module_ "Fib" $ do+          group $ do+            ghci "putStrLn \"foo\""+              "foo"+            ghci "putStr \"bar\""+              "bar"+            ghci "putStrLn \"baz\""+              "baz"++    it "extracts examples from documentation for non-exported names" $ do+      extractDocTests ["test/parse/non-exported/Fib.hs"] `shouldGive` do+        module_ "Fib" $ do+          group $ do+            ghci "putStrLn \"foo\""+              "foo"+            ghci "putStr \"bar\""+              "bar"+            ghci "putStrLn \"baz\""+              "baz"++    it "extracts multiple examples from a module" $ do+      extractDocTests ["test/parse/multiple-examples/Foo.hs"] `shouldGive` do+        module_ "Foo" $ do+          group $ do+            ghci "foo"+              "23"+          group $ do+            ghci "bar"+              "42"++    it "returns an empty list, if documentation contains no examples" $ do+      extractDocTests ["test/parse/no-examples/Fib.hs"] >>= (`shouldBe` [])++    it "sets setup code to Nothing, if it does not contain any tests" $ 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+      extractDocTests ["test/parse/setup-only/Foo.hs"] `shouldGive` do+        tell [Module "Foo" (Just [Example "foo" ["23"]]) []]++  describe "parseInteractions (an internal function)" $ do++    let parse_ = map unLoc . parseInteractions . noLocation . build++    it "parses an interaction" $ do+      parse_ $ do+        ">>> foo"+        "23"+      `shouldBe` [("foo", ["23"])]++    it "drops whitespace as appropriate" $ do+      parse_ $ do+        "    >>> foo   "+        "    23"+      `shouldBe` [("foo", ["23"])]++    it "parses an interaction without a result" $ do+      parse_ $ do+        ">>> foo"+      `shouldBe` [("foo", [])]++    it "works with a complex example" $ do+      parse_ $ do+        "test"+        "foobar"+        ""+        ">>> foo"+        "23"+        ""+        ">>> baz"+        ""+        ">>> bar"+        "23"+        ""+        "baz"+      `shouldBe` [("foo", ["23"]), ("baz", []), ("bar", ["23"])]++    it "attaches location information to parsed interactions" $ do+      let loc = Located . Location "Foo.hs"+      r <- return . parseInteractions . loc 23 . build  $ do+        "1"+        "2"+        ""+        ">>> 4"+        "5"+        ""+        ">>> 7"+        ""+        ">>> 9"+        "10"+        ""+        "11"+      r `shouldBe` [loc 26 $ ("4", ["5"]), loc 29 $ ("7", []), loc 31 $ ("9", ["10"])]++    it "basic multiline" $ do+      parse_ $ do+        ">>> :{ first"+        " next"+        "some"+        ":}"+        "output"+      `shouldBe` [(":{ first\n next\nsome\n:}", ["output"])]++    it "multiline align output" $ do+      parse_ $ do+        ">>> :{ first"+        "  :}"+        "  output"+      `shouldBe` [(":{ first\n:}", ["output"])]++    it "multiline align output with >>>" $ do+      parse_ $ do+        " >>> :{ first"+        " >>> :}"+        " output"+      `shouldBe` [(":{ first\n:}", ["output"])]++    it "parses wild cards lines" $ do+      parse_ $ do+        " >>> action"+        " foo"+        " ..."+        " bar"+      `shouldBe` [("action", ["foo", WildCardLine, "bar"])]++    it "parses wild card chunks" $ do+      parse_ $ do+        " >>> action"+        " foo ... bar"+      `shouldBe` [("action", [ExpectedLine ["foo ", WildCardChunk, " bar"]])]++  describe " parseProperties (an internal function)" $ do+    let parse_ = map unLoc . parseProperties . noLocation . build++    it "parses a property" $ do+      parse_ $ do+        "prop> foo"+      `shouldBe` ["foo"]++  describe "mkLineChunks (an internal function)" $ do++    it "replaces ellipsis with WildCardChunks" $ do+      mkLineChunks "foo ... bar ... baz" `shouldBe`+        ["foo ", WildCardChunk, " bar ", WildCardChunk, " baz"]++    it "doesn't replace fewer than 3 consecutive dots" $ do+      mkLineChunks "foo .. bar .. baz" `shouldBe`+        ["foo .. bar .. baz"]++    it "handles leading and trailing dots" $ do+      mkLineChunks ".. foo bar .." `shouldBe` [".. foo bar .."]++    it "handles leading and trailing ellipsis" $ do+      mkLineChunks "... foo bar ..." `shouldBe` [ WildCardChunk+                                                , " foo bar "+                                                , WildCardChunk+                                                ]
+ test/PropertySpec.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE OverloadedStrings #-}+module PropertySpec (spec) where++import           Imports++import           Test.Hspec+import           Data.String.Builder++import           Property+import           Interpreter (Interpreter)+import qualified Interpreter++withInterpreter :: (Interpreter -> IO a) -> IO a+withInterpreter = Interpreter.withInterpreter (Interpreter.ghc, ["--interactive"])++isFailure :: PropertyResult -> Bool+isFailure (Failure _) = True+isFailure _ = False++spec :: Spec+spec = do+  describe "runProperty" $ 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+      runProperty repl "True" `shouldReturn` Success++    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+      runProperty repl "(reverse . reverse) xs == (xs :: [Int])" `shouldReturn` Success++    it "runs an implicitly quantified property even with GHC 7.4" $+      -- ghc will include a suggestion (did you mean `id` instead of `is`) in+      -- the error message+      withInterpreter $ \repl -> do+        runProperty repl "foldr (+) 0 is == sum (is :: [Int])" `shouldReturn` Success++    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+      runProperty repl "\\x -> x + y == y + x" `shouldReturn` Success++    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+      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+      runProperty repl "reverse xs == xs" >>= (`shouldSatisfy` isFailure)++  describe "freeVariables" $ do+    it "finds a free variables in a term" $ withInterpreter $ \repl -> do+      freeVariables repl "x" `shouldReturn` ["x"]++    it "ignores duplicates" $ withInterpreter $ \repl -> do+      freeVariables repl "x == x" `shouldReturn` ["x"]++    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+      freeVariables repl "x' == y''" `shouldReturn` ["x'", "y''"]++    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+    context "when error message was produced by GHC 7.4.1" $ do+      it "extracts a variable name of variable that is not in scope from an error message" $ do+        parseNotInScope . build $ do+          "<interactive>:4:1: Not in scope: `x'"+        `shouldBe` ["x"]++      it "ignores duplicates" $ do+        parseNotInScope . build $ do+          "<interactive>:4:1: Not in scope: `x'"+          ""+          "<interactive>:4:6: Not in scope: `x'"+        `shouldBe` ["x"]++      it "works for variable names that contain a prime" $ do+        parseNotInScope . build $ do+          "<interactive>:2:1: Not in scope: x'"+          ""+          "<interactive>:2:7: Not in scope: y'"+        `shouldBe` ["x'", "y'"]++      it "works for error messages with suggestions" $ do+        parseNotInScope . build $ do+          "<interactive>:1:1:"+          "    Not in scope: `is'"+          "    Perhaps you meant `id' (imported from Prelude)"+        `shouldBe` ["is"]++    context "when error message was produced by GHC 8.0.1" $ do+      it "extracts a variable name of variable that is not in scope from an error message" $ do+        parseNotInScope . build $ do+          "<interactive>:1:1: error: Variable not in scope: x"+        `shouldBe` ["x"]++      it "ignores duplicates" $ do+        parseNotInScope . build $ do+          "<interactive>:1:1: error: Variable not in scope: x :: ()"+          ""+          "<interactive>:1:6: error: Variable not in scope: x :: ()"+        `shouldBe` ["x"]++      it "works for variable names that contain a prime" $ do+        parseNotInScope . build $ do+          "<interactive>:1:1: error: Variable not in scope: x' :: ()"+          ""+          "<interactive>:1:7: error: Variable not in scope: y'' :: ()"+        `shouldBe` ["x'", "y''"]++      it "works for error messages with suggestions" $ do+        parseNotInScope . build $ do+          "<interactive>:1:1: error:"+          "    • Variable not in scope: length_"+          "    • Perhaps you meant ‘length’ (imported from Prelude)"+        `shouldBe` ["length_"]
+ test/RunSpec.hs view
@@ -0,0 +1,187 @@+{-# LANGUAGE CPP #-}+module RunSpec (main, spec) where++import           Imports++import           Test.Hspec+import           System.Exit++import qualified Control.Exception as E+import           System.FilePath+import           System.Directory (getCurrentDirectory, setCurrentDirectory)+import           System.IO.Temp (withSystemTempDirectory)+import           Data.List (isPrefixOf, sort)++import           System.IO.Silently+import           System.IO (stderr)+import qualified Options++import           Run++withCurrentDirectory :: FilePath -> IO a -> IO a+withCurrentDirectory workingDir action = do+  E.bracket getCurrentDirectory setCurrentDirectory $ \_ -> do+    setCurrentDirectory workingDir+    action++main :: IO ()+main = hspec spec+++removeLoadedPackageEnvironment :: String -> String+#if __GLASGOW_HASKELL__ < 810+removeLoadedPackageEnvironment = unlines . filter (not . isPrefixOf "Loaded package environment from ") . lines+#else+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+    it "exits with ExitFailure if at least one test case fails" $ do+      hSilence [stderr] (doctest ["test/integration/failing/Foo.hs"]) `shouldThrow` (== ExitFailure 1)++    it "prints help on --help" $ do+      (r, ()) <- capture (doctest ["--help"])+      r `shouldBe` Options.usage++    it "prints version on --version" $ do+      (r, ()) <- capture (doctest ["--version"])+      lines r `shouldSatisfy` any (isPrefixOf "doctest version ")++    it "accepts arbitrary GHC options" $ do+      hSilence [stderr] $ doctest ["-cpp", "-DFOO", "test/integration/test-options/Foo.hs"]++    it "accepts GHC options with --optghc" $ do+      hSilence [stderr] $ doctest ["--optghc=-cpp", "--optghc=-DFOO", "test/integration/test-options/Foo.hs"]++    it "prints a deprecation message for --optghc" $ do+      (r, _) <- hCapture [stderr] $ doctest ["--optghc=-cpp", "--optghc=-DFOO", "test/integration/test-options/Foo.hs"]+      lines r `shouldSatisfy` isPrefixOf [+          "WARNING: --optghc is deprecated, doctest now accepts arbitrary GHC options"+        , "directly."+        ]++    it "prints error message on invalid option" $ do+      (r, e) <- hCapture [stderr] . E.try $ doctest ["--foo", "test/integration/test-options/Foo.hs"]+      e `shouldBe` Left (ExitFailure 1)+      removeLoadedPackageEnvironment r `shouldBe` unlines [+          "doctest: unrecognized option `--foo'"+        , "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` verboseFibOutput++    it "prints verbose description of a property" $ do+      (r, ()) <- hCapture [stderr] $ doctest ["--verbose", "test/integration/property-bool/Foo.hs"]+      removeLoadedPackageEnvironment r `shouldBe` unlines [+          "### Started execution at test/integration/property-bool/Foo.hs:4."+        , "### property:"+        , "True"+        , "### Successful!"+        , ""+        , "# Final summary:"+        , "Examples: 1  Tried: 1  Errors: 0  Failures: 0"+        ]++    it "prints verbose error" $ do+      (r, e) <- hCapture [stderr] . E.try $ doctest ["--verbose", "test/integration/failing/Foo.hs"]+      e `shouldBe` Left (ExitFailure 1)+      removeLoadedPackageEnvironment r `shouldBe` unlines [+              "### Started execution at test/integration/failing/Foo.hs:5."+            , "### example:"+            , "23"+            , "test/integration/failing/Foo.hs:5: failure in expression `23'"+            , "expected: 42"+            , " but got: 23"+            , "          ^"+            , ""+            , "# Final summary:"+            , "Examples: 1  Tried: 1  Errors: 0  Failures: 1"+        ]++#if __GLASGOW_HASKELL__ >= 802+    it "can deal with potentially problematic GHC options" $ do+      hSilence [stderr] $ doctest ["-fdiagnostics-color=always", "test/integration/color/Foo.hs"]+#endif++  describe "doctestWithResult" $ do+    context "on parse error" $ do+      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))+        removeLoadedPackageEnvironment r `shouldBe` unlines (+#if __GLASGOW_HASKELL__ < 910+          "" :+#endif+#if __GLASGOW_HASKELL__ >= 906+          [ "Foo.hs:6:1: error: [GHC-58481]"+#else+          [ "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"+        ]+    it "ignores files" $ do+      res <- expandDirs "doctest.cabal"+      res `shouldBe` ["doctest.cabal"]+    it "ignores random things" $ do+      let x = "foo bar baz bin"+      res <- expandDirs x+      res `shouldBe` [x]
+ test/Runner/ExampleSpec.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE OverloadedStrings #-}+module Runner.ExampleSpec (main, spec) where++import           Imports++import           Data.String+import           Test.Hspec+import           Test.Hspec.Core.QuickCheck (modifyMaxSize)+import           Test.QuickCheck++import           Parse+import           Runner.Example++main :: IO ()+main = hspec spec++data Line = PlainLine String | WildCardLines [String]+  deriving (Show, Eq)++instance Arbitrary Line where+    arbitrary = frequency [ (2, PlainLine <$> arbitrary)+                          , (1, WildCardLines . getNonEmpty <$> arbitrary)+                          ]++lineToExpected :: [Line] -> ExpectedResult+lineToExpected = map $ \x -> case x of+                                 PlainLine str -> fromString str+                                 WildCardLines _ -> WildCardLine++lineToActual :: [Line] -> [String]+lineToActual = concatMap $ \x -> case x of+                               PlainLine str -> [str]+                               WildCardLines xs -> xs++spec :: Spec+spec = do+  describe "mkResult" $ do+    it "returns Equal when output matches" $ do+      property $ \xs -> do+        mkResult (map fromString xs) xs `shouldBe` Equal++    it "ignores trailing whitespace" $ do+      mkResult ["foo\t"] ["foo  "] `shouldBe` Equal++    context "with WildCardLine" $ do+      it "matches zero lines" $ do+        mkResult ["foo", WildCardLine, "bar"] ["foo", "bar"]+            `shouldBe` Equal++      it "matches first zero line" $ do+        mkResult [WildCardLine, "foo", "bar"] ["foo", "bar"]+            `shouldBe` Equal++      it "matches final zero line" $ do+        mkResult ["foo", "bar", WildCardLine] ["foo", "bar"]+            `shouldBe` Equal++      it "matches an arbitrary number of lines" $ do+        mkResult ["foo", WildCardLine, "bar"] ["foo", "baz", "bazoom", "bar"]+            `shouldBe` Equal++      -- See https://github.com/sol/doctest/issues/259+      modifyMaxSize (const 8) $+        it "matches an arbitrary number of lines (quickcheck)" $ do+          property $ \xs -> mkResult (lineToExpected xs) (lineToActual xs)+              `shouldBe` Equal++    context "with WildCardChunk" $ do+      it "matches an arbitrary line chunk" $ do+        mkResult [ExpectedLine ["foo", WildCardChunk, "bar"]] ["foo baz bar"]+            `shouldBe` Equal++      it "matches an arbitrary line chunk at end" $ do+        mkResult [ExpectedLine ["foo", WildCardChunk]] ["foo baz bar"]+            `shouldBe` Equal++      it "does not match at end" $ do+        mkResult [ExpectedLine [WildCardChunk, "baz"]] ["foo baz bar"]+            `shouldBe` NotEqual [+                 "expected: ...baz"+               , " but got: foo baz bar"+               , "                 ^"+               ]++      it "does not match at start" $ do+        mkResult [ExpectedLine ["fuu", WildCardChunk]] ["foo baz bar"]+            `shouldBe` NotEqual [+                 "expected: fuu..."+               , " but got: foo baz bar"+               , "           ^"+               ]++    context "when output does not match" $ do+      it "constructs failure message" $ do+        mkResult ["foo"] ["bar"] `shouldBe` NotEqual [+            "expected: foo"+          , " but got: bar"+          , "          ^"+          ]++      it "constructs failure message for multi-line output" $ do+        mkResult ["foo", "bar"] ["foo", "baz"] `shouldBe` NotEqual [+            "expected: foo"+          , "          bar"+          , " but got: foo"+          , "          baz"+          , "            ^"+          ]++      context "when any output line contains \"unsafe\" characters" $ do+        it "uses show to format output lines" $ do+          mkResult ["foo\160bar"] ["foo bar"] `shouldBe` NotEqual [+              "expected: foo\\160bar"+            , " but got: foo bar"+            , "             ^"+            ]++      it "insert caret after last matching character on different lengths" $ do+        mkResult ["foo"] ["fo"] `shouldBe` NotEqual [+            "expected: foo"+          , " but got: fo"+          , "            ^"+          ]++      it "insert caret after mismatching line for multi-line output" $ do+        mkResult ["foo", "bar", "bat"] ["foo", "baz", "bax"] `shouldBe` NotEqual [+            "expected: foo"+          , "          bar"+          , "          bat"+          , " but got: foo"+          , "          baz"+          , "            ^"+          , "          bax"+          ]++      it "insert caret after mismatching line with the longest match for multi-line wildcard pattern" $ do+        mkResult ["foo", WildCardLine, "bar", "bat"] ["foo", "xxx", "yyy", "baz", "bxx"] `shouldBe` NotEqual [+            "expected: foo"+          , "          ..."+          , "          bar"+          , "          bat"+          , " but got: foo"+          , "          xxx"+          , "          yyy"+          , "          baz"+          , "            ^"+          , "          bxx"+          ]++      it "insert caret after longest match for wildcard" $ do+        mkResult [ExpectedLine ["foo ", WildCardChunk, " bar bat"]] ["foo xxx yyy baz bxx"] `shouldBe` NotEqual [+            "expected: foo ... bar bat"+          , " but got: foo xxx yyy baz bxx"+          , "                        ^"+          ]++      it "show expanded pattern for long matches" $ do+        mkResult [ExpectedLine ["foo ", WildCardChunk, " bar bat"]] ["foo 123456789 123456789 xxx yyy baz bxx"] `shouldBe` NotEqual [+            "expected: foo ... bar bat"+          , " but got: foo 123456789 123456789 xxx yyy baz bxx"+          , "          foo ........................... ba^"+          ]
+ test/RunnerSpec.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE CPP, OverloadedStrings #-}+module RunnerSpec (spec) where++import           Imports++import           Test.Hspec++import           Data.IORef+import           System.IO+import           System.IO.Silently (hCapture_)+import           Runner++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 Interactive $ do+          report "foobar"+        `shouldReturn` "foobar\n"++    context "when mode is non-interactive" $ do+      it "writes to stderr" $ do+        capture NonInteractive $ do+          report "foobar"+        `shouldReturn` "foobar\n"++  describe "report_" $ do+    context "when mode is interactive" $ do+      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 NonInteractive $ do+          reportTransient "foobar"+        `shouldReturn` ""
+ test/UtilSpec.hs view
@@ -0,0 +1,23 @@+module UtilSpec (main, spec) where++import           Imports++import           Test.Hspec++import           Util++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "convertDosLineEndings" $ do+    it "converts CRLF to LF" $ do+      convertDosLineEndings "foo\r\nbar\r\nbaz" `shouldBe` "foo\nbar\nbaz"++    it "strips a trailing CR" $ do+      convertDosLineEndings "foo\r" `shouldBe` "foo"++  describe "takeWhileEnd" $ do+    it "returns the longest suffix of elements that satisfy a given predicate" $ do+      takeWhileEnd (/= ' ') "foo bar" `shouldBe` "bar"
− test/doctests.hs 
@@ -1,13 +0,0 @@-module Main where--import           Test.DocTest--main :: IO ()-main = doctest [-    "-packageghc"-  , "-isrc"-  , "-idist/build/autogen/"-  , "-optP-include"-  , "-optPdist/build/autogen/cabal_macros.h"-  , "src/Run.hs"-  ]
+ test/extract/argument-list/Foo.hs view
@@ -0,0 +1,6 @@+module Foo where++foo :: Int -- ^ doc for arg1+    -> Int -- ^ doc for arg2+    -> Int+foo = undefined
+ test/extract/comment-order/Foo.hs view
@@ -0,0 +1,28 @@+-- | module header+module Foo (++-- * some heading+-- | export list 1+  foo++-- * some other heading+-- | export list 2+, bar++-- * one more heading+-- $foo+, baz+) where++-- | foo+foo :: Int+foo = 23++-- $foo named chunk++-- | bar+bar :: Int+bar = 23++baz :: Int+baz = 23
+ test/extract/declaration/Foo.hs view
@@ -0,0 +1,5 @@+module Foo where++-- | Some documentation+foo :: Int+foo = 23
+ test/extract/dos-line-endings/Foo.hs view
@@ -0,0 +1,8 @@+module Foo where
+
+-- |
+-- foo
+-- bar
+-- baz
+foo :: Int
+foo = 23
+ test/extract/export-list/Foo.hs view
@@ -0,0 +1,12 @@+module Foo (+-- * some heading+-- | documentation from export list+  foo+, bar+) where++foo :: Int+foo = 23++bar :: Int+bar = 23
+ test/extract/imported-module/Bar.hs view
@@ -0,0 +1,7 @@+module Bar where++import Baz++-- | documentation for bar+bar :: Int+bar = 23
+ test/extract/imported-module/Baz.hs view
@@ -0,0 +1,5 @@+module Baz where++-- | documentation for baz+baz :: Int+baz = 23
+ test/extract/module-header/Foo.hs view
@@ -0,0 +1,5 @@+-- | Some documentation+module Foo where++foo :: Int+foo = 23
+ test/extract/named-chunks/Foo.hs view
@@ -0,0 +1,15 @@+module Foo (+  foo+, bar+) where++-- $foo named chunk foo++-- $bar+-- named chunk bar++foo :: Int+foo = 23++bar :: Int+bar = 23
+ test/extract/regression/Fixity.hs view
@@ -0,0 +1,4 @@+module Fixity where++foo :: Int+foo = 23 + 42
+ test/extract/regression/ForeignImport.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module ForeignImport where+import Foreign.C++import Prelude hiding (sin)+ +-- pure function+foreign import ccall "sin" c_sin :: CDouble -> CDouble+sin :: Double -> Double+sin d = realToFrac (c_sin (realToFrac d))
+ test/extract/regression/ParallelListComp.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE ParallelListComp #-}+module ParallelListComp where++foo :: [Int]+foo = [x+y | x <- [1,2,3] | y <- [4,5,6]]
+ test/extract/regression/ParallelListCompClass.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE ParallelListComp #-}+module ParallelListCompClass where++class Foo a where+  foo :: a -> [Int]++instance Foo Int where+  foo _ = [x+y | x <- [1,2,3] | y <- [4,5,6]]
+ test/extract/regression/RewriteRules.hs view
@@ -0,0 +1,7 @@+module RewriteRules (foo) where++{-# RULES "map/append" forall f xs ys. map f (xs ++ ys) = map f xs ++ map f ys #-}++-- | doc for foo+foo :: Int+foo = 23
+ test/extract/regression/RewriteRulesWithSigs.hs view
@@ -0,0 +1,7 @@+module RewriteRulesWithSigs (foo) where++{-# RULES "map/append" forall f (xs :: [Int])  ys. map f (xs ++ ys) = map f xs ++ map f ys #-}++-- | doc for foo+foo :: Int+foo = 23
+ test/extract/setup/Foo.hs view
@@ -0,0 +1,16 @@+module Foo where++-- $setup+-- some setup code++-- | foo+foo :: Int+foo = 42++-- | bar+bar :: Int+bar = 42++-- | baz+baz :: Int+baz = 42
+ test/extract/th/Bar.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TemplateHaskell #-}++module Bar where++import Language.Haskell.TH.Lib (ExpQ)++bar :: ExpQ+bar = [| 23 |]
+ test/extract/th/Foo.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TemplateHaskell #-}+module Foo where++import Bar++-- | some documentation+foo :: Int+foo = $(bar)
+ test/extract/type-class-args/Foo.hs view
@@ -0,0 +1,8 @@+module Foo where+++class Foo a where++  bar :: a    -- ^ foo+      -> Int  -- ^ bar+      -> String
+ test/extract/type-class/Foo.hs view
@@ -0,0 +1,7 @@+module Foo where+++class ToString a where++  -- | Convert given value to a string.+  toString :: a -> String
+ test/extract/type-families/Foo.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE TypeFamilies #-}+module Foo where++type family Foo a++type instance Foo Int = Int
+ test/integration/bugfixImportHierarchical/ModuleA.hs view
@@ -0,0 +1,6 @@+-- |+-- >>> fib 10+-- 55+module ModuleA where++import Foo.ModuleB
+ test/integration/bugfixImportHierarchical/ModuleB.hs view
@@ -0,0 +1,12 @@+module Foo.ModuleB (fib) where+++-- |+-- >>> fib 10+-- 55+-- >>> fib 5+-- 5+fib :: Integer -> Integer+fib 0 = 0+fib 1 = 1+fib n = fib (n - 1) + fib (n - 2)
+ test/integration/bugfixMultipleModules/ModuleA.hs view
@@ -0,0 +1,6 @@+-- |+-- >>> fib 10+-- 55+module ModuleA where++import ModuleB
+ test/integration/bugfixMultipleModules/ModuleB.hs view
@@ -0,0 +1,20 @@+module ModuleB (fib) where+++-- |+-- >>> fib 10+-- 55+-- >>> fib 5+-- 5+fib :: Integer -> Integer+fib = foo++-- |+-- >>> foo 10+-- 55+-- >>> foo 5+-- 5+foo :: Integer -> Integer+foo 0 = 0+foo 1 = 1+foo n = foo (n - 1) + foo (n - 2)
+ test/integration/bugfixOutputToStdErr/Fib.hs view
@@ -0,0 +1,9 @@+module Fib where++-- | Calculate Fibonacci number of given 'Num'.+--+-- >>> import System.IO+-- >>> hPutStrLn stderr "foobar"+-- foobar+fib :: (Num t, Num t1) => t -> t1+fib _ = undefined
+ test/integration/bugfixWorkingDirectory/Fib.hs view
@@ -0,0 +1,10 @@+module Fib where++-- | Calculate Fibonacci number of given 'Num'.+--+-- >>> bar+-- 10+fib :: (Num t, Num t1) => t -> t1+fib _ = undefined++bar = 10
+ test/integration/bugfixWorkingDirectory/description view
@@ -0,0 +1,10 @@+Put the following files in the current working directory:++    ./Fib.hs+    ./examples/Fib.hs++Now run:++    doctest examples/Fib.hs++Erroneously `./Fib.hs` will be tested instead of `examples/Fib.hs`.
+ test/integration/bugfixWorkingDirectory/examples/Fib.hs view
@@ -0,0 +1,22 @@+module Fib where+++-- | Calculate Fibonacci number of given 'Num'.+--+-- Examples:+--+--    >>> fib 10+--    55+fib :: Integer -> Integer+fib 0 = 0+fib 1 = 1+fib n = fib (n - 1) + fib (n - 2)++-- |+--+-- Examples:+--+--    >>> fib 10+--    55+foo :: Int -> Int+foo = undefined
+ test/integration/color/Foo.hs view
@@ -0,0 +1,8 @@+module Foo where++import Data.Maybe++-- | Convert a map into list array.+-- prop> tabulate m !! fromEnum d == fromMaybe 0 (lookup d m)+tabulate :: [(Bool, Double)] -> [Double]+tabulate m = [fromMaybe 0 $ lookup False m, fromMaybe 0 $ lookup True m]
+ test/integration/custom-package-conf/Bar.hs view
@@ -0,0 +1,10 @@+module Bar where++import Foo++-- |+-- >>> import Foo+-- >>> foo+-- 23+bar :: Int+bar = 42
+ test/integration/custom-package-conf/foo/Foo.hs view
@@ -0,0 +1,3 @@+module Foo where+foo :: Int+foo = 23
+ test/integration/custom-package-conf/foo/doctest-foo.cabal view
@@ -0,0 +1,8 @@+name:           doctest-foo+version:        0.0.0+build-type:     Simple+cabal-version:  >= 1.8++library+  exposed-modules:  Foo+  build-depends:    base
+ test/integration/dos-line-endings/Fib.hs view
@@ -0,0 +1,10 @@+module Fib where
+
+-- | Calculate Fibonacci numbers.
+--
+-- >>> fib 10
+-- 55
+fib :: Integer -> Integer
+fib 0 = 0
+fib 1 = 1
+fib n = fib (n - 1) + fib (n - 2)
+ 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
+ test/integration/failing-multiple/Foo.hs view
@@ -0,0 +1,16 @@+module Foo where++-- | A failing example+--+-- >>> 23+-- 23+--+-- >>> 23+-- 42+--+-- >>> 23+-- 23+-- >>> 23+-- 23+test :: a+test = undefined
+ test/integration/failing/Foo.hs view
@@ -0,0 +1,8 @@+module Foo where++-- | A failing example+--+-- >>> 23+-- 42+test :: a+test = undefined
+ test/integration/it/Foo.hs view
@@ -0,0 +1,20 @@+module Foo where++-- |+--+-- >>> :t 'a'+-- 'a' :: Char+--+-- >>> "foo"+-- "foo"+--+-- >>> length it+-- 3+--+-- >>> it * it+-- 9+--+-- >>> :t it+-- it :: Int+--+foo = undefined
+ test/integration/it/Setup.hs view
@@ -0,0 +1,23 @@+module Setup where++-- $setup+-- >>> :t 'a'+-- 'a' :: Char+--+-- >>> 42 :: Int+-- 42+--+-- >>> it+-- 42++-- |+--+-- >>> it * it+-- 1764+foo = undefined++-- |+--+-- >>> it * it+-- 1764+bar = undefined
+ test/integration/local-stderr-binding/A.hs view
@@ -0,0 +1,11 @@+module A where++stderr :: Bool+stderr = True++stdout :: String+stdout = "hello"++-- |+-- >>> 3 + 3+-- 6
+ test/integration/multiline/Multiline.hs view
@@ -0,0 +1,61 @@+module Multiline where+++{- |++>>> :{+    let+     x = 1+     y = z+   in x + y+  :}+  3++-}+z = 2++{- |++Aligns with the closing++>>> :{+    let+     x = 1+     y = z+   in x + y+     :}+     3+-}+z2 = 2+++{- | Also works let that's for do:++>>> :{+let+     x = 1+     y = z+:}++>>> y+2++-}+z3 = 2++++{- | Handles repeated @>>>@ too, which is bad since haddock-2.13.2 currently +will strip the leading whitespace leading to something that will not copy-paste+(unless it uses explicit { ; } and the users manually strip the @>>>@)++>>> :{+>>> let+>>>      x = 1+>>>      y = z+>>> in x + y+>>> :}+3++-}+z4 = 4
+ test/integration/parse-error/Foo.hs view
@@ -0,0 +1,5 @@+module Foo where++-- | Some documentation+foo :: Int+foo =
+ test/integration/property-bool-with-type-signature/Foo.hs view
@@ -0,0 +1,5 @@+module Foo where++-- |+-- prop> True :: Bool+foo = undefined
+ test/integration/property-bool/Foo.hs view
@@ -0,0 +1,5 @@+module Foo where++-- |+-- prop> True+foo = undefined
+ test/integration/property-failing/Foo.hs view
@@ -0,0 +1,5 @@+module Foo where++-- |+-- prop> abs x == x+foo = undefined
+ test/integration/property-implicitly-quantified/Foo.hs view
@@ -0,0 +1,5 @@+module Foo where++-- |+-- prop> abs x == abs (abs x)+foo = undefined
+ test/integration/property-quantified/Foo.hs view
@@ -0,0 +1,5 @@+module Foo where++-- |+-- prop> \x -> abs x == abs (abs x)+foo = undefined
+ test/integration/property-setup/Foo.hs view
@@ -0,0 +1,9 @@+module Foo where++-- $setup+-- >>> import Test.QuickCheck+-- >>> let arbitraryEven = (* 2) `fmap` arbitrary++-- |+-- prop> forAll arbitraryEven even+foo = undefined
+ test/integration/setup-skip-on-failure/Foo.hs view
@@ -0,0 +1,17 @@+module Foo where++-- $setup+-- >>> x+-- 23++-- |+-- >>> foo+-- 42+foo :: Int+foo = 42++-- |+-- >>> y+-- 42+bar :: Int+bar = 42
+ test/integration/setup/Foo.hs view
@@ -0,0 +1,10 @@+module Foo where++-- $setup+-- >>> let x = 23 :: Int++-- |+-- >>> x + foo+-- 65+foo :: Int+foo = 42
+ test/integration/system-io-imported/A.hs view
@@ -0,0 +1,10 @@+module A where++import System.IO++-- ghci-wrapper needs to poke around with System.IO itself, and unloads the module once it's done. Test to make sure legitimate uses of System.IO don't get lost in the wash.++-- |+-- >>> ReadMode+-- ReadMode+
+ test/integration/template-haskell-bugfix/Main.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE TemplateHaskell #-}+module Main where++-- Import our template "pr"+import Printf ( pr )++-- The splice operator $ takes the Haskell source code+-- generated at compile time by "pr" and splices it into+-- the argument of "putStrLn".+main = putStrLn ( $(pr "Hello") )
+ test/integration/template-haskell-bugfix/Printf.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE TemplateHaskell #-}+--+-- derived from: http://www.haskell.org/ghc/docs/latest/html/users_guide/template-haskell.html#th-example+--+module Printf (pr) where++import Language.Haskell.TH++data Format = D | S | L String++parse :: String -> [Format]+parse s   = [ L s ]++gen :: [Format] -> Q Exp+gen [D]   = [| \n -> show n |]+gen [S]   = [| \s -> s |]+gen [L s] = stringE s++-- |+--+-- >>> :set -XTemplateHaskell+-- >>> putStrLn ( $(pr "Hello") )+-- Hello+pr :: String -> Q Exp+pr s = gen (parse s)
+ test/integration/template-haskell/Foo.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE TemplateHaskell #-}+module Foo where++import Language.Haskell.TH+import Text.Printf++-- | Report an error.+--+-- >>> :set -XTemplateHaskell+-- >>> $(logError "Something bad happened!")+-- ERROR <interactive>: Something bad happened!+logError :: String -> Q Exp+logError msg = do+  loc <- location+  let s = (printf "ERROR %s: %s" (loc_filename loc) msg) :: String+  [| putStrLn s |]
+ test/integration/test-options/Foo.hs view
@@ -0,0 +1,14 @@+module Foo where+++-- |+-- Examples:+--+-- >>> foo+-- 23+foo :: Int+#ifdef FOO+foo = 23+#else+foo = 42+#endif
+ test/integration/testBlankline/Fib.hs view
@@ -0,0 +1,10 @@+module Fib where++-- | Calculate Fibonacci number of given 'Num'.+--+-- >>> putStrLn "foo\n\nbar"+-- foo+-- <BLANKLINE>+-- bar+fib :: (Num t, Num t1) => t -> t1+fib _ = undefined
+ test/integration/testCPP/Foo.hs view
@@ -0,0 +1,14 @@+module Foo where+++-- |+-- Examples:+--+-- >>> foo+-- 23+foo :: Int+#ifdef FOO+foo = 23+#else+foo = 42+#endif
+ test/integration/testCombinedExample/Fib.hs view
@@ -0,0 +1,20 @@+module Fib where++-- | Calculate Fibonacci number of given 'Num'.+--+-- First let's set `n` to ten:+--+-- >>> let n = 10+--+-- And now calculate the 10th Fibonacci number:+--+-- >>> fib n+-- 55+--+-- >>> let x = 10+-- >>> x+-- 10+fib :: Integer -> Integer+fib 0 = 0+fib 1 = 1+fib n = fib (n - 1) + fib (n - 2)
+ test/integration/testCommentLocation/Foo.hs view
@@ -0,0 +1,79 @@+-- |+-- Examples in various locations...+--+-- Some random text.  Some random text.  Some random text.  Some random text.+-- Some random text.  Some random text.  Some random text.  Some random text.+-- Some random text.+--+-- >>> let x = 10+--+-- Some random text.  Some random text.  Some random text.  Some random text.+-- Some random text.  Some random text.  Some random text.  Some random text.+-- Some random text.+--+--+--   >>> baz+--   "foobar"++module Foo (+  -- | Some documentation not attached to a particular Haskell entity+  --+  -- >>> test 10+  -- *** Exception: Prelude.undefined+  -- ...+  test,++  -- |+  -- >>> fib 10+  -- 55+  fib,++  -- |+  -- >>> bar+  -- "bar"+  bar+  ) where+++-- | My test+--+-- >>> test 20+-- *** Exception: Prelude.undefined+-- ...+test :: Integer -> Integer+test = undefined++-- | Note that examples for 'fib' include the two examples below+-- and the one example with ^ syntax after 'fix'+--+-- >>> foo+-- "foo"++{- |+    Example:++     >>> fib 10+     55+-}++-- | Calculate Fibonacci number of given `n`.+fib :: Integer  -- ^ given `n`+                --+                -- >>> fib 10+                -- 55++    -> Integer  -- ^ Fibonacci of given `n`+                --+                -- >>> baz+                -- "foobar"+fib 0 = 0+fib 1 = 1+fib n = fib (n - 1) + fib (n - 2)+-- ^ Example:+--+--   >>> fib 5+--   5++foo = "foo"+bar = "bar"+baz = foo ++ bar
+ test/integration/testDocumentationForArguments/Fib.hs view
@@ -0,0 +1,7 @@+module Fib where++fib :: Int -- ^ +           -- >>> 23+           -- 23+    -> Int+fib _ = undefined
+ test/integration/testFailOnMultiline/Fib.hs view
@@ -0,0 +1,13 @@+module Fib where++-- | The following interaction cause `doctest' to fail with an error:+--+-- >>> :{+foo :: Int+foo = 23++-- | The following interaction cause `doctest' to fail with an error:+--+-- >>>       :{+bar :: Int+bar = 23
+ test/integration/testImport/ModuleA.hs view
@@ -0,0 +1,6 @@+-- |+-- >>> fib 10+-- 55+module ModuleA where++import ModuleB
+ test/integration/testImport/ModuleB.hs view
@@ -0,0 +1,12 @@+module ModuleB (fib) where+++-- |+-- >>> fib 10+-- 55+-- >>> fib 5+-- 5+fib :: Integer -> Integer+fib 0 = 0+fib 1 = 1+fib n = fib (n - 1) + fib (n - 2)
+ test/integration/testPutStr/Fib.hs view
@@ -0,0 +1,13 @@+module Fib where++-- | Calculate Fibonacci number of given 'Num'.+--+-- >>> putStrLn "foo"+-- foo+-- >>> putStr "bar"+-- bar+--+-- >>> putStrLn "baz"+-- baz+fib :: (Num t, Num t1) => t -> t1+fib _ = undefined
+ test/integration/testSimple/Fib.hs view
@@ -0,0 +1,10 @@+module Fib where++-- | Calculate Fibonacci numbers.+--+-- >>> fib 10+-- 55+fib :: Integer -> Integer+fib 0 = 0+fib 1 = 1+fib n = fib (n - 1) + fib (n - 2)
+ test/integration/trailing-whitespace/Foo.hs view
@@ -0,0 +1,8 @@+module Foo where++-- | A failing example+--+-- >>> putStrLn "foo   "+-- foo+test :: a+test = undefined
+ test/integration/with-cbits/Bar.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Bar where++import Foreign.C++-- |+-- >>> foo+-- 23+foreign import ccall foo :: CInt
+ test/parse/multiple-examples/Foo.hs view
@@ -0,0 +1,11 @@+module Foo where++-- |+-- >>> foo+-- 23+foo = 23++-- |+-- >>> bar+-- 42+bar = 42
+ test/parse/no-examples/Fib.hs view
@@ -0,0 +1,10 @@+module Fib where++-- | Calculate Fibonacci numbers.+-- @+-- some code+-- @+--+-- foobar 23+fib :: Int -> Int -> Int+fib _ = undefined
+ test/parse/non-exported/Fib.hs view
@@ -0,0 +1,16 @@+module Fib (foo) where++foo :: Int+foo = 23++-- | Calculate Fibonacci number of given 'Num'.+--+-- >>> putStrLn "foo"+-- foo+-- >>> putStr "bar"+-- bar+--+-- >>> putStrLn "baz"+-- baz+fib :: (Num t, Num t1) => t -> t1+fib _ = undefined
+ test/parse/property/Fib.hs view
@@ -0,0 +1,15 @@+module Fib where++-- | Calculate Fibonacci numbers.+--+-- prop> foo+--+-- some text+--+-- prop> bar+--+-- some more text+--+-- prop> baz+fib :: Int -> Int -> Int+fib _ = undefined
+ test/parse/setup-empty/Foo.hs view
@@ -0,0 +1,10 @@+module Foo where++-- $setup+-- some setup code++-- |+-- >>> foo+-- 23+foo :: Int+foo = 23
+ test/parse/setup-only/Foo.hs view
@@ -0,0 +1,9 @@+module Foo where++-- $setup+-- >>> foo+-- 23++-- | some documentation+foo :: Int+foo = 23
+ test/parse/simple/Fib.hs view
@@ -0,0 +1,13 @@+module Fib where++-- | Calculate Fibonacci numbers.+--+-- >>> putStrLn "foo"+-- foo+-- >>> putStr "bar"+-- bar+--+-- >>> putStrLn "baz"+-- baz+fib :: Int -> Int -> Int+fib _ = undefined