diff --git a/CHANGES.markdown b/CHANGES.markdown --- a/CHANGES.markdown +++ b/CHANGES.markdown @@ -1,6 +1,6 @@ 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. + 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` diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,9 +1,9 @@ # Doctest: Test interactive Haskell examples `doctest` is a tool that checks -[examples](https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744) +[examples](https://haskell-haddock.readthedocs.io/latest/markup.html#examples) and -[properties](https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810771856) +[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). @@ -12,6 +12,7 @@ * [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) @@ -33,24 +34,30 @@ ## Installation `doctest` is available from -[Hackage](http://hackage.haskell.org/cgi-bin/hackage-scripts/package/doctest). +[Hackage](https://hackage.haskell.org/package/doctest). Install it with: - cabal update && cabal install doctest - -Make sure that Cabal's `bindir` is on your `PATH`. - -On Linux: + cabal update && cabal install --ignore-project doctest - export PATH="$HOME/.cabal/bin:$PATH" +Make sure that Cabal's `installdir` is on your `PATH`. -On Mac OS X: +On Linux / macOS / BSD: - export PATH="$HOME/Library/Haskell/bin:$PATH" +```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: +On Windows with PowerShell: - set PATH="%AppData%\cabal\bin\;%PATH%" +```pwsh +# requires cabal-install version 3.12, or later +$Env:PATH = "$(cabal -v0 path --installdir)" + ";" + $Env:PATH +``` ## A basic example @@ -81,7 +88,7 @@ (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) +[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 @@ -120,7 +127,7 @@ 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 @@ -159,7 +166,7 @@ Example: -``` +```bash $ cabal repl --with-compiler=doctest --repl-options=--verbose ### Started execution at src/Fib.hs:7. ### example: @@ -175,6 +182,48 @@ 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 @@ -387,7 +436,7 @@ ``` If you see an error like the following, ensure that -[QuickCheck](http://hackage.haskell.org/package/QuickCheck) is visible to +[QuickCheck](https://hackage.haskell.org/package/QuickCheck) is visible to `doctest` (e.g. by passing `--build-depends=QuickCheck` to `cabal repl`). ```haskell @@ -415,7 +464,7 @@ -- 2 ``` -[named-chunks]: http://www.haskell.org/haddock/doc/html/ch03s05.html +[named-chunks]: https://haskell-haddock.readthedocs.io/latest/markup.html#named-chunks ## Using GHC extensions @@ -456,7 +505,7 @@ -- >>> :seti -XTupleSections ``` -[language-pragma]: https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/exts/pragmas.html#language-pragma +[language-pragma]: https://downloads.haskell.org/ghc/latest/docs/users_guide/exts/pragmas.html#language-pragma # Limitations @@ -518,40 +567,43 @@ # 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 - * Andreas Abel * Ankit Ahuja * Artyom Kazak - * Edward Kmett * Gabor Greif + * Guillaume Bouchard * Hiroki Hattori - * Ignat Insarov * Jens Petersen - * Joachim Breitner * John Chee * João Cristóvão - * Julian Arni - * Kazu Yamamoto * Leon Schoorl * Levent Erkok * Luke Murphy * Matvey Aksenov - * Michael Orlitzky - * Michael Snoyman * Mitchell Rosen * Nick Smallbone * Nikos Baxevanis - * Oleg Grenrus - * quasicomputational - * Ryan Scott - * Sakari Jokinen - * Simon Hengel - * Sönke Hahn - * Takano Akio * Tamar Christina * Veronika Romashkina diff --git a/doctest.cabal b/doctest.cabal --- a/doctest.cabal +++ b/doctest.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: doctest -version: 0.22.5 +version: 0.22.6 synopsis: Test interactive Haskell examples description: `doctest` is a tool that checks [examples](https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744) and [properties](https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810771856) @@ -127,7 +127,11 @@ Test.DocTest.Internal.Location Test.DocTest.Internal.Parse Test.DocTest.Internal.Run + Test.DocTest.Internal.Cabal other-modules: + Cabal + Cabal.Options + Cabal.Paths Extract GhcUtil Imports @@ -147,6 +151,7 @@ build-depends: base >=4.7 && <5 , code-page >=0.1 + , containers , deepseq , directory , exceptions @@ -174,9 +179,7 @@ ghc-options: -Wall -threaded build-depends: base >=4.7 && <5 - , filepath - , process - , temporary + , doctest default-language: Haskell2010 if impl(ghc >= 9.0) ghc-options: -fwarn-unused-packages @@ -209,6 +212,8 @@ test-suite spec main-is: Spec.hs other-modules: + Cabal.OptionsSpec + Cabal.PathsSpec ExtractSpec InfoSpec InterpreterSpec @@ -223,6 +228,9 @@ RunnerSpec RunSpec UtilSpec + Cabal + Cabal.Options + Cabal.Paths Extract GhcUtil Imports @@ -238,6 +246,7 @@ Runner Runner.Example Test.DocTest + Test.DocTest.Internal.Cabal Test.DocTest.Internal.Extract Test.DocTest.Internal.Location Test.DocTest.Internal.Parse @@ -264,6 +273,7 @@ , QuickCheck >=2.13.1 , base >=4.7 && <5 , code-page >=0.1 + , containers , deepseq , directory , exceptions diff --git a/driver/cabal-doctest.hs b/driver/cabal-doctest.hs --- a/driver/cabal-doctest.hs +++ b/driver/cabal-doctest.hs @@ -1,36 +1,8 @@ -{-# LANGUAGE LambdaCase #-} module Main (main) where import Prelude - -import Data.Version -import System.Environment -import System.Exit -import System.FilePath -import System.IO.Temp (withSystemTempDirectory) -import System.Process - -import Paths_doctest (version) +import qualified Test.DocTest.Internal.Cabal as Cabal +import System.Environment (getArgs) main :: IO () -main = do - args <- getArgs - lookupEnv "CABAL" >>= \ case - Nothing -> run "cabal" args - Just cabal -> run cabal (drop 1 args) - -run :: String -> [String] -> IO () -run cabal args = withSystemTempDirectory "doctest" $ \ dir -> do - let - doctest = dir "doctest" - script = dir "init-ghci" - callProcess cabal ["install", "--ignore-project", "--installdir", dir, "--install-method=symlink", "doctest-" ++ showVersion version] - callProcess (dir "doctest") ["--version"] - callProcess cabal ("build" : "--only-dependencies" : args) - writeFile script ":seti -w -Wdefault" - spawnProcess cabal ("repl" - : "--build-depends=QuickCheck" - : "--build-depends=template-haskell" - : ("--repl-options=-ghci-script=" ++ script) - : "--with-compiler" : doctest - : args) >>= waitForProcess >>= exitWith +main = getArgs >>= Cabal.doctest diff --git a/src/Cabal.hs b/src/Cabal.hs new file mode 100644 --- /dev/null +++ b/src/Cabal.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE LambdaCase #-} +module Cabal (externalCommand) where + +import Imports + +import System.IO +import System.Environment +import System.Exit (exitWith) +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 + , "--with-hc-pkg", ghcPkg + ] + + doesFileExist script >>= \ case + True -> pass + False -> writeFileAtomically script ":seti -w -Wdefault" + + callProcess doctest ["--version"] + + callProcess cabal ("build" : "--only-dependencies" : discardReplOptions args) + + rawSystem cabal ("repl" + : "--build-depends=QuickCheck" + : "--build-depends=template-haskell" + : ("--repl-options=-ghci-script=" <> script) + : args ++ [ + "--with-compiler", doctest + , "--with-hc-pkg", ghcPkg + ]) >>= exitWith + +writeFileAtomically :: FilePath -> String -> IO () +writeFileAtomically name contents = do + (tmp, h) <- openTempFile (takeDirectory name) (takeFileName name) + hPutStr h contents + hClose h + renameFile tmp name diff --git a/src/Cabal/Options.hs b/src/Cabal/Options.hs new file mode 100644 --- /dev/null +++ b/src/Cabal/Options.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +module Cabal.Options ( + rejectUnsupportedOptions +, discardReplOptions + +#ifdef TEST +, Option(..) +, pathOptions +, replOptions +, shouldReject +, Discard(..) +, shouldDiscard +#endif +) where + +import Imports + +import Data.List +import System.Exit + +import Data.Set (Set) +import qualified Data.Set as Set + +data Option = Option { + optionName :: String +, _optionArgument :: OptionArgument +} + +data OptionArgument = Argument | NoArgument + +pathOptions :: [Option] +pathOptions = [ + Option "-z" NoArgument + , Option "--ignore-project" NoArgument + , Option "--output-format" Argument + , Option "--compiler-info" NoArgument + , Option "--cache-home" NoArgument + , Option "--remote-repo-cache" NoArgument + , Option "--logs-dir" NoArgument + , Option "--store-dir" NoArgument + , Option "--config-file" NoArgument + , Option "--installdir" NoArgument + ] + +replOptions :: [Option] +replOptions = [ + Option "-z" NoArgument + , Option "--ignore-project" NoArgument + , Option "--repl-no-load" NoArgument + , Option "--repl-options" Argument + , Option "--repl-multi-file" Argument + , Option "-b" Argument + , Option "--build-depends" Argument + , Option "--no-transitive-deps" NoArgument + , Option "--enable-multi-repl" NoArgument + , Option "--disable-multi-repl" NoArgument + , Option "--keep-temp-files" NoArgument + ] + +rejectUnsupportedOptions :: [String] -> IO () +rejectUnsupportedOptions = mapM_ $ \ arg -> when (shouldReject arg) $ do + die "Error: cabal: unrecognized 'doctest' option `--installdir'" + +shouldReject :: String -> Bool +shouldReject arg = + Set.member arg rejectNames + || (`any` longOptionsWithArgument) (`isPrefixOf` arg) + where + rejectNames :: Set String + rejectNames = Set.fromList (map optionName pathOptions) + + longOptionsWithArgument :: [String] + longOptionsWithArgument = [name <> "=" | Option name@('-':'-':_) Argument <- pathOptions] + +discardReplOptions :: [String] -> [String] +discardReplOptions = go + where + go = \ case + [] -> [] + arg : args -> case shouldDiscard arg of + Keep -> arg : go args + Discard -> go args + DiscardWithArgument -> go (drop 1 args) + +data Discard = Keep | Discard | DiscardWithArgument + deriving (Eq, Show) + +shouldDiscard :: String -> Discard +shouldDiscard arg + | Set.member arg flags = Discard + | Set.member arg options = DiscardWithArgument + | isOptionWithArgument = Discard + | otherwise = Keep + where + flags :: Set String + flags = Set.fromList [name | Option name NoArgument <- replOptions] + + options :: Set String + options = Set.fromList (longOptions <> shortOptions) + + longOptions :: [String] + longOptions = [name | Option name@('-':'-':_) Argument <- replOptions] + + shortOptions :: [String] + shortOptions = [name | Option name@['-', _] Argument <- replOptions] + + isOptionWithArgument :: Bool + isOptionWithArgument = any (`isPrefixOf` arg) (map (<> "=") longOptions <> shortOptions) diff --git a/src/Cabal/Paths.hs b/src/Cabal/Paths.hs new file mode 100644 --- /dev/null +++ b/src/Cabal/Paths.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +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 { + 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" + + ghcVersion <- strip <$> readProcess ghc ["--numeric-version"] "" + + let + ghcPkg :: FilePath + ghcPkg = takeDirectory ghc "ghc-pkg-" <> ghcVersion +#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-" <> ghcVersion <> "-" <> abi + + createDirectoryIfMissing True cache + + return Paths { + 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 + +strip :: String -> String +strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace + +parseVersion :: String -> Maybe Version +parseVersion = lookup "" . map swap . readP_to_S Version.parseVersion diff --git a/src/Imports.hs b/src/Imports.hs --- a/src/Imports.hs +++ b/src/Imports.hs @@ -4,3 +4,7 @@ import Data.Monoid as Imports import Data.Maybe as Imports import Control.Monad as Imports +import Control.Arrow as Imports + +pass :: Monad m => m () +pass = return () diff --git a/src/Info.hs b/src/Info.hs --- a/src/Info.hs +++ b/src/Info.hs @@ -2,6 +2,7 @@ module Info ( versionInfo , info +, version #ifdef TEST , formatInfo #endif @@ -19,13 +20,22 @@ 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 -import Interpreter (ghc) - version :: String version = showVersion Paths_doctest.version + +#endif ghcVersion :: String ghcVersion = GHC.cProjectVersion diff --git a/src/Test/DocTest/Internal/Cabal.hs b/src/Test/DocTest/Internal/Cabal.hs new file mode 100644 --- /dev/null +++ b/src/Test/DocTest/Internal/Cabal.hs @@ -0,0 +1,10 @@ +module Test.DocTest.Internal.Cabal ( + doctest +) where + +import Imports + +import qualified Cabal + +doctest :: [String] -> IO () +doctest = Cabal.externalCommand diff --git a/test/Cabal/OptionsSpec.hs b/test/Cabal/OptionsSpec.hs new file mode 100644 --- /dev/null +++ b/test/Cabal/OptionsSpec.hs @@ -0,0 +1,100 @@ +{-# 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 qualified Data.Set as Set + +import Cabal.Options + +spec :: Spec +spec = do + describe "pathOptions" $ do + it "is the set of options that are unique to 'cabal path'" $ do + build <- Set.fromList . lines <$> readProcess "cabal" ["build", "--list-options"] "" + path <- Set.fromList . lines <$> readProcess "cabal" ["path", "--list-options"] "" + map optionName pathOptions `shouldMatchList` Set.toList (Set.difference path build) + + describe "replOptions" $ 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"] "" + map optionName replOptions `shouldMatchList` Set.toList (Set.difference 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" $ rawSystem "cabal" ["repl", "--installdir"] >>= exitWith +#endif + shouldFail "doctest" $ rejectUnsupportedOptions ["--installdir"] + + describe "shouldReject" $ do + it "accepts --foo" $ do + shouldReject "--foo" `shouldBe` False + + it "rejects --ignore-project" $ do + shouldReject "--ignore-project" `shouldBe` True + + it "rejects -z" $ do + shouldReject "-z" `shouldBe` True + + it "rejects --output-format" $ do + shouldReject "--output-format" `shouldBe` True + + it "rejects --output-format=" $ do + shouldReject "--output-format=json" `shouldBe` True + + it "rejects --installdir" $ do + shouldReject "--installdir" `shouldBe` True + + describe "discardReplOptions" $ do + it "discards 'cabal repl'-only options" $ do + discardReplOptions [ + "--foo" + , "--build-depends=foo" + , "--build-depends", "foo" + , "-bfoo" + , "-b", "foo" + , "--bar" + , "--enable-multi-repl" + , "--repl-options", "foo" + , "--repl-options=foo" + , "--baz" + ] `shouldBe` ["--foo", "--bar", "--baz"] + + describe "shouldDiscard" $ do + it "keeps --foo" $ do + shouldDiscard "--foo" `shouldBe` Keep + + it "discards --build-depends" $ do + shouldDiscard "--build-depends" `shouldBe` DiscardWithArgument + + it "discards --build-depends=" $ do + shouldDiscard "--build-depends=foo" `shouldBe` Discard + + it "discards -b" $ do + shouldDiscard "-b" `shouldBe` DiscardWithArgument + + it "discards -bfoo" $ do + shouldDiscard "-bfoo" `shouldBe` Discard + + it "discards --repl-options" $ do + shouldDiscard "--repl-options" `shouldBe` DiscardWithArgument + + it "discards --repl-options=" $ do + shouldDiscard "--repl-options=foo" `shouldBe` Discard + + it "discards --enable-multi-repl" $ do + shouldDiscard "--enable-multi-repl" `shouldBe` Discard diff --git a/test/Cabal/PathsSpec.hs b/test/Cabal/PathsSpec.hs new file mode 100644 --- /dev/null +++ b/test/Cabal/PathsSpec.hs @@ -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