packages feed

doctest 0.16.3 → 0.25.0

raw patch · 65 files changed

Files

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