Add --fail-fast

CHANGES.markdown

@@ -1,3 +1,6 @@
+Changes in 0.23.0
+ - Add `--fail-fast`
+
 Changes in 0.22.10
  - Make progress reporting more robust
 

package.yaml

@@ -1,5 +1,5 @@
 name: doctest
-version: 0.22.10
+version: 0.23.0
 synopsis: Test interactive Haskell examples
 description: |
  `doctest` is a tool that checks [examples](https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744)

src/Options.hs

@@ -28,14 +28,16 @@ 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"
  , ""
  , "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"
@@ -57,6 +59,7 @@ data Config = Config {
  ghcOptions :: [String]
 , fastMode :: Bool
 , preserveIt :: Bool
+, failFast :: Bool
 , verbose :: Bool
 , repl :: (String, [String])
 } deriving (Eq, Show)
@@ -66,6 +69,7 @@ defaultConfig = Config {
  ghcOptions = []
 , fastMode = False
 , preserveIt = False
+, failFast = False
 , verbose = False
 , repl = (ghc, ["--interactive"])
 }
@@ -105,6 +109,9 @@ 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 } }
 
@@ -134,6 +141,7 @@ commonRunOptions :: RunOptionsParser
 commonRunOptions = do
  parseFlag "--fast" (setFastMode True)
  parseFlag "--preserve-it" (setPreserveIt True)
+ parseFlag "--fail-fast" (setFailFastMode True)
  parseFlag "--verbose" (setVerbose True)
 
 parseFlag :: String -> (Run -> Run) -> RunOptionsParser

src/Run.hs

@@ -136,9 +136,6 @@ doctestWith = doctestWithResult >=> evaluateResult
 
 type Result = Summary
 
-isSuccess :: Result -> Bool
-isSuccess s = sErrors s == 0 && sFailures s == 0
-
 evaluateResult :: Result -> IO ()
 evaluateResult r = unless (isSuccess r) exitFailure
 
@@ -158,5 +155,6 @@ runDocTests Config{..} modules = 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

