hspec-1.8.1.1/0000755000000000000000000000000012251063642011151 5ustar0000000000000000hspec-1.8.1.1/LICENSE0000644000000000000000000000226112251063642012157 0ustar0000000000000000Copyright (c) 2011-2013 Simon Hengel Copyright (c) 2011-2012 Trystan Spangler Copyright (c) 2011-2011 Greg Weber Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. hspec-1.8.1.1/hspec.cabal0000644000000000000000000001266212251063642013246 0ustar0000000000000000name: hspec version: 1.8.1.1 license: MIT license-file: LICENSE copyright: (c) 2011-2013 Simon Hengel, (c) 2011-2012 Trystan Spangler, (c) 2011 Greg Weber maintainer: Simon Hengel build-type: Simple cabal-version: >= 1.8 category: Testing stability: experimental bug-reports: https://github.com/hspec/hspec/issues homepage: http://hspec.github.io/ synopsis: Behavior-Driven Development for Haskell description: Behavior-Driven Development for Haskell . Hspec is roughly based on the Ruby library RSpec. However, Hspec is just a framework for running HUnit and QuickCheck tests. Compared to other options, it provides a much nicer syntax that makes tests very easy to read. . The Hspec Manual is at . -- find hspec-discover/test-data/ -type f extra-source-files: hspec-discover/test-data/nested-spec/FooSpec.hs hspec-discover/test-data/nested-spec/Foo/Bar/BazSpec.hs hspec-discover/test-data/nested-spec/Foo/BarSpec.hs hspec-discover/test-data/empty-dir/Foo/Bar/Baz/.placeholder source-repository head type: git location: https://github.com/hspec/hspec Library ghc-options: -Wall hs-source-dirs: src build-depends: base == 4.* , random == 1.0.* , setenv , ansi-terminal >= 0.5 , time , transformers >= 0.2.2.0 && < 0.4.0 , deepseq , HUnit >= 1.2.5 , QuickCheck >= 2.5.1 , quickcheck-io , hspec-expectations == 0.5.0.* exposed-modules: Test.Hspec Test.Hspec.Core Test.Hspec.Monadic Test.Hspec.Runner Test.Hspec.Formatters Test.Hspec.HUnit Test.Hspec.QuickCheck other-modules: Test.Hspec.Util Test.Hspec.Compat Test.Hspec.Core.Type Test.Hspec.Core.QuickCheckUtil Test.Hspec.Config Test.Hspec.Options Test.Hspec.FailureReport Test.Hspec.Runner.Eval Test.Hspec.Formatters.Internal Test.Hspec.Timer test-suite spec type: exitcode-stdio-1.0 hs-source-dirs: src, test main-is: Spec.hs other-modules: Mock Helper Test.HspecSpec Test.Hspec.CompatSpec Test.Hspec.Core.TypeSpec Test.Hspec.FailureReportSpec Test.Hspec.FormattersSpec Test.Hspec.HUnitSpec Test.Hspec.OptionsSpec Test.Hspec.QuickCheckSpec Test.Hspec.RunnerSpec Test.Hspec.TimerSpec Test.Hspec.UtilSpec ghc-options: -Wall -Werror build-depends: base == 4.* , random == 1.0.* , setenv , silently >= 1.2.4 , ansi-terminal , time , transformers , deepseq , HUnit , QuickCheck , quickcheck-io , hspec-expectations , hspec-meta >= 1.8.0 , process , ghc-paths test-suite doctests main-is: doctests.hs type: exitcode-stdio-1.0 ghc-options: -Wall -Werror -threaded hs-source-dirs: test build-depends: base == 4.* , doctest >= 0.9.4.1 test-suite example type: exitcode-stdio-1.0 main-is: Spec.hs hs-source-dirs: example ghc-options: -Wall -Werror build-depends: base == 4.* , hspec , QuickCheck -- hspec-discover executable hspec-discover ghc-options: -Wall hs-source-dirs: hspec-discover/src main-is: Main.hs other-modules: Run Config build-depends: base == 4.* , filepath , directory test-suite hspec-discover-spec type: exitcode-stdio-1.0 ghc-options: -Wall -Werror hs-source-dirs: hspec-discover/src , hspec-discover/test main-is: Spec.hs other-modules: RunSpec ConfigSpec build-depends: base == 4.* , filepath , directory , hspec-meta test-suite hspec-discover-example buildable: False type: exitcode-stdio-1.0 ghc-options: -Wall -Werror hs-source-dirs: hspec-discover/example main-is: Spec.hs build-depends: base == 4.* , hspec , QuickCheck test-suite hspec-discover-integration-test-empty buildable: False type: exitcode-stdio-1.0 ghc-options: -Wall -Werror hs-source-dirs: hspec-discover/integration-test/empty main-is: Spec.hs build-depends: base == 4.* , hspec test-suite hspec-discover-integration-test-with-formatter buildable: False type: exitcode-stdio-1.0 ghc-options: -Wall -Werror hs-source-dirs: hspec-discover/integration-test/with-formatter main-is: Spec.hs other-modules: FooSpec build-depends: base == 4.* , hspec test-suite hspec-discover-integration-test-with-io-formatter buildable: False type: exitcode-stdio-1.0 ghc-options: -Wall -Werror hs-source-dirs: hspec-discover/integration-test/with-io-formatter main-is: Spec.hs other-modules: FooSpec Formatter build-depends: base == 4.* , hspec , transformers test-suite hspec-discover-integration-test-with-formatter-empty buildable: False type: exitcode-stdio-1.0 ghc-options: -Wall -Werror hs-source-dirs: hspec-discover/integration-test/with-formatter-empty main-is: Spec.hs build-depends: base == 4.* , hspec hspec-1.8.1.1/Setup.lhs0000644000000000000000000000011412251063642012755 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain hspec-1.8.1.1/test/0000755000000000000000000000000012251063642012130 5ustar0000000000000000hspec-1.8.1.1/test/doctests.hs0000644000000000000000000000031612251063642014314 0ustar0000000000000000module Main where import Test.DocTest main :: IO () main = doctest ["-isrc", "-optP-include", "-optPdist/build/autogen/cabal_macros.h", "src/Test/Hspec/Util.hs", "src/Test/Hspec/Formatters.hs"] hspec-1.8.1.1/test/Spec.hs0000644000000000000000000000006112251063642013353 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-meta-discover #-} hspec-1.8.1.1/test/Helper.hs0000644000000000000000000000474512251063642013715 0ustar0000000000000000module Helper ( module Test.Hspec.Meta , module Test.QuickCheck , module Control.Applicative , module System.IO.Silently , sleep , timeout , defaultParams , captureLines , normalizeSummary , ignoreExitCode , ignoreUserInterrupt , shouldStartWith , shouldEndWith , shouldUseArgs ) where import Data.List import Data.Char import Data.IORef import Control.Monad import Control.Applicative import System.Environment (withArgs) import System.Exit import Control.Concurrent import qualified Control.Exception as E import qualified System.Timeout as System import Data.Time.Clock.POSIX import System.IO.Silently import Test.Hspec.Meta import Test.QuickCheck hiding (Result(..)) import qualified Test.Hspec as H import qualified Test.Hspec.Core as H (Params(..), Item(..), mapSpecItem) import qualified Test.Hspec.Runner as H ignoreExitCode :: IO () -> IO () ignoreExitCode action = action `E.catch` \e -> let _ = e :: ExitCode in return () ignoreUserInterrupt :: IO () -> IO () ignoreUserInterrupt action = action `E.catch` \e -> unless (e == E.UserInterrupt) (E.throwIO e) captureLines :: IO a -> IO [String] captureLines = fmap lines . capture_ shouldStartWith :: (Eq a, Show a) => [a] -> [a] -> Expectation x `shouldStartWith` y = x `shouldSatisfy` isPrefixOf y shouldEndWith :: (Eq a, Show a) => [a] -> [a] -> Expectation x `shouldEndWith` y = x `shouldSatisfy` isSuffixOf y -- replace times in summary with zeroes normalizeSummary :: [String] -> [String] normalizeSummary xs = map f xs where f x | "Finished in " `isPrefixOf` x = map g x | otherwise = x g x | isNumber x = '0' | otherwise = x defaultParams :: H.Params defaultParams = H.Params (H.configQuickCheckArgs H.defaultConfig) (H.configSmallCheckDepth H.defaultConfig) (const $ return ()) sleep :: POSIXTime -> IO () sleep = threadDelay . floor . (* 1000000) timeout :: POSIXTime -> IO a -> IO (Maybe a) timeout = System.timeout . floor . (* 1000000) shouldUseArgs :: [String] -> (Args -> Bool) -> Expectation shouldUseArgs args p = do spy <- newIORef (H.paramsQuickCheckArgs defaultParams) let interceptArgs item = item {H.itemExample = \params action -> writeIORef spy (H.paramsQuickCheckArgs params) >> H.itemExample item params action} spec = H.mapSpecItem interceptArgs $ H.it "foo" False (silence . ignoreExitCode . withArgs args . H.hspec) spec readIORef spy >>= (`shouldSatisfy` p) hspec-1.8.1.1/test/Mock.hs0000644000000000000000000000047112251063642013357 0ustar0000000000000000module Mock where import Control.Applicative import Data.IORef newtype Mock = Mock (IORef Int) newMock :: IO Mock newMock = Mock <$> newIORef 0 mockAction :: Mock -> IO () mockAction (Mock ref) = modifyIORef ref succ mockCounter :: Mock -> IO Int mockCounter (Mock ref) = readIORef ref hspec-1.8.1.1/test/Test/0000755000000000000000000000000012251063642013047 5ustar0000000000000000hspec-1.8.1.1/test/Test/HspecSpec.hs0000644000000000000000000001122312251063642015257 0ustar0000000000000000module Test.HspecSpec (main, spec) where import Helper import Mock import Data.IORef import Data.List (isPrefixOf) import Test.Hspec.Core (SpecTree(..), Item(..), Result(..), runSpecM) import qualified Test.Hspec as H import qualified Test.Hspec.Runner as H (hspecResult) main :: IO () main = hspec spec spec :: Spec spec = do describe "pending" $ do it "specifies a pending example" $ do r <- runSpec $ do H.it "foo" H.pending r `shouldSatisfy` any (== " # PENDING: No reason given") describe "pendingWith" $ do it "specifies a pending example with a reason for why it's pending" $ do r <- runSpec $ do H.it "foo" $ do H.pendingWith "for some reason" r `shouldSatisfy` any (== " # PENDING: for some reason") describe "describe" $ do let testSpec = do H.describe "some subject" $ do H.it "foo" True H.it "bar" True H.it "baz" True it "takes a description of what the behavior is for" $ do r <- runSpec testSpec r `shouldSatisfy` any (== "some subject") it "groups behaviors for what's being described" $ do r <- filter (isPrefixOf " - ") `fmap` runSpec testSpec length r `shouldBe` 3 it "can be nested" $ do let [SpecGroup foo [SpecGroup bar [SpecItem Item {itemRequirement = baz}]]] = runSpecM $ do H.describe "foo" $ do H.describe "bar" $ do H.it "baz" True (foo, bar, baz) `shouldBe` ("foo", "bar", "baz") context "when no description is given" $ do it "uses a default description" $ do let [SpecGroup d _] = runSpecM (H.describe "" (pure ())) d `shouldBe` "(no description given)" describe "it" $ do it "takes a description of a desired behavior" $ do let [SpecItem item] = runSpecM (H.it "whatever" True) itemRequirement item `shouldBe` "whatever" it "takes an example of that behavior" $ do let [SpecItem item] = runSpecM (H.it "whatever" True) itemExample item defaultParams id `shouldReturn` Success context "when no description is given" $ do it "uses a default description" $ do let [SpecItem item] = runSpecM (H.it "" True) itemRequirement item `shouldBe` "(unspecified behavior)" describe "example" $ do it "fixes the type of an expectation" $ do r <- runSpec $ do H.it "foo" $ H.example $ do pure () r `shouldSatisfy` any (== "1 example, 0 failures") describe "parallel" $ do it "marks examples for parallel execution" $ do let [SpecItem item] = runSpecM . H.parallel $ H.it "whatever" True itemIsParallelizable item `shouldBe` True it "is applied recursively" $ do let [SpecGroup _ [SpecGroup _ [SpecItem item]]] = runSpecM . H.parallel $ do H.describe "foo" $ do H.describe "bar" $ do H.it "baz" True itemIsParallelizable item `shouldBe` True describe "before" $ do it "runs an action before each spec item" $ do mock <- newMock silence $ H.hspec $ H.before (mockAction mock) $ do H.it "foo" $ do mockCounter mock `shouldReturn` 1 H.it "bar" $ do mockCounter mock `shouldReturn` 2 mockCounter mock `shouldReturn` 2 context "when used multiple times" $ do it "is evaluated outside in" $ do ref <- newIORef (0 :: Int) let action1 = do readIORef ref `shouldReturn` 0 modifyIORef ref succ action2 = do readIORef ref `shouldReturn` 1 modifyIORef ref succ silence $ H.hspec $ H.before action1 $ H.before action2 $ do H.it "foo" $ do readIORef ref `shouldReturn` 2 describe "after" $ do it "runs an action after each spec item" $ do mock <- newMock silence $ H.hspec $ H.after (mockAction mock) $ do H.it "foo" $ do mockCounter mock `shouldReturn` 0 H.it "bar" $ do mockCounter mock `shouldReturn` 1 mockCounter mock `shouldReturn` 2 describe "around" $ do it "wraps each spec item with an action" $ do ref <- newIORef (0 :: Int) let action :: IO () -> IO () action e = do readIORef ref `shouldReturn` 0 writeIORef ref 1 e readIORef ref `shouldReturn` 2 writeIORef ref 3 silence $ H.hspec $ H.around action $ do H.it "foo" $ do readIORef ref `shouldReturn` 1 writeIORef ref 2 readIORef ref `shouldReturn` 3 where runSpec :: H.Spec -> IO [String] runSpec = captureLines . H.hspecResult hspec-1.8.1.1/test/Test/Hspec/0000755000000000000000000000000012251063642014111 5ustar0000000000000000hspec-1.8.1.1/test/Test/Hspec/CompatSpec.hs0000644000000000000000000000107112251063642016502 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Test.Hspec.CompatSpec (main, spec) where import Helper import Test.Hspec.Compat import Data.Typeable data SomeType = SomeType deriving Typeable main :: IO () main = hspec spec spec :: Spec spec = do describe "showType" $ do it "shows unqualified name of type" $ do showType SomeType `shouldBe` "SomeType" describe "showFullType (currently unused)" $ do it "shows fully qualified name of type" $ do showFullType SomeType `shouldBe` "Test.Hspec.CompatSpec.SomeType" hspec-1.8.1.1/test/Test/Hspec/QuickCheckSpec.hs0000644000000000000000000000077612251063642017304 0ustar0000000000000000module Test.Hspec.QuickCheckSpec (main, spec) where import Helper import qualified Test.Hspec as H import qualified Test.Hspec.Runner as H import qualified Test.Hspec.QuickCheck as H main :: IO () main = hspec spec spec :: Spec spec = do describe "prop" $ do it "is a shortcut to use properties as examples" $ do silence . H.hspecResult $ do H.describe "read" $ do H.prop "is inverse to show" $ \x -> (read . show) x == (x :: Int) `shouldReturn` H.Summary 1 0 hspec-1.8.1.1/test/Test/Hspec/HUnitSpec.hs0000644000000000000000000000562112251063642016313 0ustar0000000000000000module Test.Hspec.HUnitSpec (main, spec) where import Helper import qualified Test.Hspec as H import qualified Test.Hspec.Runner as H import Test.Hspec.Core.Type (SpecTree(..), Item(..), runSpecM) import Test.Hspec.HUnit import Test.HUnit main :: IO () main = hspec spec -- SpecTree does not have an Eq nor a Show instance, hence we map it to `Tree`. data Tree = Group String [Tree] | Example String deriving (Eq, Show) shouldYield :: Test -> [Tree] -> Expectation a `shouldYield` b = (convert . runSpecM . fromHUnitTest) a `shouldBe` b where convert :: [SpecTree] -> [Tree] convert = map go where go :: SpecTree -> Tree go x = case x of SpecGroup s xs -> Group s (map go xs) SpecItem item -> Example (itemRequirement item) spec :: Spec spec = do describe "fromHUnitTest" $ do let e = TestCase $ pure () it "works for a TestCase" $ do e `shouldYield` [Example ""] it "works for a labeled TestCase" $ do TestLabel "foo" e `shouldYield` [Example "foo"] it "works for a TestCase with nested labels" $ do (TestLabel "foo" . TestLabel "bar") e `shouldYield` [Group "foo" [Example "bar"]] it "works for a flat TestList" $ do TestList [e, e, e] `shouldYield` [Example "", Example "", Example ""] it "works for a nested TestList" $ do (TestLabel "foo" . TestLabel "bar" . TestList) [TestLabel "one" e, TestLabel "two" e, TestLabel "three" e] `shouldYield` [Group "foo" [Group "bar" [Example "one", Example "two", Example "three"]]] describe "HUnit TestCase as an example (deprecated!)" $ do it "is specified with the HUnit `TestCase` data constructor" $ TestCase $ do silence . H.hspecResult $ do H.it "some behavior" (TestCase $ "foo" @?= "bar") H.it "some behavior" (TestCase $ "foo" @?= "foo") `shouldReturn` H.Summary 2 1 it "is the assumed example for IO() actions" $ do silence . H.hspecResult $ do H.it "some behavior" ("foo" @?= "bar") H.it "some behavior" ("foo" @?= "foo") `shouldReturn` H.Summary 2 1 it "will show the failed assertion text if available (e.g. assertBool)" $ do let assertionText = "some assertion text" r <- captureLines . H.hspecResult $ do H.describe "foo" $ do H.it "bar" (assertFailure assertionText) r `shouldSatisfy` any (== assertionText) it "will show the failed assertion expected and actual values if available (e.g. assertEqual)" $ do r <- captureLines . H.hspecResult $ do H.describe "foo" $ do H.it "bar" (assertEqual "trivial" (1::Int) 2) assertBool "should find assertion text" $ any (=="trivial") r assertBool "should find 'expected: 1'" $ any (=="expected: 1") r assertBool "should find ' but got: 2'" $ any (==" but got: 2") r hspec-1.8.1.1/test/Test/Hspec/FailureReportSpec.hs0000644000000000000000000000256112251063642020047 0ustar0000000000000000module Test.Hspec.FailureReportSpec (main, spec) where import Helper import System.IO import Test.Hspec.FailureReport import GHC.Paths (ghc) import System.Process import System.Exit main :: IO () main = hspec spec spec :: Spec spec = do describe "writeFailureReport" $ do it "prints a warning on unexpected exceptions" $ do r <- hCapture_ [stderr] $ writeFailureReport (error "some error") r `shouldBe` "WARNING: Could not write environment variable HSPEC_FAILURES (some error)\n" -- GHCi needs to keep the environment on :reload, so that we can store -- failures there. Otherwise --rerun would not be very useful. So we add a -- test for that. describe "GHCi" $ do it "keeps environment variables on :reload" $ do let flags = ["-v0", "--interactive", "-ignore-dot-ghci"] (Just hIn, Just hOut, Nothing, processHandle) <- createProcess $ (proc ghc flags) { std_in = CreatePipe , std_out = CreatePipe } hPutStrLn hIn "import System.SetEnv" hPutStrLn hIn "setEnv \"FOO\" \"bar\"" hPutStrLn hIn ":reload" hPutStrLn hIn "import System.Environment" hPutStrLn hIn "getEnv \"FOO\"" hClose hIn r <- hGetContents hOut length r `seq` r `shouldBe` "\"bar\"\n" waitForProcess processHandle `shouldReturn` ExitSuccess hspec-1.8.1.1/test/Test/Hspec/FormattersSpec.hs0000644000000000000000000001616612251063642017420 0ustar0000000000000000{-# LANGUAGE CPP #-} module Test.Hspec.FormattersSpec (main, spec) where import Helper import qualified Test.Hspec as H import qualified Test.Hspec.Core as H (Result(..)) import qualified Test.Hspec.Runner as H import qualified Test.Hspec.Formatters as H #ifndef mingw32_HOST_OS import System.Console.ANSI #endif main :: IO () main = hspec spec testSpec :: H.Spec testSpec = do H.describe "Example" $ do H.it "success" (H.Success) H.it "fail 1" (H.Fail "fail message") H.it "pending" (H.pendingWith "pending message") H.it "fail 2" (H.Fail "") H.it "exceptions" (undefined :: H.Result) H.it "fail 3" (H.Fail "") spec :: Spec spec = do describe "silent" $ do let runSpec = fmap fst . capture . H.hspecWith H.defaultConfig {H.configFormatter = H.silent} it "produces no output" $ do runSpec testSpec `shouldReturn` "" describe "failed_examples" $ do failed_examplesSpec H.failed_examples describe "progress" $ do let runSpec = captureLines . H.hspecWith H.defaultConfig {H.configFormatter = H.progress} it "produces '..F...FF.F' style output" $ do r <- runSpec testSpec head r `shouldBe` ".F.FFF" context "same as failed_examples" $ do failed_examplesSpec H.progress describe "specdoc" $ do let runSpec = captureLines . H.hspecWith H.defaultConfig {H.configFormatter = H.specdoc} it "displays a header for each thing being described" $ do _:x:_ <- runSpec testSpec x `shouldBe` "Example" it "displays one row for each behavior" $ do r <- runSpec $ do H.describe "List as a Monoid" $ do H.describe "mappend" $ do H.it "is associative" True H.describe "mempty" $ do H.it "is a left identity" True H.it "is a right identity" True H.describe "Maybe as a Monoid" $ do H.describe "mappend" $ do H.it "is associative" True H.describe "mempty" $ do H.it "is a left identity" True H.it "is a right identity" True normalizeSummary r `shouldBe` [ "" , "List as a Monoid" , " mappend" , " - is associative" , "" , " mempty" , " - is a left identity" , " - is a right identity" , "" , "Maybe as a Monoid" , " mappend" , " - is associative" , "" , " mempty" , " - is a left identity" , " - is a right identity" , "" , "Finished in 0.0000 seconds" , "6 examples, 0 failures" ] it "prints an empty line before each group" $ do r <- runSpec $ do H.describe "foo" $ do H.it "example 1" True H.it "example 2" True H.describe "bar" $ do H.it "example 3" True H.it "example 4" True normalizeSummary r `shouldBe` [ "" , "foo" , " - example 1" , " - example 2" , "" , " bar" , " - example 3" , " - example 4" , "" , "Finished in 0.0000 seconds" , "4 examples, 0 failures" ] it "prints an empty line after each group" $ do r <- runSpec $ do H.describe "foo" $ do H.describe "bar" $ do H.it "example 1" True H.it "example 2" True H.it "example 3" True H.it "example 4" True normalizeSummary r `shouldBe` [ "" , "foo" , " bar" , " - example 1" , " - example 2" , "" , " - example 3" , " - example 4" , "" , "Finished in 0.0000 seconds" , "4 examples, 0 failures" ] it "outputs an empty line at the beginning (even for non-nested specs)" $ do r <- runSpec $ do H.it "example 1" True H.it "example 2" True normalizeSummary r `shouldBe` [ "" , "- example 1" , "- example 2" , "" , "Finished in 0.0000 seconds" , "2 examples, 0 failures" ] it "displays a row for each successfull, failed, or pending example" $ do r <- runSpec testSpec r `shouldSatisfy` any (== " - fail 1 FAILED [1]") r `shouldSatisfy` any (== " - success") it "displays a '#' with an additional message for pending examples" $ do r <- runSpec testSpec r `shouldSatisfy` any (== " # PENDING: pending message") context "same as failed_examples" $ do failed_examplesSpec H.progress failed_examplesSpec :: H.Formatter -> Spec failed_examplesSpec formatter = do let runSpec = captureLines . H.hspecWith H.defaultConfig {H.configFormatter = formatter} it "summarizes the time it takes to finish" $ do r <- runSpec (return ()) normalizeSummary r `shouldSatisfy` any (== "Finished in 0.0000 seconds") context "displays a detailed list of failures" $ do it "prints all requirements that are not met" $ do r <- runSpec testSpec r `shouldSatisfy` any (== "1) Example fail 1") it "prints the exception type for requirements that fail due to an uncaught exception" $ do r <- runSpec $ do H.it "foobar" (undefined :: Bool) r `shouldContain` [ "1) foobar" , "uncaught exception: ErrorCall (Prelude.undefined)" ] it "prints all descriptions when a nested requirement fails" $ do r <- runSpec $ H.describe "foo" $ do H.describe "bar" $ do H.it "baz" False r `shouldSatisfy` any (== "1) foo.bar baz") it "summarizes the number of examples and failures" $ do r <- runSpec testSpec r `shouldSatisfy` any (== "6 examples, 4 failures, 1 pending") -- Windows has no support for ANSI escape codes. The Console API is used for -- colorized output, hence the following tests do not work on Windows. #ifndef mingw32_HOST_OS it "shows summary in green if there are no failures" $ do r <- captureLines $ H.hspecWith H.defaultConfig {H.configColorMode = H.ColorAlways} $ do H.it "foobar" True r `shouldSatisfy` any (== (green ++ "1 example, 0 failures" ++ reset)) it "shows summary in yellow if there are pending examples" $ do r <- captureLines $ H.hspecWith H.defaultConfig {H.configColorMode = H.ColorAlways} $ do H.it "foobar" H.pending r `shouldSatisfy` any (== (yellow ++ "1 example, 0 failures, 1 pending" ++ reset)) it "shows summary in red if there are failures" $ do r <- captureLines $ H.hspecWith H.defaultConfig {H.configColorMode = H.ColorAlways} $ do H.it "foobar" False r `shouldSatisfy` any (== (red ++ "1 example, 1 failure" ++ reset)) it "shows summary in red if there are both failures and pending examples" $ do r <- captureLines $ H.hspecWith H.defaultConfig {H.configColorMode = H.ColorAlways} $ do H.it "foo" False H.it "bar" H.pending r `shouldSatisfy` any (== (red ++ "2 examples, 1 failure, 1 pending" ++ reset)) where green = setSGRCode [SetColor Foreground Dull Green] yellow = setSGRCode [SetColor Foreground Dull Yellow] red = setSGRCode [SetColor Foreground Dull Red] reset = setSGRCode [Reset] #endif hspec-1.8.1.1/test/Test/Hspec/RunnerSpec.hs0000644000000000000000000003370412251063642016540 0ustar0000000000000000module Test.Hspec.RunnerSpec (main, spec) where import Helper import System.IO (stderr) import Control.Monad import System.Environment (withArgs, withProgName, getArgs) import System.Exit import qualified Control.Exception as E import Mock import System.SetEnv import Test.Hspec.Util (getEnv) import Test.Hspec.FailureReport (FailureReport(..)) import qualified Test.Hspec as H import qualified Test.Hspec.Runner as H import qualified Test.Hspec.Core as H (Result(..)) import qualified Test.Hspec.Formatters as H (silent) import qualified Test.QuickCheck as QC main :: IO () main = hspec spec quickCheckOptions :: [([Char], Args -> Int)] quickCheckOptions = [("--qc-max-success", QC.maxSuccess), ("--qc-max-size", QC.maxSize), ("--qc-max-discard", QC.maxDiscardRatio)] spec :: Spec spec = do describe "hspec" $ do it "runs a spec" $ do silence . H.hspec $ do H.it "foobar" True `shouldReturn` () it "exits with exitFailure if not all examples pass" $ do silence . H.hspec $ do H.it "foobar" False `shouldThrow` (== ExitFailure 1) it "allows output to stdout" $ do r <- captureLines . H.hspec $ do H.it "foobar" $ do putStrLn "baz" r `shouldSatisfy` elem "baz" it "prints an error message on unrecognized command-line options" $ do withProgName "myspec" . withArgs ["--foo"] $ do hSilence [stderr] (H.hspec $ pure ()) `shouldThrow` (== ExitFailure 1) fst `fmap` hCapture [stderr] (ignoreExitCode (H.hspec $ pure ())) `shouldReturn` unlines [ "myspec: unrecognized option `--foo'" , "Try `myspec --help' for more information." ] it "stores a failure report in the environment" $ do silence . ignoreExitCode . withArgs ["--seed", "23"] . H.hspec $ do H.describe "foo" $ do H.describe "bar" $ do H.it "example 1" True H.it "example 2" False H.describe "baz" $ do H.it "example 3" False getEnv "HSPEC_FAILURES" `shouldReturn` (Just . show) FailureReport { failureReportSeed = 23 , failureReportMaxSuccess = 100 , failureReportMaxSize = 100 , failureReportMaxDiscardRatio = 10 , failureReportPaths = [ (["foo", "bar"], "example 2") , (["baz"], "example 3") ] } describe "with --rerun" $ do let runSpec = (captureLines . ignoreExitCode . H.hspec) $ do H.it "example 1" True H.it "example 2" False H.it "example 3" False H.it "example 4" True H.it "example 5" False it "reruns examples that previously failed" $ do r0 <- runSpec r0 `shouldSatisfy` elem "5 examples, 3 failures" r1 <- withArgs ["--rerun"] runSpec r1 `shouldSatisfy` elem "3 examples, 3 failures" it "reuses the same seed" $ do let runSpec_ = (captureLines . ignoreExitCode . H.hspec) $ do H.it "foo" $ property $ (/= (26 :: Integer)) r0 <- withArgs ["--seed", "2413421499272008081"] runSpec_ r0 `shouldContain` [ "Falsifiable (after 66 tests): " , "26" ] r1 <- withArgs ["-r"] runSpec_ r1 `shouldContain` [ "Falsifiable (after 66 tests): " , "26" ] forM_ quickCheckOptions $ \(flag, accessor) -> do it ("reuses same " ++ flag) $ do [flag, "23"] `shouldUseArgs` ((== 23) . accessor) ["--rerun"] `shouldUseArgs` ((== 23) . accessor) context "when there is no failure report in the environment" $ do it "runs everything" $ do unsetEnv "HSPEC_FAILURES" r <- hSilence [stderr] $ withArgs ["-r"] runSpec r `shouldSatisfy` elem "5 examples, 3 failures" it "prints a warning to stderr" $ do unsetEnv "HSPEC_FAILURES" r <- hCapture_ [stderr] $ withArgs ["-r"] runSpec r `shouldBe` "WARNING: Could not read environment variable HSPEC_FAILURES; `--rerun' is ignored!\n" context "when parsing of failure report fails" $ do it "runs everything" $ do setEnv "HSPEC_FAILURES" "some invalid report" r <- hSilence [stderr] $ withArgs ["-r"] runSpec r `shouldSatisfy` elem "5 examples, 3 failures" it "prints a warning to stderr" $ do setEnv "HSPEC_FAILURES" "some invalid report" r <- hCapture_ [stderr] $ withArgs ["-r"] runSpec r `shouldBe` "WARNING: Could not read environment variable HSPEC_FAILURES; `--rerun' is ignored!\n" it "does not leak command-line flags to examples" $ do silence . withArgs ["--verbose"] $ do H.hspec $ do H.it "foobar" $ do getArgs `shouldReturn` [] `shouldReturn` () context "when interrupted with ctrl-c" $ do it "prints summary immediately" $ do r <- captureLines . ignoreUserInterrupt . withArgs ["--seed", "23"] . H.hspec $ do H.it "foo" False H.it "bar" $ do E.throwIO E.UserInterrupt :: IO () H.it "baz" True normalizeSummary r `shouldBe` [ "" , "- foo FAILED [1]" , "" , "1) foo" , "" , "Randomized with seed 23" , "" ] it "throws UserInterrupt" $ do silence . H.hspec $ do H.it "foo" $ do E.throwIO E.UserInterrupt :: IO () `shouldThrow` (== E.UserInterrupt) context "with --help" $ do let printHelp = withProgName "spec" . withArgs ["--help"] . H.hspec $ pure () it "prints help" $ do r <- (captureLines . ignoreExitCode) printHelp r `shouldStartWith` ["Usage: spec [OPTION]..."] silence printHelp `shouldThrow` (== ExitSuccess) it "constrains lines to 80 characters" $ do r <- (captureLines . ignoreExitCode) printHelp r `shouldSatisfy` all ((<= 80) . length) r `shouldSatisfy` any ((78 <=) . length) context "with --dry-run" $ do it "produces a report" $ do r <- captureLines . withArgs ["--dry-run"] . H.hspec $ do H.it "foo" True H.it "bar" True normalizeSummary r `shouldBe` [ "" , "- foo" , "- bar" , "" , "Finished in 0.0000 seconds" , "2 examples, 0 failures" ] it "does not verify anything" $ do e <- newMock _ <- captureLines . withArgs ["--dry-run"] . H.hspec $ do H.it "foo" (mockAction e) H.it "bar" False mockCounter e `shouldReturn` 0 context "with --fail-fast" $ do it "stops after first failure" $ do r <- captureLines . ignoreExitCode . withArgs ["--fail-fast", "--seed", "23"] . H.hspec $ do H.it "foo" True H.it "bar" False H.it "baz" False normalizeSummary r `shouldBe` [ "" , "- foo" , "- bar FAILED [1]" , "" , "1) bar" , "" , "Randomized with seed 23" , "" , "Finished in 0.0000 seconds" , "2 examples, 1 failure" ] it "works for nested specs" $ do r <- captureLines . ignoreExitCode . withArgs ["--fail-fast", "--seed", "23"] . H.hspec $ do H.describe "foo" $ do H.it "bar" False H.it "baz" True normalizeSummary r `shouldBe` [ "" , "foo" , " - bar FAILED [1]" , "" , "1) foo bar" , "" , "Randomized with seed 23" , "" , "Finished in 0.0000 seconds" , "1 example, 1 failure" ] context "with --match" $ do it "only runs examples that match a given pattern" $ do e1 <- newMock e2 <- newMock e3 <- newMock silence . withArgs ["-m", "/bar/example"] . H.hspec $ do H.describe "foo" $ do H.describe "bar" $ do H.it "example 1" $ mockAction e1 H.it "example 2" $ mockAction e2 H.describe "baz" $ do H.it "example 3" $ mockAction e3 (,,) <$> mockCounter e1 <*> mockCounter e2 <*> mockCounter e3 `shouldReturn` (1, 1, 0) it "can be given multiple times" $ do e1 <- newMock e2 <- newMock e3 <- newMock silence . withArgs ["-m", "foo", "-m", "baz"] . H.hspec $ do H.describe "foo" $ do H.it "example 1" $ mockAction e1 H.describe "bar" $ do H.it "example 2" $ mockAction e2 H.describe "baz" $ do H.it "example 3" $ mockAction e3 (,,) <$> mockCounter e1 <*> mockCounter e2 <*> mockCounter e3 `shouldReturn` (1, 0, 1) context "with --format" $ do it "uses specified formatter" $ do r <- capture_ . ignoreExitCode . withArgs ["--format", "progress"] . H.hspec $ do H.it "foo" True H.it "bar" True H.it "baz" False H.it "qux" True r `shouldContain` "..F." context "when given an invalid argument" $ do it "prints an error message to stderr" $ do r <- hCapture_ [stderr] . ignoreExitCode . withArgs ["--format", "foo"] . H.hspec $ do H.it "foo" True r `shouldContain` "invalid argument `foo' for `--format'" context "with --qc-max-success" $ do it "tries QuickCheck properties specified number of times" $ do m <- newMock silence . withArgs ["--qc-max-success", "23"] . H.hspec $ do H.it "foo" $ property $ do mockAction m mockCounter m `shouldReturn` 23 context "when run with --rerun" $ do it "takes precedence" $ do ["--qc-max-success", "23"] `shouldUseArgs` ((== 23) . QC.maxSuccess) ["--rerun", "--qc-max-success", "42"] `shouldUseArgs` ((== 42) . QC.maxSuccess) context "with --qc-max-size" $ do it "passes specified size to QuickCheck properties" $ do ["--qc-max-size", "23"] `shouldUseArgs` ((== 23) . QC.maxSize) context "with --qc-max-discard" $ do it "uses specified discard ratio to QuickCheck properties" $ do ["--qc-max-discard", "23"] `shouldUseArgs` ((== 23) . QC.maxDiscardRatio) context "with --seed" $ do it "uses specified seed" $ do r <- captureLines . ignoreExitCode . withArgs ["--seed", "2413421499272008081"] . H.hspec $ do H.it "foo" $ property (/= (26 :: Integer)) r `shouldContain` [ "Falsifiable (after 66 tests): " , "26" ] context "when run with --rerun" $ do it "takes precedence" $ do let runSpec args = capture_ . ignoreExitCode . withArgs args . H.hspec $ do H.it "foo" $ property $ \n -> ((17 + 31 * n) `mod` 50) /= (23 :: Integer) r0 <- runSpec ["--seed", "23"] r0 `shouldContain` "(after 88 tests)" r1 <- runSpec ["--seed", "42"] r1 `shouldContain` "(after 48 tests)" r2 <- runSpec ["--rerun", "--seed", "23"] r2 `shouldContain` "(after 88 tests)" context "when given an invalid argument" $ do let run = withArgs ["--seed", "foo"] . H.hspec $ do H.it "foo" True it "prints an error message to stderr" $ do r <- hCapture_ [stderr] (ignoreExitCode run) r `shouldContain` "invalid argument `foo' for `--seed'" it "exits with exitFailure" $ do hSilence [stderr] run `shouldThrow` (== ExitFailure 1) context "with --print-cpu-time" $ do it "includes used CPU time in summary" $ do r <- capture_ $ withArgs ["--print-cpu-time"] (H.hspec $ pure ()) (normalizeSummary . lines) r `shouldContain` ["Finished in 0.0000 seconds, used 0.0000 seconds of CPU time"] context "with --html" $ do it "produces HTML output" $ do r <- capture_ . withArgs ["--html"] . H.hspec $ do H.it "foo" True r `shouldContain` "" it "marks successful examples with CSS class hspec-success" $ do r <- capture_ . withArgs ["--html"] . H.hspec $ do H.it "foo" True r `shouldContain` "- foo\n" it "marks pending examples with CSS class hspec-pending" $ do r <- capture_ . withArgs ["--html"] . H.hspec $ do H.it "foo" H.pending r `shouldContain` "- foo" it "marks failed examples with CSS class hspec-failure" $ do r <- capture_ . ignoreExitCode . withArgs ["--html"] . H.hspec $ do H.it "foo" False r `shouldContain` "- foo" describe "hspecResult" $ do it "returns a summary of the test run" $ do silence . H.hspecResult $ do H.it "foo" True H.it "foo" False H.it "foo" False H.it "foo" True H.it "foo" True `shouldReturn` H.Summary 5 2 it "treats uncaught exceptions as failure" $ do silence . H.hspecResult $ do H.it "foobar" (E.throwIO (E.ErrorCall "foobar") >> pure ()) `shouldReturn` H.Summary 1 1 it "uses the specdoc formatter by default" $ do _:r:_ <- captureLines . H.hspecResult $ do H.describe "Foo.Bar" $ do H.it "some example" True r `shouldBe` "Foo.Bar" it "can use a custom formatter" $ do r <- capture_ . H.hspecWith H.defaultConfig {H.configFormatter = H.silent} $ do H.describe "Foo.Bar" $ do H.it "some example" True r `shouldBe` "" it "does not let escape error thunks from failure messages" $ do r <- silence . H.hspecResult $ do H.it "some example" (H.Fail $ "foobar" ++ undefined) r `shouldBe` H.Summary 1 1 it "runs specs in parallel" $ do let n = 10 t = 0.01 dt = t * (fromIntegral n / 2) r <- timeout dt . silence . H.hspecResult . H.parallel $ do replicateM_ n (H.it "foo" $ sleep t) r `shouldBe` Just (H.Summary n 0) hspec-1.8.1.1/test/Test/Hspec/TimerSpec.hs0000644000000000000000000000114412251063642016340 0ustar0000000000000000module Test.Hspec.TimerSpec (main, spec) where import Helper import Test.Hspec.Timer main :: IO () main = hspec spec spec :: Spec spec = do describe "timer action returned by newTimer" $ do let dt = 0.01 it "returns False" $ do timer <- newTimer dt timer `shouldReturn` False context "after specified time" $ do it "returns True" $ do timer <- newTimer dt sleep dt timer `shouldReturn` True timer `shouldReturn` False sleep dt sleep dt timer `shouldReturn` True timer `shouldReturn` False hspec-1.8.1.1/test/Test/Hspec/UtilSpec.hs0000644000000000000000000001065312251063642016202 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} module Test.Hspec.UtilSpec (main, spec) where import Helper import Data.Int (Int32) import System.Random (StdGen) import qualified Control.Exception as E import System.SetEnv import Test.Hspec.Util main :: IO () main = hspec spec spec :: Spec spec = do describe "pluralize" $ do it "returns an amount and a word given an amount and word" $ do pluralize 1 "thing" `shouldBe` "1 thing" it "returns a singular word given the number 1" $ do pluralize 1 "thing" `shouldBe` "1 thing" it "returns a plural word given a number greater than 1" $ do pluralize 2 "thing" `shouldBe` "2 things" it "returns a plural word given the number 0" $ do pluralize 0 "thing" `shouldBe` "0 things" describe "lineBreaksAt" $ do it "inserts line breaks at word boundaries" $ do lineBreaksAt 20 "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod" `shouldBe` [ "Lorem ipsum dolor" , "sit amet," , "consectetur" , "adipisicing elit," , "sed do eiusmod" ] describe "safeTry" $ do it "returns Right on success" $ do Right e <- safeTry (return 23 :: IO Int) e `shouldBe` 23 it "returns Left on exception" $ do Left e <- safeTry (E.throwIO E.DivideByZero :: IO Int) show e `shouldBe` "divide by zero" it "evaluates result to weak head normal form" $ do Left e <- safeTry (return undefined) show e `shouldBe` "Prelude.undefined" it "re-throws AsyncException" $ do safeTry (E.throwIO E.UserInterrupt :: IO Int) `shouldThrow` (== E.UserInterrupt) describe "filterPredicate" $ do it "tries to match a pattern against a path" $ do let p = filterPredicate "foo/bar/example 1" p (["foo", "bar"], "example 1") `shouldBe` True p (["foo", "bar"], "example 2") `shouldBe` False it "is ambiguous" $ do let p = filterPredicate "foo/bar/baz" p (["foo", "bar"], "baz") `shouldBe` True p (["foo"], "bar/baz") `shouldBe` True it "succeeds on a partial match" $ do let p = filterPredicate "bar/baz" p (["foo", "bar", "baz"], "example 1") `shouldBe` True it "succeeds with a pattern that matches the message give in the failure list" $ do let p = filterPredicate "ModuleA.ModuleB.foo does something" p (["ModuleA", "ModuleB", "foo"], "does something") `shouldBe` True describe "formatRequirement" $ do it "creates a sentence from a subject and a requirement" $ do formatRequirement (["reverse"], "reverses a list") `shouldBe` "reverse reverses a list" it "creates a sentence from a subject and a requirement when the subject consits of multiple words" $ do formatRequirement (["The reverse function"], "reverses a list") `shouldBe` "The reverse function reverses a list" it "returns the requirement if no subject is given" $ do formatRequirement ([], "reverses a list") `shouldBe` "reverses a list" it "inserts context separated by commas" $ do formatRequirement (["reverse", "when applied twice"], "reverses a list") `shouldBe` "reverse, when applied twice, reverses a list" it "joins components of a subject with a dot" $ do formatRequirement (["Data", "List", "reverse"], "reverses a list") `shouldBe` "Data.List.reverse reverses a list" it "properly handles context after a subject that consists of several components" $ do formatRequirement (["Data", "List", "reverse", "when applied twice"], "reverses a list") `shouldBe` "Data.List.reverse, when applied twice, reverses a list" describe "getEnv" $ do it "returns value of specified environment variable" $ do setEnv "FOO" "bar" getEnv "FOO" `shouldReturn` Just "bar" it "returns Nothing if specified environment variable is not set" $ do unsetEnv "FOO" getEnv "FOO" `shouldReturn` Nothing describe "stdGenToInteger" $ do it "is inverse to stdGenFromInteger" $ property $ \(NonNegative i) -> (stdGenToInteger . stdGenFromInteger) i `shouldBe` i describe "stdGenFromInteger" $ do it "is inverse to stdGenToInteger" $ property $ \stdGen -> (stdGenFromInteger . stdGenToInteger) stdGen `shouldBe` stdGen instance Eq StdGen where a == b = show a == show b instance Arbitrary StdGen where arbitrary = do (Positive a, Positive b) <- arbitrary return $ read (show (a :: Int32) ++ " " ++ show (b :: Int32)) hspec-1.8.1.1/test/Test/Hspec/OptionsSpec.hs0000644000000000000000000000306012251063642016712 0ustar0000000000000000module Test.Hspec.OptionsSpec (main, spec) where import Helper import System.Exit import Test.Hspec.Options hiding (parseOptions) import qualified Test.Hspec.Options as Options main :: IO () main = hspec spec fromLeft :: Either a b -> a fromLeft (Left a) = a fromLeft _ = error "fromLeft: No left value!" spec :: Spec spec = do describe "parseOptions" $ do let parseOptions = Options.parseOptions defaultOptions "my-spec" it "sets optionsColorMode to ColorAuto" $ do optionsColorMode <$> parseOptions [] `shouldBe` Right ColorAuto context "with --no-color" $ do it "sets optionsColorMode to ColorNever" $ do optionsColorMode <$> parseOptions ["--no-color"] `shouldBe` Right ColorNever context "with --color" $ do it "sets optionsColorMode to ColorAlways" $ do optionsColorMode <$> parseOptions ["--color"] `shouldBe` Right ColorAlways context "with --out" $ do it "sets optionsOutputFile" $ do optionsOutputFile <$> parseOptions ["--out", "foo"] `shouldBe` Right (Just "foo") context "with --qc-max-success" $ do context "when given an invalid argument" $ do it "returns an error message" $ do fromLeft (parseOptions ["--qc-max-success", "foo"]) `shouldBe` (ExitFailure 1, "my-spec: invalid argument `foo' for `--qc-max-success'\nTry `my-spec --help' for more information.\n") context "with --depth" $ do it "sets depth parameter for SmallCheck" $ do optionsDepth <$> parseOptions ["--depth", "23"] `shouldBe` Right (Just 23) hspec-1.8.1.1/test/Test/Hspec/Core/0000755000000000000000000000000012251063642015001 5ustar0000000000000000hspec-1.8.1.1/test/Test/Hspec/Core/TypeSpec.hs0000644000000000000000000001212212251063642017067 0ustar0000000000000000module Test.Hspec.Core.TypeSpec (main, spec) where import Helper import Mock import Data.List import Data.IORef import Control.Exception (AsyncException(..), throwIO) import qualified Test.Hspec.Core.Type as H hiding (describe, it) import qualified Test.Hspec as H import qualified Test.Hspec.Runner as H main :: IO () main = hspec spec evaluateExample :: H.Example e => e -> IO H.Result evaluateExample e = H.evaluateExample e (defaultParams {H.paramsQuickCheckArgs = (H.paramsQuickCheckArgs defaultParams) {replay = Just (read "", 0)}}) id evaluateExampleWith :: H.Example e => (IO () -> IO ()) -> e -> IO H.Result evaluateExampleWith action e = H.evaluateExample e (defaultParams {H.paramsQuickCheckArgs = (H.paramsQuickCheckArgs defaultParams) {replay = Just (read "", 0)}}) action spec :: Spec spec = do describe "evaluateExample" $ do context "for Bool" $ do it "returns Success on True" $ do evaluateExample True `shouldReturn` H.Success it "returns Fail on False" $ do evaluateExample False `shouldReturn` H.Fail "" it "propagates exceptions" $ do evaluateExample (error "foobar" :: Bool) `shouldThrow` errorCall "foobar" context "for Expectation" $ do it "returns Success if all expectations hold" $ do evaluateExample (23 `shouldBe` (23 :: Int)) `shouldReturn` H.Success it "returns Fail if an expectation does not hold" $ do evaluateExample (23 `shouldBe` (42 :: Int)) `shouldReturn` H.Fail "expected: 42\n but got: 23" it "propagates exceptions" $ do evaluateExample (error "foobar" :: Expectation) `shouldThrow` errorCall "foobar" it "runs provided action around expectation" $ do ref <- newIORef (0 :: Int) let action :: IO () -> IO () action e = do n <- readIORef ref e readIORef ref `shouldReturn` succ n modifyIORef ref succ evaluateExampleWith action (modifyIORef ref succ) `shouldReturn` H.Success readIORef ref `shouldReturn` 2 context "when used with `pending`" $ do it "returns Pending" $ do evaluateExample (H.pending) `shouldReturn` H.Pending Nothing context "when used with `pendingWith`" $ do it "includes the optional reason" $ do evaluateExample (H.pendingWith "foo") `shouldReturn` H.Pending (Just "foo") context "for Property" $ do it "returns Success if property holds" $ do evaluateExample (property $ \n -> n == (n :: Int)) `shouldReturn` H.Success it "returns Fail if property does not hold" $ do H.Fail _ <- evaluateExample $ property $ \n -> n /= (n :: Int) return () it "shows what falsified it" $ do H.Fail r <- evaluateExample $ property $ \x y -> x + y == (x * y :: Int) r `shouldBe` intercalate "\n" [ "Falsifiable (after 1 test and 2 shrinks): " , "0" , "1" ] it "runs provided action around each single check of the property" $ do ref <- newIORef (0 :: Int) let action :: IO () -> IO () action e = do n <- readIORef ref e readIORef ref `shouldReturn` succ n modifyIORef ref succ H.Success <- evaluateExampleWith action (property $ modifyIORef ref succ) readIORef ref `shouldReturn` 200 context "when used with shouldBe" $ do it "shows what falsified it" $ do H.Fail r <- evaluateExample $ property $ \x y -> x + y `shouldBe` (x * y :: Int) r `shouldBe` intercalate "\n" [ "Falsifiable (after 1 test and 2 shrinks): " , "expected: 0" , " but got: 1" , "0" , "1" ] it "propagates UserInterrupt" $ do let p = property (throwIO UserInterrupt :: Expectation) evaluateExample p `shouldThrow` (== UserInterrupt) it "propagates exceptions" $ do pendingWith "this probably needs a patch to QuickCheck" -- evaluateExample (property $ (error "foobar" :: Int -> Bool)) `shouldThrow` errorCall "foobar" context "when used with `pending`" $ do it "returns Pending" $ do evaluateExample (property H.pending) `shouldReturn` H.Pending Nothing context "when used with `pendingWith`" $ do it "includes the optional reason" $ do evaluateExample (property $ H.pendingWith "foo") `shouldReturn` H.Pending (Just "foo") describe "Expectation" $ do context "as a QuickCheck property" $ do it "can be quantified" $ do e <- newMock silence . H.hspec $ do H.it "some behavior" $ property $ \xs -> do mockAction e (reverse . reverse) xs `shouldBe` (xs :: [Int]) mockCounter e `shouldReturn` 100 it "can be used with expectations/HUnit assertions" $ do silence . H.hspecResult $ do H.describe "readIO" $ do H.it "is inverse to show" $ property $ \x -> do (readIO . show) x `shouldReturn` (x :: Int) `shouldReturn` H.Summary 1 0 hspec-1.8.1.1/example/0000755000000000000000000000000012251063642012604 5ustar0000000000000000hspec-1.8.1.1/example/Spec.hs0000644000000000000000000000054412251063642014035 0ustar0000000000000000module Main (main, spec) where import Test.Hspec import Test.QuickCheck main :: IO () main = hspec spec spec :: Spec spec = do describe "reverse" $ do it "reverses a list" $ do reverse [1 :: Int, 2, 3] `shouldBe` [3, 2, 1] it "gives the original list, if applied twice" $ property $ \xs -> (reverse . reverse) xs == (xs :: [Int]) hspec-1.8.1.1/hspec-discover/0000755000000000000000000000000012251063642014067 5ustar0000000000000000hspec-1.8.1.1/hspec-discover/integration-test/0000755000000000000000000000000012251063642017367 5ustar0000000000000000hspec-1.8.1.1/hspec-discover/integration-test/with-formatter-empty/0000755000000000000000000000000012251063642023477 5ustar0000000000000000hspec-1.8.1.1/hspec-discover/integration-test/with-formatter-empty/Spec.hs0000644000000000000000000000013512251063642024724 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --formatter=Test.Hspec.Formatters.progress #-} hspec-1.8.1.1/hspec-discover/integration-test/empty/0000755000000000000000000000000012251063642020525 5ustar0000000000000000hspec-1.8.1.1/hspec-discover/integration-test/empty/Spec.hs0000644000000000000000000000005412251063642021752 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} hspec-1.8.1.1/hspec-discover/integration-test/with-formatter/0000755000000000000000000000000012251063642022343 5ustar0000000000000000hspec-1.8.1.1/hspec-discover/integration-test/with-formatter/FooSpec.hs0000644000000000000000000000034412251063642024236 0ustar0000000000000000module FooSpec (main, spec) where import Test.Hspec main :: IO () main = hspec spec spec :: Spec spec = do describe "reverse" $ do it "reverses a list" $ do reverse [1 :: Int, 2, 3] `shouldBe` [3, 2, 1] hspec-1.8.1.1/hspec-discover/integration-test/with-formatter/Spec.hs0000644000000000000000000000013512251063642023570 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --formatter=Test.Hspec.Formatters.progress #-} hspec-1.8.1.1/hspec-discover/integration-test/with-io-formatter/0000755000000000000000000000000012251063642022750 5ustar0000000000000000hspec-1.8.1.1/hspec-discover/integration-test/with-io-formatter/Formatter.hs0000644000000000000000000000054312251063642025251 0ustar0000000000000000module Formatter (count) where import Data.IORef import Control.Monad.IO.Class import Test.Hspec.Formatters count :: IO Formatter count = do ref <- newIORef (0 :: Int) return silent { exampleSucceeded = \_ -> liftIO (modifyIORef ref succ) , footerFormatter = liftIO (readIORef ref) >>= writeLine . show } hspec-1.8.1.1/hspec-discover/integration-test/with-io-formatter/FooSpec.hs0000644000000000000000000000034412251063642024643 0ustar0000000000000000module FooSpec (main, spec) where import Test.Hspec main :: IO () main = hspec spec spec :: Spec spec = do describe "reverse" $ do it "reverses a list" $ do reverse [1 :: Int, 2, 3] `shouldBe` [3, 2, 1] hspec-1.8.1.1/hspec-discover/integration-test/with-io-formatter/Spec.hs0000644000000000000000000000011612251063642024174 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --formatter=Formatter.count #-} hspec-1.8.1.1/hspec-discover/test/0000755000000000000000000000000012251063642015046 5ustar0000000000000000hspec-1.8.1.1/hspec-discover/test/Spec.hs0000644000000000000000000000006112251063642016271 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-meta-discover #-} hspec-1.8.1.1/hspec-discover/test/ConfigSpec.hs0000644000000000000000000000234412251063642017425 0ustar0000000000000000module ConfigSpec (main, spec) where import Test.Hspec.Meta import Config main :: IO () main = hspec spec spec :: Spec spec = do describe "parseConfig" $ do let parse = parseConfig "hspec-discover" it "recognizes --nested" $ do parse ["--nested"] `shouldBe` Right (defaultConfig {configNested = True}) it "recognizes --formatter" $ do parse ["--formatter", "someFormatter"] `shouldBe` Right (defaultConfig {configFormatter = Just "someFormatter"}) it "returns error message on unrecognized option" $ do parse ["--foo"] `shouldBe` (Left . unlines) [ "hspec-discover: unrecognized option `--foo'" , "" , "Usage: hspec-discover SRC CUR DST [--formatter=FORMATTER]" ] it "returns error message on unexpected argument" $ do parse ["foo"] `shouldBe` (Left . unlines) [ "hspec-discover: unexpected argument `foo'" , "" , "Usage: hspec-discover SRC CUR DST [--formatter=FORMATTER]" ] context "when option is given multiple times" $ do it "gives the last occurrence precedence" $ do parse ["--formatter", "foo", "--formatter", "bar"] `shouldBe` Right (defaultConfig {configFormatter = Just "bar"}) hspec-1.8.1.1/hspec-discover/test/RunSpec.hs0000644000000000000000000000666112251063642016772 0ustar0000000000000000module RunSpec (main, spec) where import Test.Hspec.Meta import Control.Applicative import System.IO import System.Directory import System.FilePath import Data.List (intercalate, sort) import Run main :: IO () main = hspec spec withTempFile :: (FilePath -> IO a) -> IO a withTempFile action = do dir <- getTemporaryDirectory (file, h) <- openTempFile dir "" hClose h action file <* removeFile file spec :: Spec spec = do describe "run" $ do it "generates test driver" $ withTempFile $ \f -> do run ["hspec-discover/test-data/nested-spec/Spec.hs", "", f] readFile f `shouldReturn` unlines [ "{-# LINE 1 \"hspec-discover/test-data/nested-spec/Spec.hs\" #-}module Main where" , "import qualified Foo.Bar.BazSpec" , "import qualified Foo.BarSpec" , "import qualified FooSpec" , "import Test.Hspec" , "main :: IO ()" , "main = hspec $ describe \"Foo.Bar.Baz\" Foo.Bar.BazSpec.spec >> describe \"Foo.Bar\" Foo.BarSpec.spec >> describe \"Foo\" FooSpec.spec" ] it "generates test driver for an empty directory" $ withTempFile $ \f -> do run ["hspec-discover/test-data/empty-dir/Spec.hs", "", f] readFile f `shouldReturn` unlines [ "{-# LINE 1 \"hspec-discover/test-data/empty-dir/Spec.hs\" #-}module Main where" , "import Test.Hspec" , "main :: IO ()" , "main = hspec $ return ()" ] describe "getFilesRecursive" $ do it "recursively returns all file entries of a given directory" $ do getFilesRecursive "hspec-discover/test-data" `shouldReturn` sort [ "empty-dir/Foo/Bar/Baz/.placeholder" , "nested-spec/Foo/Bar/BazSpec.hs" , "nested-spec/Foo/BarSpec.hs" , "nested-spec/FooSpec.hs" ] describe "fileToSpec" $ do it "converts path to spec name" $ do fileToSpec "FooSpec.hs" `shouldBe` Just "Foo" it "rejects spec with empty name" $ do fileToSpec "Spec.hs" `shouldBe` Nothing it "works for lhs files" $ do fileToSpec "FooSpec.lhs" `shouldBe` Just "Foo" it "returns Nothing for invalid spec name" $ do fileToSpec "foo" `shouldBe` Nothing context "when path has directory component" $ do it "converts path to spec name" $ do fileToSpec ("Foo" "Bar" "BazSpec.hs") `shouldBe` Just "Foo.Bar.Baz" it "rejects spec with empty name" $ do fileToSpec ("Foo" "Bar" "Spec.hs") `shouldBe` Nothing describe "findSpecs" $ do it "finds specs" $ do findSpecs "hspec-discover/test-data/nested-spec/Spec.hs" `shouldReturn` ["Foo.Bar.Baz","Foo.Bar","Foo"] describe "driverWithFormatter" $ do it "generates a test driver that uses a custom formatter" $ do driverWithFormatter False "Some.Module.formatter" "" `shouldBe` intercalate "\n" [ "import Test.Hspec" , "import Test.Hspec.Runner" , "import qualified Some.Module" , "main :: IO ()" , "main = hspecWithFormatter Some.Module.formatter $ " ] describe "moduleName" $ do it "returns the module name of an fully qualified identifier" $ do moduleName "Some.Module.someId" `shouldBe` "Some.Module" describe "importList" $ do it "generates imports for a list of specs" $ do importList ["Foo", "Bar"] "" `shouldBe` unlines [ "import qualified FooSpec" , "import qualified BarSpec" ] hspec-1.8.1.1/hspec-discover/example/0000755000000000000000000000000012251063642015522 5ustar0000000000000000hspec-1.8.1.1/hspec-discover/example/Spec.hs0000644000000000000000000000005412251063642016747 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} hspec-1.8.1.1/hspec-discover/test-data/0000755000000000000000000000000012251063642015755 5ustar0000000000000000hspec-1.8.1.1/hspec-discover/test-data/nested-spec/0000755000000000000000000000000012251063642020167 5ustar0000000000000000hspec-1.8.1.1/hspec-discover/test-data/nested-spec/FooSpec.hs0000644000000000000000000000000012251063642022047 0ustar0000000000000000hspec-1.8.1.1/hspec-discover/test-data/nested-spec/Foo/0000755000000000000000000000000012251063642020712 5ustar0000000000000000hspec-1.8.1.1/hspec-discover/test-data/nested-spec/Foo/BarSpec.hs0000644000000000000000000000000012251063642022553 0ustar0000000000000000hspec-1.8.1.1/hspec-discover/test-data/nested-spec/Foo/Bar/0000755000000000000000000000000012251063642021416 5ustar0000000000000000hspec-1.8.1.1/hspec-discover/test-data/nested-spec/Foo/Bar/BazSpec.hs0000644000000000000000000000000012251063642023267 0ustar0000000000000000hspec-1.8.1.1/hspec-discover/test-data/empty-dir/0000755000000000000000000000000012251063642017667 5ustar0000000000000000hspec-1.8.1.1/hspec-discover/test-data/empty-dir/Foo/0000755000000000000000000000000012251063642020412 5ustar0000000000000000hspec-1.8.1.1/hspec-discover/test-data/empty-dir/Foo/Bar/0000755000000000000000000000000012251063642021116 5ustar0000000000000000hspec-1.8.1.1/hspec-discover/test-data/empty-dir/Foo/Bar/Baz/0000755000000000000000000000000012251063642021632 5ustar0000000000000000hspec-1.8.1.1/hspec-discover/test-data/empty-dir/Foo/Bar/Baz/.placeholder0000644000000000000000000000000012251063642024103 0ustar0000000000000000hspec-1.8.1.1/hspec-discover/src/0000755000000000000000000000000012251063642014656 5ustar0000000000000000hspec-1.8.1.1/hspec-discover/src/Run.hs0000644000000000000000000000737612251063642015773 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | A preprocessor that finds and combines specs. module Run ( run -- exported for testing , importList , fileToSpec , findSpecs , getFilesRecursive , driverWithFormatter , moduleName ) where import Control.Monad import Control.Applicative import Data.List import Data.Maybe import Data.String import System.Environment import System.Exit import System.IO import System.Directory (doesDirectoryExist, getDirectoryContents, doesFileExist) import System.FilePath hiding (combine) import Config instance IsString ShowS where fromString = showString type Spec = String run :: [String] -> IO () run args_ = do name <- getProgName case args_ of src : _ : dst : args -> case parseConfig name args of Left err -> do hPutStrLn stderr err exitFailure Right c -> do when (configNested c) (hPutStrLn stderr "hspec-discover: WARNING - The `--nested' flag is deprecated and will be removed in a future release!") specs <- findSpecs src writeFile dst (mkSpecModule src c specs) _ -> do hPutStrLn stderr (usage name) exitFailure mkSpecModule :: FilePath -> Config -> [Spec] -> String mkSpecModule src c nodes = ( "{-# LINE 1 " . shows src . " #-}" . showString "module Main where\n" . importList nodes . maybe driver (driverWithFormatter (null nodes)) (configFormatter c) . formatSpecs nodes ) "\n" where driver = showString "import Test.Hspec\n" . showString "main :: IO ()\n" . showString "main = hspec $ " driverWithFormatter :: Bool -> String -> ShowS driverWithFormatter isEmpty f = (if isEmpty then id else "import Test.Hspec\n") . showString "import Test.Hspec.Runner\n" . showString "import qualified " . showString (moduleName f) . showString "\n" . showString "main :: IO ()\n" . showString "main = hspecWithFormatter " . showString f . showString " $ " moduleName :: String -> String moduleName = reverse . dropWhile (== '.') . dropWhile (/= '.') . reverse -- | Generate imports for a list of specs. importList :: [Spec] -> ShowS importList = foldr (.) "" . map f where f :: Spec -> ShowS f name = "import qualified " . showString name . "Spec\n" -- | Combine a list of strings with (>>). sequenceS :: [ShowS] -> ShowS sequenceS = foldr (.) "" . intersperse " >> " -- | Convert a list of specs to code. formatSpecs :: [Spec] -> ShowS formatSpecs xs | null xs = "return ()" | otherwise = sequenceS (map formatSpec xs) -- | Convert a spec to code. formatSpec :: Spec -> ShowS formatSpec name = "describe " . shows name . " " . showString name . "Spec.spec" findSpecs :: FilePath -> IO [Spec] findSpecs src = do let (dir, file) = splitFileName src mapMaybe fileToSpec . filter (/= file) <$> getFilesRecursive dir fileToSpec :: FilePath -> Maybe String fileToSpec f = intercalate "." . reverse <$> case reverse $ splitDirectories f of x:xs -> case stripSuffix "Spec.hs" x <|> stripSuffix "Spec.lhs" x of Nothing -> Nothing Just "" -> Nothing Just ys -> Just (ys : xs) _ -> Nothing where stripSuffix :: Eq a => [a] -> [a] -> Maybe [a] stripSuffix suffix str = reverse <$> stripPrefix (reverse suffix) (reverse str) getFilesRecursive :: FilePath -> IO [FilePath] getFilesRecursive baseDir = sort <$> go [] where go :: FilePath -> IO [FilePath] go dir = do c <- map (dir ) . filter (`notElem` [".", ".."]) <$> getDirectoryContents (baseDir dir) dirs <- filterM (doesDirectoryExist . (baseDir )) c >>= mapM go files <- filterM (doesFileExist . (baseDir )) c return (files ++ concat dirs) hspec-1.8.1.1/hspec-discover/src/Main.hs0000644000000000000000000000020012251063642016066 0ustar0000000000000000module Main (main) where import System.Environment import Run (run) main :: IO () main = getArgs >>= run hspec-1.8.1.1/hspec-discover/src/Config.hs0000644000000000000000000000172112251063642016420 0ustar0000000000000000module Config ( Config (..) , defaultConfig , parseConfig , usage ) where import System.Console.GetOpt data Config = Config { configNested :: Bool , configFormatter :: Maybe String } deriving (Eq, Show) defaultConfig :: Config defaultConfig = Config False Nothing options :: [OptDescr (Config -> Config)] options = [ Option [] ["nested"] (NoArg $ \c -> c {configNested = True}) "" , Option [] ["formatter"] (ReqArg (\s c -> c {configFormatter = Just s}) "FORMATTER") "" ] usage :: String -> String usage prog = "\nUsage: " ++ prog ++ " SRC CUR DST [--formatter=FORMATTER]\n" parseConfig :: String -> [String] -> Either String Config parseConfig prog args = case getOpt Permute options args of (opts, [], []) -> Right (foldl (flip id) defaultConfig opts) (_, _, err:_) -> formatError err (_, arg:_, _) -> formatError ("unexpected argument `" ++ arg ++ "'\n") where formatError err = Left (prog ++ ": " ++ err ++ usage prog) hspec-1.8.1.1/src/0000755000000000000000000000000012251063642011740 5ustar0000000000000000hspec-1.8.1.1/src/Test/0000755000000000000000000000000012251063642012657 5ustar0000000000000000hspec-1.8.1.1/src/Test/Hspec.hs0000644000000000000000000000431112251063642014254 0ustar0000000000000000-- | -- Stability: stable -- -- Hspec is a testing library for Haskell. -- -- This is the library reference for Hspec. -- The contains more in-depth -- documentation. module Test.Hspec ( -- * Types Spec , Example -- * Setting expectations , module Test.Hspec.Expectations -- * Defining a spec , describe , context , it , example , pending , pendingWith , before , after , around , parallel -- * Running a spec , hspec ) where import Test.Hspec.Core.Type hiding (describe, it) import Test.Hspec.Runner import Test.Hspec.HUnit () import Test.Hspec.Expectations import Test.Hspec.Core (mapSpecItem) import qualified Test.Hspec.Core as Core -- | Combine a list of specs into a larger spec. describe :: String -> Spec -> Spec describe label action = fromSpecList [Core.describe label (runSpecM action)] -- | An alias for `describe`. context :: String -> Spec -> Spec context = describe -- | Create a spec item. -- -- A spec item consists of: -- -- * a textual description of a desired behavior -- -- * an example for that behavior -- -- > describe "absolute" $ do -- > it "returns a positive number when given a negative number" $ -- > absolute (-1) == 1 it :: Example a => String -> a -> Spec it label action = fromSpecList [Core.it label action] -- | This is a type restricted version of `id`. It can be used to get better -- error messages on type mismatches. -- -- Compare e.g. -- -- > it "exposes some behavior" $ example $ do -- > putStrLn -- -- with -- -- > it "exposes some behavior" $ do -- > putStrLn example :: Expectation -> Expectation example = id -- | Run examples of given spec in parallel. parallel :: Spec -> Spec parallel = mapSpecItem $ \item -> item {itemIsParallelizable = True} -- | Run a custom action before every spec item. before :: IO () -> Spec -> Spec before action = around (action >>) -- | Run a custom action after every spec item. after :: IO () -> Spec -> Spec after action = around (>> action) -- | Run a custom action before and/or after every spec item. around :: (IO () -> IO ()) -> Spec -> Spec around a2 = mapSpecItem $ \item -> item {itemExample = \params a1 -> itemExample item params (a1 . a2)} hspec-1.8.1.1/src/Test/Hspec/0000755000000000000000000000000012251063642013721 5ustar0000000000000000hspec-1.8.1.1/src/Test/Hspec/Compat.hs0000644000000000000000000000335112251063642015502 0ustar0000000000000000{-# LANGUAGE CPP #-} module Test.Hspec.Compat ( showType , showFullType , readMaybe , module Data.IORef #if !MIN_VERSION_base(4,6,0) , modifyIORef' #endif ) where import Data.Typeable (Typeable, typeOf, typeRepTyCon) import Text.Read import Data.IORef #if MIN_VERSION_base(4,4,0) import Data.Typeable.Internal (tyConModule, tyConName) #endif #if !MIN_VERSION_base(4,6,0) import qualified Text.ParserCombinators.ReadP as P import Prelude #endif #if !MIN_VERSION_base(4,6,0) -- |Strict version of 'modifyIORef' modifyIORef' :: IORef a -> (a -> a) -> IO () modifyIORef' ref f = do x <- readIORef ref let x' = f x x' `seq` writeIORef ref x' -- | Parse a string using the 'Read' instance. -- Succeeds if there is exactly one valid result. -- A 'Left' value indicates a parse error. readEither :: Read a => String -> Either String a readEither s = case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of [x] -> Right x [] -> Left "Prelude.read: no parse" _ -> Left "Prelude.read: ambiguous parse" where read' = do x <- readPrec lift P.skipSpaces return x -- | Parse a string using the 'Read' instance. -- Succeeds if there is exactly one valid result. readMaybe :: Read a => String -> Maybe a readMaybe s = case readEither s of Left _ -> Nothing Right a -> Just a #endif showType :: Typeable a => a -> String showType a = let t = typeRepTyCon (typeOf a) in #if MIN_VERSION_base(4,4,0) show t #else (reverse . takeWhile (/= '.') . reverse . show) t #endif showFullType :: Typeable a => a -> String showFullType a = let t = typeRepTyCon (typeOf a) in #if MIN_VERSION_base(4,4,0) tyConModule t ++ "." ++ tyConName t #else show t #endif hspec-1.8.1.1/src/Test/Hspec/QuickCheck.hs0000644000000000000000000000332312251063642016270 0ustar0000000000000000-- | -- Stability: provisional module Test.Hspec.QuickCheck ( -- * Params modifyMaxSuccess , modifyMaxDiscardRatio , modifyMaxSize -- * Re-exports from QuickCheck -- | -- Previous versions of Hspec provided a distinct `property` combinator, but -- it's now possible to use QuickCheck's `property` instead. For backward -- compatibility we now re-export QuickCheck's `property`, but it is advisable -- to import it from "Test.QuickCheck" instead. , property -- * Shortcuts , prop ) where import Test.QuickCheck import Test.Hspec import Test.Hspec.Core (Params(..), modifyParams) -- | -- > prop ".." $ -- > .. -- -- is a shortcut for -- -- > it ".." $ property $ -- > .. prop :: Testable prop => String -> prop -> Spec prop s = it s . property -- | Use a modified `maxSuccess` for given spec. modifyMaxSuccess :: (Int -> Int) -> Spec -> Spec modifyMaxSuccess = modifyArgs . modify where modify :: (Int -> Int) -> Args -> Args modify f args = args {maxSuccess = f (maxSuccess args)} -- | Use a modified `maxDiscardRatio` for given spec. modifyMaxDiscardRatio :: (Int -> Int) -> Spec -> Spec modifyMaxDiscardRatio = modifyArgs . modify where modify :: (Int -> Int) -> Args -> Args modify f args = args {maxDiscardRatio = f (maxDiscardRatio args)} -- | Use a modified `maxSize` for given spec. modifyMaxSize :: (Int -> Int) -> Spec -> Spec modifyMaxSize = modifyArgs . modify where modify :: (Int -> Int) -> Args -> Args modify f args = args {maxSize = f (maxSize args)} modifyArgs :: (Args -> Args) -> Spec -> Spec modifyArgs = modifyParams . modify where modify :: (Args -> Args) -> Params -> Params modify f p = p {paramsQuickCheckArgs = f (paramsQuickCheckArgs p)} hspec-1.8.1.1/src/Test/Hspec/Core.hs0000644000000000000000000000403712251063642015151 0ustar0000000000000000-- | -- Stability: experimental -- -- This module provides access to Hspec's internals. It is less stable than -- other parts of the API. For most users "Test.Hspec" is more suitable! module Test.Hspec.Core ( -- * A type class for examples Example (..) , Params (..) , Progress , Result (..) -- * A writer monad for constructing specs , SpecM , runSpecM , fromSpecList -- * Internal representation of a spec tree , SpecTree (..) , Item (..) , mapSpecItem , modifyParams , describe , it -- * Deprecated types and functions , Specs , hspecB , hspecX , hHspec , hspec ) where import Control.Applicative import System.IO (Handle) import Test.Hspec.Core.Type import qualified Test.Hspec.Runner as Runner import Test.Hspec.Runner (Summary(..), Config(..), defaultConfig) hspecWith :: Config -> [SpecTree] -> IO Summary hspecWith c = Runner.hspecWith c . fromSpecList mapSpecItem :: (Item -> Item) -> Spec -> Spec mapSpecItem f = fromSpecList . map go . runSpecM where go :: SpecTree -> SpecTree go spec = case spec of SpecItem item -> SpecItem (f item) SpecGroup d es -> SpecGroup d (map go es) modifyParams :: (Params -> Params) -> Spec -> Spec modifyParams f = mapSpecItem $ \item -> item {itemExample = \p -> (itemExample item) (f p)} {-# DEPRECATED hspecX "use `Test.Hspec.Runner.hspec` instead" #-} -- since 1.2.0 hspecX :: [SpecTree] -> IO () hspecX = hspec {-# DEPRECATED hspec "use `Test.Hspec.Runner.hspec` instead" #-} -- since 1.4.0 hspec :: [SpecTree] -> IO () hspec = Runner.hspec . fromSpecList {-# DEPRECATED hspecB "use `Test.Hspec.Runner.hspecWith` instead" #-} -- since 1.4.0 hspecB :: [SpecTree] -> IO Bool hspecB spec = (== 0) . summaryFailures <$> hspecWith defaultConfig spec {-# DEPRECATED hHspec "use `Test.Hspec.Runner.hspecWith` instead" #-} -- since 1.4.0 hHspec :: Handle -> [SpecTree] -> IO Summary hHspec h = hspecWith defaultConfig {configHandle = Left h} {-# DEPRECATED Specs "use `[SpecTree]` instead" #-} -- since 1.4.0 type Specs = [SpecTree] hspec-1.8.1.1/src/Test/Hspec/Util.hs0000644000000000000000000000700712251063642015176 0ustar0000000000000000module Test.Hspec.Util ( pluralize , lineBreaksAt , safeTry , Path , filterPredicate , formatRequirement , readMaybe , getEnv , strip , stdGenToInteger , stdGenFromInteger ) where import Data.Int (Int32) import Data.List import Data.Maybe import Data.Char (isSpace) import Control.Applicative import qualified Control.Exception as E import qualified System.Environment as Environment import System.Random (StdGen) -- | Create a more readable display of a quantity of something. -- -- Examples: -- -- >>> pluralize 0 "example" -- "0 examples" -- -- >>> pluralize 1 "example" -- "1 example" -- -- >>> pluralize 2 "example" -- "2 examples" pluralize :: Int -> String -> String pluralize 1 s = "1 " ++ s pluralize n s = show n ++ " " ++ s ++ "s" safeTry :: IO a -> IO (Either E.SomeException a) safeTry action = (Right <$> (action >>= E.evaluate)) `E.catches` [ -- Re-throw AsyncException, otherwise execution will not terminate on SIGINT -- (ctrl-c). All AsyncExceptions are re-thrown (not just UserInterrupt) -- because all of them indicate severe conditions and should not occur during -- normal operation. E.Handler $ \e -> E.throwIO (e :: E.AsyncException) , E.Handler $ \e -> (return . Left) (e :: E.SomeException) ] -- | -- A tuple that represents the location of an example within a spec. -- -- It consists of a list of group descriptions and a requirement description. type Path = ([String], String) -- | A predicate that can be used to filter specs. filterPredicate :: String -> Path -> Bool filterPredicate pattern path@(groups, requirement) = pattern `isInfixOf` plain || pattern `isInfixOf` formatted where plain = intercalate "/" (groups ++ [requirement]) formatted = formatRequirement path -- | -- Try to create a proper English sentence from a path by applying some -- heuristics. formatRequirement :: Path -> String formatRequirement (groups, requirement) = groups_ ++ requirement where groups_ = case break (any isSpace) groups of ([], ys) -> join ys (xs, ys) -> join (intercalate "." xs : ys) join xs = case xs of [x] -> x ++ " " ys -> concatMap (++ ", ") ys -- NOTE: base-4.6.0.0 provides a function with that name and type. For -- compatibility with earlier versions, we define our own version here. readMaybe :: Read a => String -> Maybe a readMaybe = fmap fst . listToMaybe . reads getEnv :: String -> IO (Maybe String) getEnv key = either (const Nothing) Just <$> safeTry (Environment.getEnv key) -- ensure that lines are not longer then given `n`, insert line breaks at word -- boundaries lineBreaksAt :: Int -> String -> [String] lineBreaksAt n input = case words input of [] -> [] x:xs -> go (x, xs) where go :: (String, [String]) -> [String] go c = case c of (s, []) -> [s] (s, y:ys) -> let r = s ++ " " ++ y in if length r <= n then go (r, ys) else s : go (y, ys) strip :: String -> String strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse -- | Converts a 'StdGen' into an 'Integer'. Assumes -- StdGens to be encoded as two positive 'Int32's and -- $show (StdGen a b) = show a ++ " " ++ show b$. stdGenToInteger :: StdGen -> Integer stdGenToInteger stdGen = let [a, b] = map read . words $ show stdGen in b * fromIntegral (maxBound :: Int32) + a -- | Inverse of 'stdGenToInteger'. stdGenFromInteger :: Integer -> StdGen stdGenFromInteger n = let (a, b) = quotRem n (fromIntegral (maxBound :: Int32)) in read (show b ++ " " ++ show a) hspec-1.8.1.1/src/Test/Hspec/HUnit.hs0000644000000000000000000000240212251063642015302 0ustar0000000000000000{-# OPTIONS -fno-warn-orphans #-} module Test.Hspec.HUnit ( -- * Interoperability with HUnit fromHUnitTest ) where import Data.List (intercalate) import qualified Test.HUnit as HU import Test.HUnit (Test (..)) import Test.Hspec.Core.Type -- | This instance is deprecated, use `Test.Hspec.HUnit.fromHUnitTest` instead! instance Example Test where evaluateExample test _ _ = do (counts, fails) <- HU.runTestText HU.putTextToShowS test let r = if HU.errors counts + HU.failures counts == 0 then Success else Fail (details $ fails "") return r where details :: String -> String details = intercalate "\n" . tail . init . lines -- | -- Convert a HUnit test suite to a spec. This can be used to run existing -- HUnit tests with Hspec. fromHUnitTest :: Test -> Spec fromHUnitTest t = fromSpecList $ case t of TestList xs -> map go xs x -> [go x] where go :: Test -> SpecTree go t_ = case t_ of TestLabel s (TestCase e) -> it s e TestLabel s (TestList xs) -> describe s (map go xs) TestLabel s x -> describe s [go x] TestList xs -> describe "" (map go xs) TestCase e -> it "" e hspec-1.8.1.1/src/Test/Hspec/Formatters.hs0000644000000000000000000001404612251063642016410 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} -- | -- Stability: experimental -- -- This module contains formatters that can be used with -- `Test.Hspec.Runner.hspecWith`. module Test.Hspec.Formatters ( -- * Formatters silent , specdoc , progress , failed_examples -- * Implementing a custom Formatter -- | -- A formatter is a set of actions. Each action is evaluated when a certain -- situation is encountered during a test run. -- -- Actions live in the `FormatM` monad. It provides access to the runner state -- and primitives for appending to the generated report. , Formatter (..) , FormatM -- ** Accessing the runner state , getSuccessCount , getPendingCount , getFailCount , getTotalCount , FailureRecord (..) , getFailMessages , usedSeed , getCPUTime , getRealTime -- ** Appending to the gerenated report , write , writeLine , newParagraph -- ** Dealing with colors , withSuccessColor , withPendingColor , withFailColor -- ** Helpers , formatException -- * Using custom formatters with @hspec-discover@ -- | -- Anything that is an instance of `IsFormatter` can be used by -- @hspec-discover@ as the default formatter for a spec. If you have a -- formatter @myFormatter@ in the module @Custom.Formatters@ you can use it -- by passing an additional argument to @hspec-discover@. -- -- >{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --formatter=Custom.Formatters.myFormatter #-} , IsFormatter (..) ) where import Data.Maybe import Test.Hspec.Util import Test.Hspec.Compat import Text.Printf import Control.Monad (unless, forM_) import Control.Applicative import qualified Control.Exception as E import System.IO (hPutStr, hFlush) -- We use an explicit import list for "Test.Hspec.Formatters.Internal", to make -- sure, that we only use the public API to implement formatters. -- -- Everything imported here has to be re-exported, so that users can implement -- their own formatters. import Test.Hspec.Formatters.Internal ( Formatter (..) , FormatM , getSuccessCount , getPendingCount , getFailCount , getTotalCount , FailureRecord (..) , getFailMessages , usedSeed , getCPUTime , getRealTime , write , writeLine , newParagraph , withSuccessColor , withPendingColor , withFailColor ) class IsFormatter a where toFormatter :: a -> IO Formatter instance IsFormatter (IO Formatter) where toFormatter = id instance IsFormatter Formatter where toFormatter = return silent :: Formatter silent = Formatter { headerFormatter = return () , exampleGroupStarted = \_ _ _ -> return () , exampleGroupDone = return () , exampleProgress = \_ _ _ -> return () , exampleSucceeded = \_ -> return () , exampleFailed = \_ _ -> return () , examplePending = \_ _ -> return () , failedFormatter = return () , footerFormatter = return () } specdoc :: Formatter specdoc = silent { headerFormatter = do writeLine "" , exampleGroupStarted = \n nesting name -> do -- separate groups with an empty line unless (n == 0) $ do newParagraph writeLine (indentationFor nesting ++ name) , exampleGroupDone = do newParagraph , exampleProgress = \h _ p -> do hPutStr h (formatProgress p) hFlush h , exampleSucceeded = \(nesting, requirement) -> withSuccessColor $ do writeLine $ indentationFor nesting ++ "- " ++ requirement , exampleFailed = \(nesting, requirement) _ -> withFailColor $ do n <- getFailCount writeLine $ indentationFor nesting ++ "- " ++ requirement ++ " FAILED [" ++ show n ++ "]" , examplePending = \(nesting, requirement) reason -> withPendingColor $ do writeLine $ indentationFor nesting ++ "- " ++ requirement ++ "\n # PENDING: " ++ fromMaybe "No reason given" reason , failedFormatter = defaultFailedFormatter , footerFormatter = defaultFooter } where indentationFor nesting = replicate (length nesting * 2) ' ' formatProgress (current, total) | total == 0 = show current ++ "\r" | otherwise = show current ++ "/" ++ show total ++ "\r" progress :: Formatter progress = silent { exampleSucceeded = \_ -> withSuccessColor $ write "." , exampleFailed = \_ _ -> withFailColor $ write "F" , examplePending = \_ _ -> withPendingColor $ write "." , failedFormatter = defaultFailedFormatter , footerFormatter = defaultFooter } failed_examples :: Formatter failed_examples = silent { failedFormatter = defaultFailedFormatter , footerFormatter = defaultFooter } defaultFailedFormatter :: FormatM () defaultFailedFormatter = do newParagraph failures <- getFailMessages forM_ (zip [1..] failures) $ \x -> do formatFailure x writeLine "" unless (null failures) $ do write "Randomized with seed " >> usedSeed >>= writeLine . show writeLine "" where formatFailure :: (Int, FailureRecord) -> FormatM () formatFailure (n, FailureRecord path reason) = do write (show n ++ ") ") writeLine (formatRequirement path) withFailColor $ do unless (null err) $ do writeLine err where err = either (("uncaught exception: " ++) . formatException) id reason -- | Convert an exception to a string. -- -- The type of the exception is included. Here is an example: -- -- >>> import Control.Applicative -- >>> import Control.Exception -- >>> either formatException show <$> (try . evaluate) (1 `div` 0) -- "ArithException (divide by zero)" formatException :: E.SomeException -> String formatException (E.SomeException e) = showType e ++ " (" ++ show e ++ ")" defaultFooter :: FormatM () defaultFooter = do writeLine =<< (++) <$> (printf "Finished in %1.4f seconds" <$> getRealTime) <*> (maybe "" (printf ", used %1.4f seconds of CPU time") <$> getCPUTime) fails <- getFailCount pending <- getPendingCount total <- getTotalCount let c | fails /= 0 = withFailColor | pending /= 0 = withPendingColor | otherwise = withSuccessColor c $ do write $ pluralize total "example" write (", " ++ pluralize fails "failure") unless (pending == 0) $ write (", " ++ show pending ++ " pending") writeLine "" hspec-1.8.1.1/src/Test/Hspec/Timer.hs0000644000000000000000000000053012251063642015333 0ustar0000000000000000module Test.Hspec.Timer where import Data.IORef import Data.Time.Clock.POSIX newTimer :: POSIXTime -> IO (IO Bool) newTimer delay = do ref <- getPOSIXTime >>= newIORef return $ do t0 <- readIORef ref t1 <- getPOSIXTime if delay < t1 - t0 then writeIORef ref t1 >> return True else return False hspec-1.8.1.1/src/Test/Hspec/Config.hs0000644000000000000000000001012312251063642015457 0ustar0000000000000000module Test.Hspec.Config ( Config (..) , defaultConfig , getConfig , configAddFilter , configSetSeed ) where import Control.Applicative import Data.List import Data.Maybe import System.IO import System.Exit import qualified Test.QuickCheck as QC import Test.Hspec.Formatters import Test.Hspec.Util -- for Monad (Either e) when base < 4.3 import Control.Monad.Trans.Error () import Test.Hspec.Options import Test.Hspec.FailureReport data Config = Config { configDryRun :: Bool , configPrintCpuTime :: Bool , configFastFail :: Bool -- | -- A predicate that is used to filter the spec before it is run. Only examples -- that satisfy the predicate are run. , configFilterPredicate :: Maybe (Path -> Bool) , configQuickCheckArgs :: QC.Args , configSmallCheckDepth :: Int , configColorMode :: ColorMode , configFormatter :: Formatter , configHtmlOutput :: Bool , configHandle :: Either Handle FilePath } defaultConfig :: Config defaultConfig = Config False False False Nothing QC.stdArgs 5 ColorAuto specdoc False (Left stdout) -- | Add a filter predicate to config. If there is already a filter predicate, -- then combine them with `||`. configAddFilter :: (Path -> Bool) -> Config -> Config configAddFilter p1 c = c { configFilterPredicate = Just p1 `filterOr` configFilterPredicate c } filterOr :: Maybe (Path -> Bool) -> Maybe (Path -> Bool) -> Maybe (Path -> Bool) filterOr p1_ p2_ = case (p1_, p2_) of (Just p1, Just p2) -> Just $ \path -> p1 path || p2 path _ -> p1_ <|> p2_ configSetSeed :: Integer -> Config -> Config configSetSeed n c = c {configQuickCheckArgs = (configQuickCheckArgs c) {QC.replay = Just (stdGenFromInteger n, 0)}} mkConfig :: Maybe FailureReport -> Options -> Config mkConfig mFailureReport opts = Config { configDryRun = optionsDryRun opts , configPrintCpuTime = optionsPrintCpuTime opts , configFastFail = optionsFastFail opts , configFilterPredicate = matchFilter `filterOr` rerunFilter , configQuickCheckArgs = qcArgs , configSmallCheckDepth = fromMaybe (configSmallCheckDepth defaultConfig) (optionsDepth opts) , configColorMode = optionsColorMode opts , configFormatter = optionsFormatter opts , configHtmlOutput = optionsHtmlOutput opts , configHandle = maybe (configHandle defaultConfig) Right (optionsOutputFile opts) } where qcArgs = ( maybe id setSeed mSeed . maybe id setMaxDiscardRatio mMaxDiscardRatio . maybe id setMaxSize mMaxSize . maybe id setMaxSuccess mMaxSuccess) QC.stdArgs mSeed = optionsSeed opts <|> (failureReportSeed <$> mFailureReport) mMaxSuccess = optionsMaxSuccess opts <|> (failureReportMaxSuccess <$> mFailureReport) mMaxSize = optionsMaxSize opts <|> (failureReportMaxSize <$> mFailureReport) mMaxDiscardRatio = optionsMaxDiscardRatio opts <|> (failureReportMaxDiscardRatio <$> mFailureReport) setMaxSuccess :: Int -> QC.Args -> QC.Args setMaxSuccess n args = args {QC.maxSuccess = n} setMaxSize :: Int -> QC.Args -> QC.Args setMaxSize n args = args {QC.maxSize = n} setMaxDiscardRatio :: Int -> QC.Args -> QC.Args setMaxDiscardRatio n args = args {QC.maxDiscardRatio = n} setSeed :: Integer -> QC.Args -> QC.Args setSeed n args = args {QC.replay = Just (stdGenFromInteger n, 0)} matchFilter = case optionsMatch opts of [] -> Nothing xs -> Just $ foldl1' (\p0 p1 path -> p0 path || p1 path) (map filterPredicate xs) rerunFilter = flip elem . failureReportPaths <$> mFailureReport getConfig :: Options -> String -> [String] -> IO Config getConfig opts_ prog args = do case parseOptions opts_ prog args of Left (err, msg) -> exitWithMessage err msg Right opts -> do r <- if optionsRerun opts then readFailureReport else return Nothing return (mkConfig r opts) exitWithMessage :: ExitCode -> String -> IO a exitWithMessage err msg = do hPutStr h msg exitWith err where h = case err of ExitSuccess -> stdout _ -> stderr hspec-1.8.1.1/src/Test/Hspec/FailureReport.hs0000644000000000000000000000216512251063642017044 0ustar0000000000000000module Test.Hspec.FailureReport ( FailureReport (..) , writeFailureReport , readFailureReport ) where import System.IO import System.SetEnv import Test.Hspec.Util (Path, safeTry, readMaybe, getEnv) data FailureReport = FailureReport { failureReportSeed :: Integer , failureReportMaxSuccess :: Int , failureReportMaxSize :: Int , failureReportMaxDiscardRatio :: Int , failureReportPaths :: [Path] } deriving (Eq, Show, Read) writeFailureReport :: FailureReport -> IO () writeFailureReport x = do -- on Windows this can throw an exception when the input is too large, hence -- we use `safeTry` here safeTry (setEnv "HSPEC_FAILURES" $ show x) >>= either onError return where onError err = do hPutStrLn stderr ("WARNING: Could not write environment variable HSPEC_FAILURES (" ++ show err ++ ")") readFailureReport :: IO (Maybe FailureReport) readFailureReport = do mx <- getEnv "HSPEC_FAILURES" case mx >>= readMaybe of Nothing -> do hPutStrLn stderr "WARNING: Could not read environment variable HSPEC_FAILURES; `--rerun' is ignored!" return Nothing x -> return x hspec-1.8.1.1/src/Test/Hspec/Runner.hs0000644000000000000000000001241112251063642015525 0ustar0000000000000000-- | -- Stability: provisional module Test.Hspec.Runner ( -- * Running a spec hspec , hspecResult , hspecWith -- * Types , Summary (..) , Config (..) , ColorMode (..) , Path , defaultConfig , configAddFilter -- * Internals , hspecWithFormatter ) where import Control.Monad import Control.Applicative import Data.Monoid import Data.Maybe import System.IO import System.Environment import System.Exit import qualified Control.Exception as E import System.Console.ANSI (hHideCursor, hShowCursor) import qualified Test.QuickCheck as QC import System.Random (newStdGen) import Control.Monad.IO.Class (liftIO) import Test.Hspec.Util import Test.Hspec.Core.Type import Test.Hspec.Config import Test.Hspec.Formatters import Test.Hspec.Formatters.Internal import Test.Hspec.FailureReport import Test.Hspec.Options (Options(..), ColorMode(..), defaultOptions) import Test.Hspec.Runner.Eval -- | Filter specs by given predicate. -- -- The predicate takes a list of "describe" labels and a "requirement". filterSpecs :: (Path -> Bool) -> [SpecTree] -> [SpecTree] filterSpecs p = goSpecs [] where goSpecs :: [String] -> [SpecTree] -> [SpecTree] goSpecs groups = mapMaybe (goSpec groups) goSpec :: [String] -> SpecTree -> Maybe SpecTree goSpec groups spec = case spec of SpecItem item -> guard (p (groups, itemRequirement item)) >> return spec SpecGroup group specs -> case goSpecs (groups ++ [group]) specs of [] -> Nothing xs -> Just (SpecGroup group xs) -- | Run given spec and write a report to `stdout`. -- Exit with `exitFailure` if at least one spec item fails. hspec :: Spec -> IO () hspec = hspecWithOptions defaultOptions -- | This function is used by @hspec-discover@. It is not part of the public -- API and may change at any time. hspecWithFormatter :: IsFormatter a => a -> Spec -> IO () hspecWithFormatter formatter spec = do f <- toFormatter formatter hspecWithOptions defaultOptions {optionsFormatter = f} spec -- Add a StdGen to configQuickCheckArgs if there is none. That way the same -- seed is used for all properties. This helps with --seed and --rerun. ensureStdGen :: Config -> IO Config ensureStdGen c = case QC.replay qcArgs of Nothing -> do stdGen <- newStdGen return c {configQuickCheckArgs = qcArgs {QC.replay = Just (stdGen, 0)}} _ -> return c where qcArgs = configQuickCheckArgs c -- | Run given spec with custom options. -- This is similar to `hspec`, but more flexible. hspecWithOptions :: Options -> Spec -> IO () hspecWithOptions opts spec = do prog <- getProgName args <- getArgs c <- getConfig opts prog args withArgs [] {- do not leak command-line arguments to examples -} $ do r <- hspecWith c spec unless (summaryFailures r == 0) exitFailure -- | Run given spec and returns a summary of the test run. -- -- /Note/: `hspecResult` does not exit with `exitFailure` on failing spec -- items. If you need this, you have to check the `Summary` yourself and act -- accordingly. hspecResult :: Spec -> IO Summary hspecResult = hspecWith defaultConfig -- | Run given spec with custom options and returns a summary of the test run. -- -- /Note/: `hspecWith` does not exit with `exitFailure` on failing spec -- items. If you need this, you have to check the `Summary` yourself and act -- accordingly. hspecWith :: Config -> Spec -> IO Summary hspecWith c_ spec = withHandle c_ $ \h -> do c <- ensureStdGen c_ let formatter = configFormatter 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 h c formatter (maybe id filterSpecs (configFilterPredicate c) $ runSpecM spec) `finally_` do failedFormatter formatter footerFormatter formatter -- dump failure report xs <- map failureRecordPath <$> getFailMessages liftIO $ writeFailureReport FailureReport { failureReportSeed = seed , failureReportMaxSuccess = QC.maxSuccess (configQuickCheckArgs c) , failureReportMaxSize = QC.maxSize (configQuickCheckArgs c) , failureReportMaxDiscardRatio = QC.maxDiscardRatio (configQuickCheckArgs c) , failureReportPaths = xs } Summary <$> getTotalCount <*> getFailCount where withHiddenCursor :: Bool -> Handle -> IO a -> IO a withHiddenCursor useColor h | useColor = E.bracket_ (hHideCursor h) (hShowCursor h) | otherwise = id doesUseColor :: Handle -> Config -> IO Bool doesUseColor h c = case configColorMode c of 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 { summaryExamples :: Int , summaryFailures :: Int } deriving (Eq, Show) instance Monoid Summary where mempty = Summary 0 0 (Summary x1 x2) `mappend` (Summary y1 y2) = Summary (x1 + y1) (x2 + y2) hspec-1.8.1.1/src/Test/Hspec/Options.hs0000644000000000000000000001531212251063642015712 0ustar0000000000000000module Test.Hspec.Options ( Options (..) , ColorMode (..) , defaultOptions , parseOptions -- exported to silence warnings , Arg (..) ) where import Data.List import System.Exit import System.Console.GetOpt import Test.Hspec.Formatters import Test.Hspec.Util -- for Monad (Either e) when base < 4.3 import Control.Monad.Trans.Error () data Options = Options { optionsDryRun :: Bool , optionsPrintCpuTime :: Bool , optionsRerun :: Bool , optionsFastFail :: Bool , optionsMatch :: [String] , optionsMaxSuccess :: Maybe Int , optionsDepth :: Maybe Int , optionsSeed :: Maybe Integer , optionsMaxSize :: Maybe Int , optionsMaxDiscardRatio :: Maybe Int , optionsColorMode :: ColorMode , optionsFormatter :: Formatter , optionsHtmlOutput :: Bool , optionsOutputFile :: Maybe FilePath } addMatch :: String -> Options -> Options addMatch s c = c {optionsMatch = s : optionsMatch c} setDepth :: Int -> Options -> Options setDepth n c = c {optionsDepth = Just n} setMaxSuccess :: Int -> Options -> Options setMaxSuccess n c = c {optionsMaxSuccess = Just n} setMaxSize :: Int -> Options -> Options setMaxSize n c = c {optionsMaxSize = Just n} setMaxDiscardRatio :: Int -> Options -> Options setMaxDiscardRatio n c = c {optionsMaxDiscardRatio = Just n} setSeed :: Integer -> Options -> Options setSeed n c = c {optionsSeed = Just n} data ColorMode = ColorAuto | ColorNever | ColorAlways deriving (Eq, Show) defaultOptions :: Options defaultOptions = Options False False False False [] Nothing Nothing Nothing Nothing Nothing ColorAuto specdoc False Nothing formatters :: [(String, Formatter)] formatters = [ ("specdoc", specdoc) , ("progress", progress) , ("failed-examples", failed_examples) , ("silent", silent) ] formatHelp :: String formatHelp = unlines (addLineBreaks "use a custom formatter; this can be one of:" ++ map ((" " ++) . fst) formatters) type Result = Either NoConfig Options data NoConfig = Help | InvalidArgument String String data Arg a = Arg { argumentName :: String , argumentParser :: String -> Maybe a , argumentSetter :: a -> Options -> Options } mkOption :: [Char] -> String -> Arg a -> String -> OptDescr (Result -> Result) mkOption shortcut name (Arg argName parser setter) help = Option shortcut [name] (ReqArg arg argName) help where arg :: String -> Result -> Result arg input x = x >>= \c -> case parser input of Just n -> Right (setter n c) Nothing -> Left (InvalidArgument name input) addLineBreaks :: String -> [String] addLineBreaks = lineBreaksAt 44 options :: [OptDescr (Result -> Result)] options = [ Option [] ["help"] (NoArg (const $ Left Help)) (h "display this help and exit") , mkOption "m" "match" (Arg "PATTERN" return addMatch) (h "only run examples that match given PATTERN") , 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 [] "depth" (Arg "N" readMaybe setDepth) (h "maximum depth of generated test values for SmallCheck properties") , mkOption "a" "qc-max-success" (Arg "N" readMaybe setMaxSuccess) (h "maximum number of successful tests before a QuickCheck property succeeds") , mkOption "" "qc-max-size" (Arg "N" readMaybe setMaxSize) (h "size to use for the biggest test cases") , mkOption "" "qc-max-discard" (Arg "N" readMaybe setMaxDiscardRatio) (h "maximum number of discarded tests per successful test before giving up") , 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 "rerun all examples that failed in the previously test run (only works in GHCi)") ] where h = unlines . addLineBreaks readFormatter :: String -> Maybe Formatter readFormatter = (`lookup` formatters) 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} setFastFail x = x >>= \c -> return c {optionsFastFail = True} setRerun x = x >>= \c -> return c {optionsRerun = True} setNoColor x = x >>= \c -> return c {optionsColorMode = ColorNever} setColor x = x >>= \c -> return c {optionsColorMode = ColorAlways} undocumentedOptions :: [OptDescr (Result -> Result)] undocumentedOptions = [ -- for compatibility with test-framework mkOption [] "maximum-generated-tests" (Arg "NUMBER" readMaybe setMaxSuccess) "how many automated tests something like QuickCheck should try, by default" -- undocumented for now, as we probably want to change this to produce a -- standalone HTML report in the future , Option [] ["html"] (NoArg setHtml) "produce HTML output" -- now a noop , Option "v" ["verbose"] (NoArg id) "do not suppress output to stdout when evaluating examples" ] where setHtml :: Result -> Result setHtml x = x >>= \c -> return c {optionsHtmlOutput = True} parseOptions :: Options -> String -> [String] -> Either (ExitCode, String) Options parseOptions c prog args = case getOpt Permute (options ++ undocumentedOptions) args of (opts, [], []) -> case foldl' (flip id) (Right c) opts of Left Help -> Left (ExitSuccess, usageInfo ("Usage: " ++ prog ++ " [OPTION]...\n\nOPTIONS") options) Left (InvalidArgument flag value) -> tryHelp ("invalid argument `" ++ value ++ "' for `--" ++ flag ++ "'\n") Right x -> Right x (_, _, err:_) -> tryHelp err (_, arg:_, _) -> tryHelp ("unexpected argument `" ++ arg ++ "'\n") where tryHelp msg = Left (ExitFailure 1, prog ++ ": " ++ msg ++ "Try `" ++ prog ++ " --help' for more information.\n") hspec-1.8.1.1/src/Test/Hspec/Monadic.hs0000644000000000000000000000243712251063642015635 0ustar0000000000000000{-# OPTIONS_HADDOCK not-home #-} module Test.Hspec.Monadic {-# DEPRECATED "use \"Test.Hspec\", \"Test.Hspec.Runner\" or \"Test.Hspec.Core\" instead" #-} ( -- * Types Spec , Example -- * Defining a spec , describe , context , it , pending -- * Running a spec , hspec , Summary (..) -- * Interface to the non-monadic API , runSpecM , fromSpecList -- * Deprecated types and functions , Specs , descriptions , hspecB , hspecX , hHspec ) where import System.IO import Control.Applicative import Test.Hspec.Core (runSpecM, fromSpecList) import Test.Hspec.Runner import Test.Hspec {-# DEPRECATED Specs "use `Spec` instead" #-} -- since 1.2.0 type Specs = Spec {-# DEPRECATED descriptions "use `sequence_` instead" #-} -- since 1.0.0 descriptions :: [Spec] -> Spec descriptions = sequence_ {-# DEPRECATED hspecX "use `hspec` instead" #-} -- since 1.2.0 hspecX :: Spec -> IO () hspecX = hspec {-# DEPRECATED hspecB "use `hspecWith` instead" #-} -- since 1.4.0 hspecB :: Spec -> IO Bool hspecB spec = (== 0) . summaryFailures <$> hspecWith defaultConfig spec {-# DEPRECATED hHspec "use hspecWith instead" #-} -- since 1.4.0 hHspec :: Handle -> Spec -> IO Summary hHspec h = hspecWith defaultConfig {configHandle = Left h} hspec-1.8.1.1/src/Test/Hspec/Formatters/0000755000000000000000000000000012251063642016047 5ustar0000000000000000hspec-1.8.1.1/src/Test/Hspec/Formatters/Internal.hs0000644000000000000000000001762612251063642020173 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Test.Hspec.Formatters.Internal ( -- * Public API Formatter (..) , FormatM , getSuccessCount , getPendingCount , getFailCount , getTotalCount , FailureRecord (..) , getFailMessages , usedSeed , getCPUTime , getRealTime , write , writeLine , newParagraph , withSuccessColor , withPendingColor , withFailColor -- * Functions for internal use , runFormatM , increaseSuccessCount , increasePendingCount , increaseFailCount , addFailMessage , finally_ ) where import qualified System.IO as IO import System.IO (Handle) import Control.Monad (when, unless) import Control.Applicative import Control.Exception (SomeException, AsyncException(..), bracket_, try, throwIO) import System.Console.ANSI import Control.Monad.Trans.State hiding (gets, modify) import Control.Monad.IO.Class import qualified System.CPUTime as CPUTime import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime) import Test.Hspec.Util (Path) import Test.Hspec.Compat import Test.Hspec.Core.Type (Progress) -- | A lifted version of `Control.Monad.Trans.State.gets` gets :: (FormatterState -> a) -> FormatM a gets f = FormatM $ do f <$> (get >>= liftIO . readIORef) -- | A lifted version of `Control.Monad.Trans.State.modify` modify :: (FormatterState -> FormatterState) -> FormatM () modify f = FormatM $ do get >>= liftIO . (`modifyIORef'` f) data FormatterState = FormatterState { stateHandle :: Handle , stateUseColor :: Bool , produceHTML :: Bool , lastIsEmptyLine :: Bool -- True, if last line was empty , successCount :: Int , pendingCount :: Int , failCount :: Int , failMessages :: [FailureRecord] , stateUsedSeed :: Integer , cpuStartTime :: Maybe Integer , startTime :: POSIXTime } -- | The random seed that is used for QuickCheck. usedSeed :: FormatM Integer usedSeed = gets stateUsedSeed -- | The total number of examples encountered so far. totalCount :: FormatterState -> Int totalCount s = successCount s + pendingCount s + failCount s -- NOTE: We use an IORef here, so that the state persists when UserInterrupt is -- thrown. newtype FormatM a = FormatM (StateT (IORef FormatterState) IO a) deriving (Functor, Applicative, Monad, MonadIO) runFormatM :: Bool -> Bool -> Bool -> Integer -> Handle -> FormatM a -> IO a runFormatM useColor produceHTML_ printCpuTime seed handle (FormatM action) = do time <- getPOSIXTime cpuTime <- if printCpuTime then Just <$> CPUTime.getCPUTime else pure Nothing st <- newIORef (FormatterState handle useColor produceHTML_ False 0 0 0 [] seed cpuTime time) evalStateT action st -- | Increase the counter for successful examples increaseSuccessCount :: FormatM () increaseSuccessCount = modify $ \s -> s {successCount = succ $ successCount s} -- | Increase the counter for pending examples increasePendingCount :: FormatM () increasePendingCount = modify $ \s -> s {pendingCount = succ $ pendingCount s} -- | Increase the counter for failed examples increaseFailCount :: FormatM () increaseFailCount = modify $ \s -> s {failCount = succ $ failCount s} -- | Get the number of successful examples encountered so far. getSuccessCount :: FormatM Int getSuccessCount = gets successCount -- | Get the number of pending examples encountered so far. getPendingCount :: FormatM Int getPendingCount = gets pendingCount -- | Get the number of failed examples encountered so far. getFailCount :: FormatM Int getFailCount = gets failCount -- | Get the total number of examples encountered so far. getTotalCount :: FormatM Int getTotalCount = gets totalCount -- | Append to the list of accumulated failure messages. addFailMessage :: Path -> Either SomeException String -> FormatM () addFailMessage p m = modify $ \s -> s {failMessages = FailureRecord p m : failMessages s} -- | Get the list of accumulated failure messages. getFailMessages :: FormatM [FailureRecord] getFailMessages = reverse `fmap` gets failMessages data FailureRecord = FailureRecord { failureRecordPath :: Path , failureRecordMessage :: Either SomeException String } data Formatter = Formatter { headerFormatter :: FormatM () -- | evaluated before each test group -- -- The given number indicates the position within the parent group. , exampleGroupStarted :: Int -> [String] -> String -> FormatM () , exampleGroupDone :: FormatM () -- | used to notify the progress of the currently evaluated example -- -- NOTE: This is only called when interactive/color mode. , exampleProgress :: Handle -> Path -> Progress -> IO () -- | evaluated after each successful example , exampleSucceeded :: Path -> FormatM () -- | evaluated after each failed example , exampleFailed :: Path -> Either SomeException String -> FormatM () -- | evaluated after each pending example , examplePending :: Path -> Maybe String -> FormatM () -- | evaluated after a test run , failedFormatter :: FormatM () -- | evaluated after `failuresFormatter` , footerFormatter :: FormatM () } -- | Append an empty line to the report. -- -- Calling this multiple times has the same effect as calling it once. newParagraph :: FormatM () newParagraph = do f <- gets lastIsEmptyLine unless f $ do writeLine "" setLastIsEmptyLine True setLastIsEmptyLine :: Bool -> FormatM () setLastIsEmptyLine f = modify $ \s -> s {lastIsEmptyLine = f} -- | Append some output to the report. write :: String -> FormatM () write s = do h <- gets stateHandle liftIO $ IO.hPutStr h s setLastIsEmptyLine False -- | The same as `write`, but adds a newline character. writeLine :: String -> FormatM () writeLine s = write s >> write "\n" -- | Set output color to red, run given action, and finally restore the default -- color. withFailColor :: FormatM a -> FormatM a withFailColor = withColor (SetColor Foreground Dull Red) "hspec-failure" -- | Set output to color green, run given action, and finally restore the -- default color. withSuccessColor :: FormatM a -> FormatM a withSuccessColor = withColor (SetColor Foreground Dull Green) "hspec-success" -- | Set output color to yellow, run given action, and finally restore the -- default color. withPendingColor :: FormatM a -> FormatM a withPendingColor = withColor (SetColor Foreground Dull Yellow) "hspec-pending" -- | Set a color, run an action, and finally reset colors. withColor :: SGR -> String -> FormatM a -> FormatM a withColor color cls action = do r <- gets produceHTML (if r then htmlSpan cls else withColor_ color) action htmlSpan :: String -> FormatM a -> FormatM a htmlSpan cls action = write ("") *> action <* write "" withColor_ :: SGR -> FormatM a -> FormatM a withColor_ color (FormatM action) = do useColor <- gets stateUseColor h <- gets stateHandle FormatM . StateT $ \st -> do bracket_ -- set color (when useColor $ hSetSGR h [color]) -- reset colors (when useColor $ hSetSGR h [Reset]) -- run action (runStateT action st) -- | -- @finally_ actionA actionB@ runs @actionA@ and then @actionB@. @actionB@ is -- run even when a `UserInterrupt` occurs during @actionA@. finally_ :: FormatM () -> FormatM () -> FormatM () finally_ (FormatM actionA) (FormatM actionB) = FormatM . StateT $ \st -> do r <- try (execStateT actionA st) case r of Left e -> do when (e == UserInterrupt) $ runStateT actionB st >> return () throwIO e Right st_ -> do runStateT actionB st_ -- | Get the used CPU time since the test run has been started. getCPUTime :: FormatM (Maybe Double) getCPUTime = do t1 <- liftIO CPUTime.getCPUTime mt0 <- gets cpuStartTime return $ toSeconds <$> ((-) <$> pure t1 <*> mt0) where toSeconds x = fromIntegral x / (10.0 ^ (12 :: Integer)) -- | Get the passed real time since the test run has been started. getRealTime :: FormatM Double getRealTime = do t1 <- liftIO getPOSIXTime t0 <- gets startTime return (realToFrac $ t1 - t0) hspec-1.8.1.1/src/Test/Hspec/Runner/0000755000000000000000000000000012251063642015172 5ustar0000000000000000hspec-1.8.1.1/src/Test/Hspec/Runner/Eval.hs0000644000000000000000000001065412251063642016423 0ustar0000000000000000module Test.Hspec.Runner.Eval (runFormatter) where import Control.Monad import qualified Control.Exception as E import Control.Concurrent import System.IO (Handle) import Control.Monad.IO.Class (liftIO) import Test.Hspec.Util import Test.Hspec.Core.Type import Test.Hspec.Config import Test.Hspec.Formatters import Test.Hspec.Formatters.Internal import Test.Hspec.Timer import Data.Time.Clock.POSIX -- | Evaluate all examples of a given spec and produce a report. runFormatter :: Bool -> Handle -> Config -> Formatter -> [SpecTree] -> FormatM () runFormatter useColor h c formatter specs = do headerFormatter formatter chan <- liftIO newChan 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 -> Handle -> Config -> Formatter -> [SpecTree] -> FormatM () run chan useColor h c formatter specs = do liftIO $ do forM_ (zip [0..] specs) (queueSpec []) writeChan chan Done processChan chan (configFastFail c) where defer = writeChan chan . Run queueSpec :: [String] -> (Int, SpecTree) -> IO () queueSpec rGroups (n, SpecGroup group xs) = do defer (exampleGroupStarted formatter n (reverse rGroups) group) forM_ (zip [0..] xs) (queueSpec (group : rGroups)) defer (exampleGroupDone formatter) queueSpec rGroups (_, SpecItem (Item isParallelizable requirement e)) = queueExample isParallelizable (reverse rGroups, requirement) (`e` id) queueExample :: Bool -> Path -> (Params -> IO Result) -> IO () queueExample isParallelizable path e | isParallelizable = runParallel | otherwise = defer runSequentially where runSequentially :: FormatM () runSequentially = do progressHandler <- liftIO (mkProgressHandler reportProgress) result <- liftIO (evalExample e progressHandler) formatResult formatter path result runParallel = do mvar <- newEmptyMVar _ <- forkIO $ do progressHandler <- mkProgressHandler (replaceMVar mvar . ReportProgress) result <- evalExample e progressHandler replaceMVar mvar (ReportResult result) defer (evalReport mvar) where evalReport :: MVar Report -> FormatM () evalReport mvar = do r <- liftIO (takeMVar mvar) case r of ReportProgress p -> do liftIO $ reportProgress p evalReport mvar ReportResult result -> formatResult formatter path result reportProgress :: (Int, Int) -> IO () reportProgress = exampleProgress formatter h path mkProgressHandler :: (a -> IO ()) -> IO (a -> IO ()) mkProgressHandler report | useColor = every 0.05 report | otherwise = return . const $ return () evalExample :: (Params -> IO Result) -> (Progress -> IO ()) -> IO (Either E.SomeException Result) evalExample e progressHandler | configDryRun c = return (Right Success) | otherwise = (safeTry . fmap forceResult) (e $ Params (configQuickCheckArgs c) (configSmallCheckDepth c) progressHandler) replaceMVar :: MVar a -> a -> IO () replaceMVar mvar p = tryTakeMVar mvar >> putMVar mvar p processChan :: Chan Message -> Bool -> FormatM () processChan chan fastFail = go where go = do m <- liftIO (readChan chan) case m of Run action -> do action fails <- getFailCount unless (fastFail && fails /= 0) go Done -> return () formatResult :: Formatter -> ([String], String) -> Either E.SomeException Result -> FormatM () formatResult formatter path result = do case result of Right Success -> do increaseSuccessCount exampleSucceeded formatter path Right (Pending reason) -> do increasePendingCount examplePending formatter path reason Right (Fail err) -> failed (Right err) Left e -> failed (Left e) where failed err = do increaseFailCount addFailMessage path err exampleFailed formatter path err -- | Execute given action at most every specified number of seconds. every :: POSIXTime -> (a -> IO ()) -> IO (a -> IO ()) every seconds action = do timer <- newTimer seconds return $ \a -> do r <- timer when r (action a) hspec-1.8.1.1/src/Test/Hspec/Core/0000755000000000000000000000000012251063642014611 5ustar0000000000000000hspec-1.8.1.1/src/Test/Hspec/Core/QuickCheckUtil.hs0000644000000000000000000000155512251063642020023 0ustar0000000000000000{-# LANGUAGE CPP #-} module Test.Hspec.Core.QuickCheckUtil where import Data.IORef import Test.QuickCheck hiding (Result(..)) import Test.QuickCheck as QC import Test.QuickCheck.Property hiding (Result(..)) import qualified Test.QuickCheck.Property as QCP import Test.QuickCheck.IO () import Control.Applicative aroundProperty :: (IO () -> IO ()) -> Property -> Property aroundProperty action p = MkProp . aroundRose action . unProp <$> p aroundRose :: (IO () -> IO ()) -> Rose QCP.Result -> Rose QCP.Result aroundRose action r = ioRose $ do ref <- newIORef (return QCP.succeeded) action (reduceRose r >>= writeIORef ref) readIORef ref isUserInterrupt :: QC.Result -> Bool isUserInterrupt r = case r of #if MIN_VERSION_QuickCheck(2,6,0) QC.Failure {QC.interrupted = x} -> x #else QC.Failure {QC.reason = "Exception: 'user interrupt'"} -> True #endif _ -> False hspec-1.8.1.1/src/Test/Hspec/Core/Type.hs0000644000000000000000000001212312251063642016065 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, GeneralizedNewtypeDeriving, DeriveDataTypeable #-} module Test.Hspec.Core.Type ( Spec , SpecM (..) , runSpecM , fromSpecList , SpecTree (..) , Item (..) , Example (..) , Result (..) , Params (..) , Progress , describe , it , forceResult , pending , pendingWith ) where import qualified Control.Exception as E import Control.Applicative import Control.Monad (when) import Control.Monad.Trans.Writer (Writer, execWriter, tell) import Data.Typeable (Typeable) import Data.List (isPrefixOf) import Data.Maybe (fromMaybe) import Test.Hspec.Util import Test.Hspec.Expectations import Test.HUnit.Lang (HUnitFailure(..)) import qualified Test.QuickCheck as QC import qualified Test.QuickCheck.State as QC import qualified Test.QuickCheck.Property as QCP import qualified Test.QuickCheck.IO () import Test.Hspec.Core.QuickCheckUtil import Control.DeepSeq (deepseq) type Spec = SpecM () -- | A writer monad for `SpecTree` forests. newtype SpecM a = SpecM (Writer [SpecTree] a) deriving (Functor, Applicative, Monad) -- | Convert a `Spec` to a forest of `SpecTree`s. runSpecM :: Spec -> [SpecTree] runSpecM (SpecM specs) = execWriter specs -- | Create a `Spec` from a forest of `SpecTree`s. fromSpecList :: [SpecTree] -> Spec fromSpecList = SpecM . tell -- | The result of running an example. data Result = Success | Pending (Maybe String) | Fail String deriving (Eq, Show, Read, Typeable) forceResult :: Result -> Result forceResult r = case r of Success -> r Pending m -> r `seq` m `deepseq` r Fail m -> r `seq` m `deepseq` r instance E.Exception Result type Progress = (Int, Int) data Params = Params { paramsQuickCheckArgs :: QC.Args , paramsSmallCheckDepth :: Int , paramsReportProgress :: Progress -> IO () } -- | Internal representation of a spec. data SpecTree = SpecGroup String [SpecTree] | SpecItem Item data Item = Item { itemIsParallelizable :: Bool , itemRequirement :: String , itemExample :: Params -> (IO () -> IO ()) -> IO Result } -- | The @describe@ function combines a list of specs into a larger spec. describe :: String -> [SpecTree] -> SpecTree describe s = SpecGroup msg where msg | null s = "(no description given)" | otherwise = s -- | Create a spec item. it :: Example a => String -> a -> SpecTree it s e = SpecItem $ Item False msg (evaluateExample e) where msg | null s = "(unspecified behavior)" | otherwise = s -- | A type class for examples. class Example a where evaluateExample :: a -> Params -> (IO () -> IO ()) -> IO Result instance Example Bool where evaluateExample b _ _ = if b then return Success else return (Fail "") instance Example Expectation where evaluateExample e _ action = (action e >> return Success) `E.catches` [ E.Handler (\(HUnitFailure err) -> return (Fail err)) , E.Handler (return :: Result -> IO Result) ] instance Example Result where evaluateExample r _ _ = return r instance Example QC.Property where evaluateExample p c action = do r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) {QC.chatty = False} (QCP.callback progressCallback $ aroundProperty action p) when (isUserInterrupt r) $ do E.throwIO E.UserInterrupt return $ case r of QC.Success {} -> Success QC.Failure {QC.output = m} -> fromMaybe (Fail $ sanitizeFailureMessage m) (parsePending m) QC.GaveUp {QC.numTests = n} -> Fail ("Gave up after " ++ pluralize n "test" ) QC.NoExpectedFailure {} -> Fail ("No expected failure") where progressCallback = QCP.PostTest QCP.NotCounterexample $ \st _ -> paramsReportProgress c (QC.numSuccessTests st, QC.maxSuccessTests st) sanitizeFailureMessage :: String -> String sanitizeFailureMessage = strip . addFalsifiable . stripFailed addFalsifiable :: String -> String addFalsifiable m | "(after " `isPrefixOf` m = "Falsifiable " ++ m | otherwise = m stripFailed :: String -> String stripFailed m | prefix `isPrefixOf` m = drop n m | otherwise = m where prefix = "*** Failed! " n = length prefix parsePending :: String -> Maybe Result parsePending m | prefix `isPrefixOf` m = (readMaybe . takeWhile (/= '\'') . drop n) m | otherwise = Nothing where n = length prefix prefix = "*** Failed! Exception: '" -- | Specifies a pending example. -- -- If you want to textually specify a behavior but do not have an example yet, -- use this: -- -- > describe "fancyFormatter" $ do -- > it "can format text in a way that everyone likes" $ -- > pending pending :: Expectation pending = E.throwIO (Pending Nothing) -- | Specifies a pending example with a reason for why it's pending. -- -- > describe "fancyFormatter" $ do -- > it "can format text in a way that everyone likes" $ -- > pendingWith "waiting for clarification from the designers" pendingWith :: String -> Expectation pendingWith = E.throwIO . Pending . Just