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