@@ -4,13 +4,16 @@ module Runner (
  runModules
 , FastMode(..)
 , PreserveIt(..)
+, FailFast(..)
 , Verbose(..)
 , Summary(..)
+, isSuccess
 , formatSummary
 
 #ifdef TEST
 , Report
 , ReportState(..)
+, runReport
 , Interactive(..)
 , report
 , reportTransient
@@ -23,7 +26,10 @@ import Imports hiding (putStr, putStrLn, error)
 import Text.Printf (printf)
 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
 
@@ -45,6 +51,9 @@ data Summary = Summary {
 instance Show Summary where
  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
@@ -66,8 +75,8 @@ withLineBuffering h action = bracket (hGetBuffering h) (hSetBuffering h) $ \ _ -
  action
 
 -- | Run all examples from a list of modules.
-runModules :: FastMode -> PreserveIt -> Verbose -> Interpreter -> [Module [Located DocTest]] -> IO Summary
-runModules fastMode preserveIt verbose repl modules = withLineBuffering stderr $ do
+runModules :: FastMode -> PreserveIt -> FailFast -> Verbose -> Interpreter -> [Module [Located DocTest]] -> IO Summary
+runModules fastMode preserveIt failFast verbose repl modules = withLineBuffering stderr $ do
 
  interactive <- hIsTerminalDevice stderr <&> \ case
  False -> NonInteractive
@@ -82,7 +91,7 @@ runModules fastMode preserveIt verbose repl modules = withLineBuffering stderr $
  hPutStrLn stderr (formatSummary final)
 
  run :: IO ()
- run = flip evalStateT (ReportState interactive verbose summary) $ do
+ run = runReport (ReportState interactive failFast verbose summary) $ do
  reportProgress
  forM_ modules $ runModule fastMode preserveIt repl
  verboseReport "# Final summary:"
@@ -97,23 +106,32 @@ runModules fastMode preserveIt verbose repl modules = withLineBuffering stderr $
 countExpressions :: Module [Located DocTest] -> Int
 countExpressions (Module _ setup tests) = sum (map length tests) + maybe 0 length setup
 
-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 {
  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 = liftIO . hPutStrLn stderr
@@ -143,8 +161,7 @@ runModule fastMode preserveIt repl (Module module_ setup examples) = do
 
  -- 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
@@ -202,6 +219,12 @@ updateSummary summary = do
  ref <- gets reportStateSummary
  liftIO $ modifyIORef' ref $ mappend summary
  reportProgress
+ gets reportStateFailFast >>= \ case
+ NoFailFast -> pass
+ FailFast -> unless (isSuccess summary) abort
+
+abort :: Report ()
+abort = MaybeT $ return Nothing
 
 reportProgress :: Report ()
 reportProgress = gets reportStateVerbose >>= \ case

test/MainSpec.hs

@@ -9,7 +9,7 @@ import Test.HUnit (assertEqual, Assertion)
 
 import System.Directory (getCurrentDirectory, setCurrentDirectory)
 import System.FilePath
-import Run hiding (doctest)
+import Run hiding (doctest, doctestWith)
 import System.IO.Silently
 import System.IO
 
@@ -19,13 +19,18 @@ withCurrentDirectory workingDir action = do
  setCurrentDirectory workingDir
  action
 
--- | Construct a doctest specific 'Assertion'.
 doctest :: HasCallStack => FilePath -> [String] -> Summary -> Assertion
-doctest = doctestWithPreserveIt False
+doctest = doctestWith False False
 
-doctestWithPreserveIt :: HasCallStack => Bool -> FilePath -> [String] -> Summary -> Assertion
-doctestWithPreserveIt preserveIt workingDir ghcOptions expected = do
- actual <- withCurrentDirectory ("test/integration" </> workingDir) (hSilence [stderr] $ doctestWithResult defaultConfig {ghcOptions, preserveIt})
+doctestWithPreserveIt :: HasCallStack => FilePath -> [String] -> Summary -> Assertion
+doctestWithPreserveIt = doctestWith True False
+
+doctestWithFailFast :: HasCallStack => FilePath -> [String] -> Summary -> Assertion
+doctestWithFailFast = doctestWith False True
+
+doctestWith :: HasCallStack => Bool -> Bool -> FilePath -> [String] -> Summary -> Assertion
+doctestWith preserveIt failFast workingDir ghcOptions expected = do
+ actual <- withCurrentDirectory ("test/integration" </> workingDir) (hSilence [stderr] $ doctestWithResult defaultConfig {ghcOptions, preserveIt, failFast})
  assertEqual label (formatSummary expected) (formatSummary actual)
  where
  label = workingDir ++ " " ++ show ghcOptions
@@ -44,21 +49,35 @@ spec = do
  (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)

test/OptionsSpec.hs

@@ -65,7 +65,7 @@ spec = do
  fastMode . runConfig <$> parseOptions [] `shouldBe` Result False
 
  context "with --fast" $ do
- it "enabled fast mode" $ do
+ it "enables fast mode" $ do
  fastMode . runConfig <$> parseOptions ["--fast"] `shouldBe` Result True
 
  describe "--preserve-it" $ do
@@ -77,6 +77,15 @@ spec = do
  it "preserves the `it` variable" $ do
  preserveIt . runConfig <$> parseOptions ["--preserve-it"] `shouldBe` Result True
 
+ describe "--fail-fast" $ do
+ context "without --fail-fast" $ do
+ it "disables fail-fast mode" $ do
+ failFast . runConfig <$> parseOptions [] `shouldBe` Result False
+
+ context "with --fail-fast" $ do
+ it "enables fail-fast mode" $ do
+ failFast . runConfig <$> parseOptions ["--fail-fast"] `shouldBe` Result True
+
  context "with --help" $ do
  it "outputs usage information" $ do
  parseOptions ["--help"] `shouldBe` Output usage

test/RunnerSpec.hs

@@ -8,13 +8,12 @@ import Test.Hspec
 import Data.IORef
 import System.IO
 import System.IO.Silently (hCapture_)
-import Control.Monad.Trans.State
 import Runner
 
-capture :: Interactive -> Report a -> IO String
+capture :: Interactive -> Report () -> IO String
 capture interactive action = do
  ref <- newIORef mempty
- hCapture_ [stderr] (evalStateT action (ReportState interactive NonVerbose ref))
+ hCapture_ [stderr] (runReport (ReportState interactive NoFailFast NonVerbose ref) action)
 
 spec :: Spec
 spec = do

test/integration/fail-fast/Bar.hs

@@ -0,0 +1,8 @@
+module Bar where
+
+-- | bar
+-- a passing test
+-- >>> bar
+-- 42
+bar :: Int
+bar = 42

test/integration/fail-fast/Foo.hs

@@ -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

@@ -0,0 +1,12 @@
+module SetupBar where
+
+-- $setup
+-- >>> 23
+-- 23
+
+-- | bar
+-- a passing test
+-- >>> bar
+-- 42
+bar :: Int
+bar = 42