diff --git a/hspec.cabal b/hspec.cabal --- a/hspec.cabal +++ b/hspec.cabal @@ -1,5 +1,5 @@ name: hspec -version: 1.6.0 +version: 1.6.1 license: MIT license-file: LICENSE copyright: (c) 2011-2013 Simon Hengel, diff --git a/src/Test/Hspec/Config.hs b/src/Test/Hspec/Config.hs --- a/src/Test/Hspec/Config.hs +++ b/src/Test/Hspec/Config.hs @@ -34,11 +34,11 @@ , configColorMode :: ColorMode , configFormatter :: Formatter , configHtmlOutput :: Bool -, configHandle :: Handle +, configHandle :: Either Handle FilePath } defaultConfig :: Config -defaultConfig = Config False False False Nothing QC.stdArgs ColorAuto specdoc False stdout +defaultConfig = Config False False False Nothing QC.stdArgs ColorAuto specdoc False (Left stdout) -- | Add a filter predicate to config. If there is already a filter predicate, -- then combine them with `||`. @@ -65,7 +65,7 @@ , configColorMode = optionsColorMode opts , configFormatter = optionsFormatter opts , configHtmlOutput = optionsHtmlOutput opts - , configHandle = stdout + , configHandle = maybe (configHandle defaultConfig) Right (optionsOutputFile opts) } where qcArgs = maybe id setSeed mSeed args diff --git a/src/Test/Hspec/Core.hs b/src/Test/Hspec/Core.hs --- a/src/Test/Hspec/Core.hs +++ b/src/Test/Hspec/Core.hs @@ -54,7 +54,7 @@ {-# DEPRECATED hHspec "use `Test.Hspec.Runner.hspecWith` instead" #-} -- since 1.4.0 hHspec :: Handle -> [SpecTree] -> IO Summary -hHspec h = hspecWith defaultConfig {configHandle = h} +hHspec h = hspecWith defaultConfig {configHandle = Left h} {-# DEPRECATED Spec "use `SpecTree` instead" #-} -- since 1.4.0 type Spec = SpecTree diff --git a/src/Test/Hspec/Monadic.hs b/src/Test/Hspec/Monadic.hs --- a/src/Test/Hspec/Monadic.hs +++ b/src/Test/Hspec/Monadic.hs @@ -50,4 +50,4 @@ {-# DEPRECATED hHspec "use hspecWith instead" #-} -- since 1.4.0 hHspec :: Handle -> Spec -> IO Summary -hHspec h = hspecWith defaultConfig {configHandle = h} +hHspec h = hspecWith defaultConfig {configHandle = Left h} diff --git a/src/Test/Hspec/Options.hs b/src/Test/Hspec/Options.hs --- a/src/Test/Hspec/Options.hs +++ b/src/Test/Hspec/Options.hs @@ -29,6 +29,7 @@ , optionsColorMode :: ColorMode , optionsFormatter :: Formatter , optionsHtmlOutput :: Bool +, optionsOutputFile :: Maybe FilePath } addMatch :: String -> Options -> Options @@ -44,7 +45,7 @@ deriving (Eq, Show) defaultOptions :: Options -defaultOptions = Options False False False False [] Nothing Nothing ColorAuto specdoc False +defaultOptions = Options False False False False [] Nothing Nothing ColorAuto specdoc False Nothing formatters :: [(String, Formatter)] formatters = [ @@ -85,12 +86,13 @@ , Option [] ["color"] (NoArg setColor) (h "colorize the output") , Option [] ["no-color"] (NoArg setNoColor) (h "do not colorize the output") , mkOption "f" "format" (Arg "FORMATTER" readFormatter setFormatter) formatHelp + , mkOption "o" "out" (Arg "FILE" return setOutputFile) (h "write output to a file instead of STDOUT") , mkOption "a" "qc-max-success" (Arg "N" readMaybe setMaxSuccess) (h "maximum number of successful tests before a QuickCheck property succeeds") , mkOption [] "seed" (Arg "N" readMaybe setSeed) (h "used seed for QuickCheck properties") , Option [] ["print-cpu-time"] (NoArg setPrintCpuTime) (h "include used CPU time in summary") , Option [] ["dry-run"] (NoArg setDryRun) (h "pretend that everything passed; don't verify anything") , Option [] ["fail-fast"] (NoArg setFastFail) (h "abort on first failure") - , Option "r" ["rerun"] (NoArg setRerun) (h "only rerun examples that previously failed") + , Option "r" ["rerun"] (NoArg setRerun) (h "rerun all examples that failed in the previously test run (only works in GHCi)") ] where h = unlines . addLineBreaks @@ -100,6 +102,9 @@ setFormatter :: Formatter -> Options -> Options setFormatter f c = c {optionsFormatter = f} + + setOutputFile :: String -> Options -> Options + setOutputFile file c = c {optionsOutputFile = Just file} setPrintCpuTime x = x >>= \c -> return c {optionsPrintCpuTime = True} setDryRun x = x >>= \c -> return c {optionsDryRun = True} diff --git a/src/Test/Hspec/Runner.hs b/src/Test/Hspec/Runner.hs --- a/src/Test/Hspec/Runner.hs +++ b/src/Test/Hspec/Runner.hs @@ -106,17 +106,16 @@ -- items. If you need this, you have to check the `Summary` yourself and act -- accordingly. hspecWith :: Config -> Spec -> IO Summary -hspecWith c_ spec = do +hspecWith c_ spec = withHandle c_ $ \h -> do c <- ensureStdGen c_ let formatter = configFormatter c - h = configHandle c seed = (stdGenToInteger . fst . fromJust . QC.replay . configQuickCheckArgs) c useColor <- doesUseColor h c withHiddenCursor useColor h $ runFormatM useColor (configHtmlOutput c) (configPrintCpuTime c) seed h $ do - runFormatter useColor c formatter (maybe id filterSpecs (configFilterPredicate c) $ runSpecM spec) `finally_` do + runFormatter useColor h c formatter (maybe id filterSpecs (configFilterPredicate c) $ runSpecM spec) `finally_` do failedFormatter formatter footerFormatter formatter @@ -141,6 +140,11 @@ ColorAuto -> hIsTerminalDevice h ColorNever -> return False ColorAlways -> return True + + withHandle :: Config -> (Handle -> IO a) -> IO a + withHandle c action = case configHandle c of + Left h -> action h + Right path -> withFile path WriteMode action -- | Summary of a test run. data Summary = Summary { diff --git a/src/Test/Hspec/Runner/Eval.hs b/src/Test/Hspec/Runner/Eval.hs --- a/src/Test/Hspec/Runner/Eval.hs +++ b/src/Test/Hspec/Runner/Eval.hs @@ -3,6 +3,7 @@ import Control.Monad import qualified Control.Exception as E import Control.Concurrent +import System.IO (Handle) import Control.Monad.IO.Class (liftIO) @@ -15,18 +16,18 @@ import Data.Time.Clock.POSIX -- | Evaluate all examples of a given spec and produce a report. -runFormatter :: Bool -> Config -> Formatter -> [SpecTree] -> FormatM () -runFormatter useColor c formatter specs = do +runFormatter :: Bool -> Handle -> Config -> Formatter -> [SpecTree] -> FormatM () +runFormatter useColor h c formatter specs = do headerFormatter formatter chan <- liftIO newChan - run chan useColor c formatter specs + run chan useColor h c formatter specs data Message = Done | Run (FormatM ()) data Report = ReportProgress Progress | ReportResult (Either E.SomeException Result) -run :: Chan Message -> Bool -> Config -> Formatter -> [SpecTree] -> FormatM () -run chan useColor c formatter specs = do +run :: Chan Message -> Bool -> Handle -> Config -> Formatter -> [SpecTree] -> FormatM () +run chan useColor h c formatter specs = do liftIO $ do forM_ (zip [0..] specs) (queueSpec []) writeChan chan Done @@ -71,7 +72,7 @@ ReportResult result -> formatResult formatter path result reportProgress :: (Int, Int) -> IO () - reportProgress = exampleProgress formatter (configHandle c) path + reportProgress = exampleProgress formatter h path mkProgressHandler :: (a -> IO ()) -> IO (a -> IO ()) mkProgressHandler report diff --git a/test/Test/Hspec/OptionsSpec.hs b/test/Test/Hspec/OptionsSpec.hs --- a/test/Test/Hspec/OptionsSpec.hs +++ b/test/Test/Hspec/OptionsSpec.hs @@ -24,3 +24,7 @@ context "with --color" $ do it "sets optionsColorMode to ColorAlways" $ do optionsColorMode <$> parseOptions ["--color"] `shouldBe` Right ColorAlways + + context "with --out" $ do + it "sets optionsColorMode to ColorAlways" $ do + optionsOutputFile <$> parseOptions ["--out", "foo"] `shouldBe` Right (Just "foo")