packages feed

hspec 1.7.2.1 → 1.8.0

raw patch · 33 files changed

+290/−363 lines, 33 filesdep ~QuickCheckdep ~hspec-expectationsdep ~hspec-meta

Dependency ranges changed: QuickCheck, hspec-expectations, hspec-meta

Files

hspec-discover/src/Config.hs view
@@ -22,7 +22,7 @@   ]  usage :: String -> String-usage prog = "\nUsage: " ++ prog ++ " SRC CUR DST [--nested] [--formatter=FORMATTER]\n"+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
hspec-discover/src/Run.hs view
@@ -1,17 +1,26 @@ {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | A preprocessor that finds and combines specs.-module Run where+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           Data.Function import           System.Environment import           System.Exit import           System.IO-import           System.Directory+import           System.Directory (doesDirectoryExist, getDirectoryContents, doesFileExist) import           System.FilePath hiding (combine)  import           Config@@ -19,6 +28,8 @@ instance IsString ShowS where   fromString = showString +type Spec = String+ run :: [String] -> IO () run args_ = do   name <- getProgName@@ -28,25 +39,22 @@         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 -> [SpecNode] -> String+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)-  . format nodes+  . formatSpecs nodes   ) "\n"   where-    format-      | configNested c = formatSpecsNested-      | otherwise = formatSpecs-     driver =         showString "import Test.Hspec\n"       . showString "main :: IO ()\n"@@ -64,125 +72,48 @@ moduleName = reverse . dropWhile (== '.') . dropWhile (/= '.') . reverse  -- | Generate imports for a list of specs.-importList :: [SpecNode] -> ShowS-importList = go ""+importList :: [Spec] -> ShowS+importList = foldr (.) "" . map f   where-    go :: ShowS -> [SpecNode] -> ShowS-    go current = foldr (.) "" . map (f current)-    f current (SpecNode name inhabited children) = this . go (current . showString name . ".") children-      where-        this-          | inhabited = "import qualified " . current . showString name . "Spec\n"-          | otherwise = id+    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 :: [SpecNode] -> ShowS+formatSpecs :: [Spec] -> ShowS formatSpecs xs   | null xs   = "return ()"   | otherwise = sequenceS (map formatSpec xs)  -- | Convert a spec to code.-formatSpec :: SpecNode -> ShowS-formatSpec = sequenceS . go ""-  where-    go :: String -> SpecNode -> [ShowS]-    go current (SpecNode name inhabited children) = addThis $ concatMap (go (current ++ name ++ ".")) children-      where-        addThis :: [ShowS] -> [ShowS]-        addThis-          | inhabited = ("describe " . shows (current ++ name) . " " . showString (current ++ name ++ "Spec.spec") :)-          | otherwise = id---- | Convert a list of specs to code.------ Hierarchical modules are mapped to nested specs.-formatSpecsNested :: [SpecNode] -> ShowS-formatSpecsNested xs-  | null xs   = "return ()"-  | otherwise = sequenceS (map formatSpecNested xs)---- | Convert a spec to code.------ Hierarchical modules are mapped to nested specs.-formatSpecNested :: SpecNode -> ShowS-formatSpecNested = go ""-  where-    go current (SpecNode name inhabited children) = "describe " . shows name . " (" . specs . ")"-      where-        specs :: ShowS-        specs = (sequenceS . addThis . map (go (current . showString name . "."))) children-        addThis-          | inhabited = ((current . showString name . "Spec.spec") :)-          | otherwise = id--data SpecNode = SpecNode String Bool [SpecNode]-  deriving (Eq, Show)--specNodeName :: SpecNode -> String-specNodeName (SpecNode name _ _) = name--specNodeInhabited :: SpecNode -> Bool-specNodeInhabited (SpecNode _ inhabited _) = inhabited--specNodeChildren :: SpecNode -> [SpecNode]-specNodeChildren (SpecNode _ _ children) = children--getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])-getFilesAndDirectories dir = do-  c <- filter (`notElem` ["..", "."]) <$> getDirectoryContents dir-  dirs <- filterM (doesDirectoryExist . (dir </>)) c-  files <- filterM (doesFileExist . (dir </>)) c-  return (dirs, files)+formatSpec :: Spec -> ShowS+formatSpec name = "describe " . shows name . " " . showString name . "Spec.spec" --- | Find specs relative to given source file.------ The source file itself is not considered.-findSpecs :: FilePath -> IO [SpecNode]+findSpecs :: FilePath -> IO [Spec] findSpecs src = do   let (dir, file) = splitFileName src-  (dirs, files) <- getFilesAndDirectories dir-  go dir (dirs, filter (/= file) files)-  where-    go :: FilePath -> ([FilePath], [FilePath]) -> IO [SpecNode]-    go base (dirs, files) = do-      nestedSpecs <- forM dirs $ \d -> do-        let dir = base </> d-        SpecNode d False <$> (getFilesAndDirectories dir >>= go dir)-      (return . filterSpecs . combineSpecs) (specsFromFiles files ++ nestedSpecs)-      where-        specsFromFiles = catMaybes . map specFromFile-          where-            suffixes :: [String]-            suffixes = ["Spec.hs","Spec.lhs"]--            specFromFile :: FilePath -> Maybe SpecNode-            specFromFile file = msum $ map (specFromFile_ file) suffixes--            specFromFile_ :: FilePath -> String -> Maybe SpecNode-            specFromFile_ file suffix-              | suffix `isSuffixOf` file = Just $ SpecNode (dropEnd (length suffix) file) True []-              | otherwise = Nothing--            dropEnd :: Int -> [a] -> [a]-            dropEnd n = reverse . drop n . reverse--        -- remove empty leafs-        filterSpecs :: [SpecNode] -> [SpecNode]-        filterSpecs = filter (\x -> specNodeInhabited x || (not . null . specNodeChildren) x)+  mapMaybe fileToSpec . filter (/= file) <$> getFilesRecursive dir -        -- sort specs, and merge nodes with the same name-        combineSpecs :: [SpecNode] -> [SpecNode]-        combineSpecs = foldr f [] . sortBy (compare `on` specNodeName)-          where-            f x@(SpecNode n1 _ _) (y@(SpecNode n2 _ _):acc) | n1 == n2 = x `combine` y : acc-            f x acc = x : acc+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) -            x `combine` y = SpecNode name inhabited children-              where-                name      = specNodeName x-                inhabited = specNodeInhabited x || specNodeInhabited y-                children  = specNodeChildren x ++ specNodeChildren y+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-discover/test-data/lhs-spec/FooSpec.lhs 
− hspec-discover/test-data/lhs-spec/Spec.hs 
− hspec-discover/test-data/no-intermediate-specs/Foo/Bar/BazSpec.hs 
− hspec-discover/test-data/prefix-name/Foo/BazSpec.hs 
− hspec-discover/test-data/prefix-name/FooBar/BazSpec.hs 
− hspec-discover/test-data/prefix-name/FooBarSpec.hs 
− hspec-discover/test-data/prefix-name/FooSpec.hs 
− hspec-discover/test-data/several-specs/BarSpec.hs 
− hspec-discover/test-data/several-specs/BazSpec.hs 
− hspec-discover/test-data/several-specs/FooSpec.hs 
− hspec-discover/test-data/single-spec-nested/Foo/BarSpec.hs 
− hspec-discover/test-data/single-spec/FooSpec.hs 
− hspec-discover/test-data/single-spec/Spec.hs 
hspec-discover/test/ConfigSpec.hs view
@@ -22,16 +22,16 @@       parse ["--foo"] `shouldBe` (Left . unlines) [           "hspec-discover: unrecognized option `--foo'"         , ""-        , "Usage: hspec-discover SRC CUR DST [--nested] [--formatter=FORMATTER]"+        , "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 [--nested] [--formatter=FORMATTER]"+        , "Usage: hspec-discover SRC CUR DST [--formatter=FORMATTER]"         ]      context "when option is given multiple times" $ do-      it "the last occurrence takes precedence" $ do+      it "gives the last occurrence precedence" $ do         parse ["--formatter", "foo", "--formatter", "bar"] `shouldBe` Right (defaultConfig {configFormatter = Just "bar"})
hspec-discover/test/RunSpec.hs view
@@ -2,47 +2,82 @@  import           Test.Hspec.Meta -import           Data.List (intercalate)+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 "findSpecs" $ do-    context "when specs are not nested" $ do-      it "finds a single spec" $ do-        findSpecs "hspec-discover/test-data/single-spec/Spec.hs" `shouldReturn` [SpecNode "Foo" True []]+  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 "finds several specs" $ do-        findSpecs "hspec-discover/test-data/several-specs/Spec.hs" `shouldReturn` [SpecNode "Bar" True [], SpecNode "Baz" True [], SpecNode "Foo" True []]+    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 ()"+        ] -      it "discovers .lhs files" $ do-        findSpecs "hspec-discover/test-data/lhs-spec/Spec.hs" `shouldReturn` [SpecNode "Foo" True []]+  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"+        ] -    context "when specs are nested" $ do-      it "finds a single spec" $ do-        findSpecs "hspec-discover/test-data/single-spec-nested/Spec.hs" `shouldReturn` [SpecNode "Foo" False [SpecNode "Bar" True []]]+  describe "fileToSpec" $ do+    it "converts path to spec name" $ do+      fileToSpec "FooSpec.hs" `shouldBe` Just "Foo" -      it "properly groups nested specs" $ do-        findSpecs "hspec-discover/test-data/nested-spec/Spec.hs" `shouldReturn` [SpecNode "Foo" True [SpecNode "Bar" True [SpecNode "Baz" True []]]]+    it "rejects spec with empty name" $ do+      fileToSpec "Spec.hs" `shouldBe` Nothing -    context "given a nested spec, without specs at the intermediate nodes" $ do-      it "finds a single spec" $ do-        findSpecs "hspec-discover/test-data/no-intermediate-specs/Spec.hs" `shouldReturn` [SpecNode "Foo" False [SpecNode "Bar" False [SpecNode "Baz" True []]]]+    it "works for lhs files" $ do+      fileToSpec "FooSpec.lhs" `shouldBe` Just "Foo" -    context "given a nested specs, with specs at the intermediate nodes" $ do-      context "with two top-level specs, where one spec name is a prefix of the other" $ do-        it "properly sorts specs" $ do-          findSpecs "hspec-discover/test-data/prefix-name/Spec.hs" `shouldReturn`-            [SpecNode "Foo" True [SpecNode "Baz" True []], SpecNode "FooBar" True [SpecNode "Baz" True []]]+    it "returns Nothing for invalid spec name" $ do+      fileToSpec "foo" `shouldBe` Nothing -    context "when there are no specs" $ do-      it "returns an empty list" $ do-        findSpecs "hspec-discover/test-data/empty-dir/Spec.hs" `shouldReturn` []+    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" [@@ -57,52 +92,9 @@     it "returns the module name of an fully qualified identifier" $ do       moduleName "Some.Module.someId" `shouldBe` "Some.Module" -  describe "formatSpec" $ do-    it "generates code for a spec" $-      formatSpec (SpecNode "Foo" True []) "" `shouldBe` "describe \"Foo\" FooSpec.spec"--    it "generates code for a nested spec" $-      formatSpec (SpecNode "Foo" True [SpecNode "Bar" True [SpecNode "Baz" True []]]) "" `shouldBe`-        "describe \"Foo\" FooSpec.spec >> describe \"Foo.Bar\" Foo.BarSpec.spec >> describe \"Foo.Bar.Baz\" Foo.Bar.BazSpec.spec"--  describe "formatSpecs" $ do-    it "generates code for a list of specs" $ do-      formatSpecs [SpecNode "Bar" True [], SpecNode "Baz" True [], SpecNode "Foo" True []] "" `shouldBe`-        "describe \"Bar\" BarSpec.spec >> describe \"Baz\" BazSpec.spec >> describe \"Foo\" FooSpec.spec"--    it "generates code for an empty list" $ do-      formatSpecs [] "" `shouldBe`-        "return ()"--  describe "formatSpecNested" $ do-    it "generates code for a spec" $-      formatSpecNested (SpecNode "Foo" True []) "" `shouldBe` "describe \"Foo\" (FooSpec.spec)"--    it "generates code for a nested spec" $-      formatSpecNested (SpecNode "Foo" True [SpecNode "Bar" True [SpecNode "Baz" True []]]) "" `shouldBe`-        "describe \"Foo\" (FooSpec.spec >> describe \"Bar\" (Foo.BarSpec.spec >> describe \"Baz\" (Foo.Bar.BazSpec.spec)))"--  describe "formatSpecsNested" $ do-    it "generates code for a list of specs" $ do-      formatSpecsNested [SpecNode "Bar" True [], SpecNode "Baz" True [], SpecNode "Foo" True []] "" `shouldBe`-        "describe \"Bar\" (BarSpec.spec) >> describe \"Baz\" (BazSpec.spec) >> describe \"Foo\" (FooSpec.spec)"--    it "generates code for an empty list" $ do-      formatSpecsNested [] "" `shouldBe`-        "return ()"-   describe "importList" $ do-    it "generates imports for a spec" $ do-      importList [SpecNode "Foo" True []] "" `shouldBe` "import qualified FooSpec\n"--    it "generates imports for a nested spec" $-      importList [SpecNode "Foo" True [SpecNode "Bar" True [SpecNode "Baz" True []]]] "" `shouldBe`-        "import qualified FooSpec\nimport qualified Foo.BarSpec\nimport qualified Foo.Bar.BazSpec\n"-     it "generates imports for a list of specs" $ do-      importList [SpecNode "Bar" True [], SpecNode "Baz" True [], SpecNode "Foo" True []] "" `shouldBe`-        "import qualified BarSpec\nimport qualified BazSpec\nimport qualified FooSpec\n"--    it "generates imports for a nested spec that has no specs at the intermediate nodes" $ do-      importList [SpecNode "Foo" False [SpecNode "Bar" False [SpecNode "Baz" True []]]] "" `shouldBe`-        "import qualified Foo.Bar.BazSpec\n"+      importList ["Foo", "Bar"] "" `shouldBe` unlines [+          "import qualified FooSpec"+        , "import qualified BarSpec"+        ]
hspec.cabal view
@@ -1,5 +1,5 @@ name:             hspec-version:          1.7.2.1+version:          1.8.0 license:          MIT license-file:     LICENSE copyright:        (c) 2011-2013 Simon Hengel,@@ -24,23 +24,10 @@  -- find hspec-discover/test-data/ -type f extra-source-files:-  hspec-discover/test-data/single-spec/FooSpec.hs-  hspec-discover/test-data/single-spec/Spec.hs-  hspec-discover/test-data/single-spec-nested/Foo/BarSpec.hs   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/lhs-spec/FooSpec.lhs-  hspec-discover/test-data/lhs-spec/Spec.hs-  hspec-discover/test-data/several-specs/BarSpec.hs-  hspec-discover/test-data/several-specs/FooSpec.hs-  hspec-discover/test-data/several-specs/BazSpec.hs   hspec-discover/test-data/empty-dir/Foo/Bar/Baz/.placeholder-  hspec-discover/test-data/prefix-name/FooSpec.hs-  hspec-discover/test-data/prefix-name/Foo/BazSpec.hs-  hspec-discover/test-data/prefix-name/FooBarSpec.hs-  hspec-discover/test-data/prefix-name/FooBar/BazSpec.hs-  hspec-discover/test-data/no-intermediate-specs/Foo/Bar/BazSpec.hs  source-repository head   type: git@@ -62,7 +49,7 @@     , HUnit         >= 1.2.5     , QuickCheck    >= 2.5.1     , quickcheck-io-    , hspec-expectations == 0.3.3.*+    , hspec-expectations == 0.4.0.*   exposed-modules:       Test.Hspec       Test.Hspec.Core@@ -75,6 +62,7 @@       Test.Hspec.Util       Test.Hspec.Compat       Test.Hspec.Core.Type+      Test.Hspec.Core.QuickCheckUtil       Test.Hspec.Config       Test.Hspec.Options       Test.Hspec.FailureReport@@ -119,7 +107,7 @@     , quickcheck-io     , hspec-expectations -    , hspec-meta >= 1.7.1+    , hspec-meta >= 1.8.0     , process     , ghc-paths 
src/Test/Hspec.hs view
@@ -1,23 +1,12 @@ -- | -- Stability: stable ----- Hspec is a framework for /Behavior-Driven Development (BDD)/ in Haskell. BDD--- is an approach to software development that combines Test-Driven--- Development, Domain-Driven Design, and Acceptance Test-Driven Planning.--- Hspec helps you do the TDD part of that equation, focusing on the--- documentation and design aspects of TDD.+-- Hspec is a testing library for Haskell. ----- Hspec (and the preceding intro) are based on the Ruby library RSpec. Much of--- what applies to RSpec also applies to Hspec. Hspec ties together--- /textual descriptions/ of behavior and /examples/ for that behavior.  The--- examples serve as test cases for the specified behavior.  Hspec's mechanism--- for examples is extensible.  Support for QuickCheck properties and HUnit--- tests is included in the core package.+-- This is the library reference for Hspec.+-- The <http://hspec.github.io/ User's Manual> contains more in-depth+-- documentation. module Test.Hspec (---- * Introduction--- $intro- -- * Types   Spec , Example@@ -45,73 +34,9 @@ import           Test.Hspec.Runner import           Test.Hspec.HUnit () import           Test.Hspec.Expectations+import           Test.Hspec.Core (mapSpecItem) import qualified Test.Hspec.Core as Core -import           Data.IORef-import           Control.Applicative---- $intro------ The three functions you'll use the most are 'hspec', 'describe', and 'it'.--- Here is an example of functions that format and unformat phone numbers and--- the specs for them.------ > import Test.Hspec--- > import Test.QuickCheck--- > import Test.HUnit--- >--- > main :: IO ()--- > main = hspec spec------ Since the specs are often used to tell you what to implement, it's best to--- start with undefined functions. Once we have some specs, then you can--- implement each behavior one at a time, ensuring that each behavior is met--- and there is no undocumented behavior.------ > unformatPhoneNumber :: String -> String--- > unformatPhoneNumber = undefined--- >--- > formatPhoneNumber :: String -> String--- > formatPhoneNumber = undefined------ The 'describe' function takes a list of behaviors and examples bound--- together with the 'it' function------ > spec :: Spec--- > spec = do--- >   describe "unformatPhoneNumber" $ do------ A `Bool` can be used as an example.------ >     it "removes dashes, spaces, and parenthesies" $--- >       unformatPhoneNumber "(555) 555-1234" == "5555551234"--------- The 'pending' function marks a behavior as pending an example. The example--- doesn't count as failing.------ >     it "handles non-US phone numbers" $--- >       pending "need to look up how other cultures format phone numbers"------ An HUnit 'Test.HUnit.Lang.Assertion' can be used as an example.------ >     it "converts letters to numbers" $ do--- >       let expected = "6862377"--- >           actual   = unformatPhoneNumber "NUMBERS"--- >       actual @?= expected--------- A QuickCheck 'Test.QuickCheck.Property' can be used as an example.------ >     it "can add and remove formatting without changing the number" $ property $--- >       forAll phoneNumber $ \n -> unformatPhoneNumber (formatPhoneNumber n) == n--- >--- > phoneNumber :: Gen String--- > phoneNumber = do--- >   n <- elements [7,10,11,12,13,14,15]--- >   vectorOf n (elements "0123456789")-- -- | Combine a list of specs into a larger spec. describe :: String -> Spec -> Spec describe label action = fromSpecList [Core.describe label (runSpecM action)]@@ -151,29 +76,16 @@  -- | Run examples of given spec in parallel. parallel :: Spec -> Spec-parallel = mapSpecItem $ \_ r e -> SpecItem True r e+parallel = mapSpecItem $ \item -> item {itemIsParallelizable = True}  -- | Run a custom action before every spec item. before :: IO () -> Spec -> Spec-before action = mapSpecItem $ \b r e -> SpecItem b r (\params -> action *> e params)+before action = around (action >>)  -- | Run a custom action after every spec item. after :: IO () -> Spec -> Spec-after action = mapSpecItem $ \b r e -> SpecItem b r (\params -> e params <* action)+after action = around (>> action)  -- | Run a custom action before and/or after every spec item. around :: (IO () -> IO ()) -> Spec -> Spec-around action = mapSpecItem $ \b r e -> SpecItem b r (\params -> wrap (e params))-  where-    wrap e = do-      ref <- newIORef (Fail "")-      action (e >>= writeIORef ref)-      readIORef ref--mapSpecItem :: (Bool -> String -> (Params -> IO Result) -> SpecTree) -> Spec -> Spec-mapSpecItem f = fromSpecList . map go . runSpecM-  where-    go :: SpecTree -> SpecTree-    go spec = case spec of-      SpecItem b r e -> f b r e-      SpecGroup d es -> SpecGroup d (map go es)+around a2 = mapSpecItem $ \item -> item {itemExample = \params a1 -> itemExample item params (a1 . a2)}
src/Test/Hspec/Compat.hs view
@@ -2,7 +2,6 @@ module Test.Hspec.Compat (   showType , showFullType-, isUserInterrupt , readMaybe , module Data.IORef #if !MIN_VERSION_base(4,6,0)@@ -11,7 +10,6 @@ ) where  import           Data.Typeable (Typeable, typeOf, typeRepTyCon)-import qualified Test.QuickCheck as QC import           Text.Read import           Data.IORef @@ -71,12 +69,3 @@ #else   show t #endif--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
src/Test/Hspec/Core.hs view
@@ -18,11 +18,13 @@  -- * Internal representation of a spec tree , SpecTree (..)+, Item (..)+, mapSpecItem+, modifyParams , describe , it  -- * Deprecated types and functions-, Spec , Specs , hspecB , hspecX@@ -33,13 +35,24 @@ import           Control.Applicative import           System.IO (Handle) -import           Test.Hspec.Core.Type hiding (Spec)+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@@ -55,9 +68,6 @@ {-# 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 Spec "use `SpecTree` instead" #-}                      -- since 1.4.0-type Spec = SpecTree  {-# DEPRECATED Specs "use `[SpecTree]` instead" #-}                   -- since 1.4.0 type Specs = [SpecTree]
+ src/Test/Hspec/Core/QuickCheckUtil.hs view
@@ -0,0 +1,28 @@+{-# 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
src/Test/Hspec/Core/Type.hs view
@@ -5,6 +5,7 @@ , runSpecM , fromSpecList , SpecTree (..)+, Item (..) , Example (..) , Result (..) , Params (..)@@ -34,10 +35,9 @@ import qualified Test.QuickCheck.Property as QCP import qualified Test.QuickCheck.IO () -import           Test.Hspec.Compat (isUserInterrupt)+import           Test.Hspec.Core.QuickCheckUtil import           Control.DeepSeq (deepseq) - type Spec = SpecM ()  -- | A writer monad for `SpecTree` forests.@@ -75,8 +75,14 @@ -- | Internal representation of a spec. data SpecTree =     SpecGroup String [SpecTree]-  | SpecItem Bool String (Params -> IO Result)+  | 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@@ -87,7 +93,7 @@  -- | Create a spec item. it :: Example a => String -> a -> SpecTree-it s e = SpecItem False msg (`evaluateExample` e)+it s e = SpecItem $ Item False msg (evaluateExample e)   where     msg       | null s = "(unspecified behavior)"@@ -95,23 +101,23 @@  -- | A type class for examples. class Example a where-  evaluateExample :: Params -> a -> IO Result+  evaluateExample :: a -> Params -> (IO () -> IO ()) -> IO Result  instance Example Bool where-  evaluateExample _ b = if b then return Success else return (Fail "")+  evaluateExample b _ _ = if b then return Success else return (Fail "")  instance Example Expectation where-  evaluateExample _ action = (action >> return Success) `E.catches` [-      E.Handler (\(HUnitFailure err) -> (return . Fail) err)+  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 _ = return+  evaluateExample r _ _ = return r  instance Example QC.Property where-  evaluateExample c p = do-    r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) {QC.chatty = False} (QCP.callback progressCallback p)+  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 
src/Test/Hspec/HUnit.hs view
@@ -12,7 +12,7 @@  -- | This instance is deprecated, use `Test.Hspec.HUnit.fromHUnitTest` instead! instance Example Test where-  evaluateExample _ test = do+  evaluateExample test _ _ = do     (counts, fails) <- HU.runTestText HU.putTextToShowS test     let r = if HU.errors counts + HU.failures counts == 0              then Success
src/Test/Hspec/QuickCheck.hs view
@@ -1,19 +1,24 @@ -- | -- 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+, property -- * Shortcuts , prop ) where  import           Test.QuickCheck import           Test.Hspec+import           Test.Hspec.Core (Params(..), modifyParams)  -- | -- > prop ".." $@@ -25,3 +30,30 @@ -- >   .. 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)}
src/Test/Hspec/Runner.hs view
@@ -53,7 +53,7 @@      goSpec :: [String] -> SpecTree -> Maybe SpecTree     goSpec groups spec = case spec of-      SpecItem _ requirement _ -> guard (p (groups, requirement)) >> return spec+      SpecItem item -> guard (p (groups, itemRequirement item)) >> return spec       SpecGroup group specs     -> case goSpecs (groups ++ [group]) specs of         [] -> Nothing         xs -> Just (SpecGroup group xs)
src/Test/Hspec/Runner/Eval.hs view
@@ -40,8 +40,8 @@       defer (exampleGroupStarted formatter n (reverse rGroups) group)       forM_ (zip [0..] xs) (queueSpec (group : rGroups))       defer (exampleGroupDone formatter)-    queueSpec rGroups (_, SpecItem isParallelizable requirement e) =-      queueExample isParallelizable (reverse rGroups, requirement) e+    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
src/Test/Hspec/Util.hs view
@@ -85,7 +85,7 @@ 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 beraks at word+-- 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
test/Helper.hs view
@@ -34,7 +34,8 @@ import           Test.Hspec.Meta import           Test.QuickCheck hiding (Result(..)) -import qualified Test.Hspec.Core as H (Result(..), Params(..), fromSpecList, SpecTree(..))+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 ()@@ -73,6 +74,8 @@ shouldUseArgs :: [String] -> (Args -> Bool) -> Expectation shouldUseArgs args p = do   spy <- newIORef (H.paramsQuickCheckArgs defaultParams)-  let spec = H.fromSpecList [H.SpecItem False "foo" $ \params -> writeIORef spy (H.paramsQuickCheckArgs params) >> return (H.Fail "example failed")]+  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)
test/Test/Hspec/Core/TypeSpec.hs view
@@ -3,6 +3,7 @@ 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)@@ -13,8 +14,11 @@ main = hspec spec  evaluateExample :: H.Example e => e -> IO H.Result-evaluateExample = H.evaluateExample (defaultParams {H.paramsQuickCheckArgs = (H.paramsQuickCheckArgs defaultParams) {replay = Just (read "", 0)}})+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@@ -38,6 +42,17 @@       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@@ -62,6 +77,17 @@           , "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)@@ -78,7 +104,7 @@         evaluateExample p `shouldThrow` (== UserInterrupt)        it "propagates exceptions" $ do-        pendingWith "this probaly needs a patch to QuickCheck"+        pendingWith "this probably needs a patch to QuickCheck"         -- evaluateExample (property $ (error "foobar" :: Int -> Bool)) `shouldThrow` errorCall "foobar"        context "when used with `pending`" $ do@@ -99,7 +125,7 @@             (reverse . reverse) xs `shouldBe` (xs :: [Int])         mockCounter e `shouldReturn` 100 -      it "can be used with expecatations/HUnit assertions" $ do+      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
test/Test/Hspec/FormattersSpec.hs view
@@ -154,9 +154,6 @@       r <- runSpec testSpec       r `shouldSatisfy` any (== "     # PENDING: pending message") -    it "outputs failed examples in red, pending in yellow, and successful in green" $ do-      pending-     context "same as failed_examples" $ do       failed_examplesSpec H.progress 
test/Test/Hspec/HUnitSpec.hs view
@@ -4,7 +4,7 @@  import qualified Test.Hspec as H import qualified Test.Hspec.Runner as H-import           Test.Hspec.Core.Type (SpecTree(..), runSpecM)+import           Test.Hspec.Core.Type (SpecTree(..), Item(..), runSpecM) import           Test.Hspec.HUnit import           Test.HUnit @@ -24,7 +24,7 @@         go :: SpecTree -> Tree         go x = case x of           SpecGroup s xs  -> Group s (map go xs)-          SpecItem _ s _  -> Example s+          SpecItem item -> Example (itemRequirement item)  spec :: Spec spec = do
test/Test/HspecSpec.hs view
@@ -2,10 +2,10 @@  import           Helper import           Mock+import           Data.IORef import           Data.List (isPrefixOf) -import           Data.IORef-import           Test.Hspec.Core (SpecTree(..), Result(..), runSpecM)+import           Test.Hspec.Core (SpecTree(..), Item(..), Result(..), runSpecM) import qualified Test.Hspec as H import qualified Test.Hspec.Runner as H (hspecResult) @@ -42,7 +42,7 @@       length r `shouldBe` 3      it "can be nested" $ do-      let [SpecGroup foo [SpecGroup bar [SpecItem _ baz _]]] = runSpecM $ do+      let [SpecGroup foo [SpecGroup bar [SpecItem Item {itemRequirement = baz}]]] = runSpecM $ do             H.describe "foo" $ do               H.describe "bar" $ do                 H.it "baz" True@@ -55,17 +55,17 @@    describe "it" $ do     it "takes a description of a desired behavior" $ do-      let [SpecItem _ d _] = runSpecM (H.it "whatever" True)-      d `shouldBe` "whatever"+      let [SpecItem item] = runSpecM (H.it "whatever" True)+      itemRequirement item `shouldBe` "whatever"      it "takes an example of that behavior" $ do-      let [SpecItem _ _ e] = runSpecM (H.it "whatever" True)-      e defaultParams `shouldReturn` Success+      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 _ d _] = runSpecM (H.it "" True)-        d `shouldBe` "(unspecified behavior)"+        let [SpecItem item] = runSpecM (H.it "" True)+        itemRequirement item `shouldBe` "(unspecified behavior)"    describe "example" $ do     it "fixes the type of an expectation" $ do@@ -76,15 +76,15 @@    describe "parallel" $ do     it "marks examples for parallel execution" $ do-      let [SpecItem isParallelizable _ _] = runSpecM . H.parallel $ H.it "whatever" True-      isParallelizable `shouldBe` True+      let [SpecItem item] = runSpecM . H.parallel $ H.it "whatever" True+      itemIsParallelizable item `shouldBe` True      it "is applied recursively" $ do-      let [SpecGroup _ [SpecGroup _ [SpecItem isParallelizable _ _]]] = runSpecM . H.parallel $ do+      let [SpecGroup _ [SpecGroup _ [SpecItem item]]] = runSpecM . H.parallel $ do             H.describe "foo" $ do               H.describe "bar" $ do                 H.it "baz" True-      isParallelizable `shouldBe` True+      itemIsParallelizable item `shouldBe` True    describe "before" $ do     it "runs an action before each spec item" $ do@@ -96,6 +96,19 @@           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@@ -107,16 +120,16 @@       mockCounter mock `shouldReturn` 2    describe "around" $ do-    it "runs an action before and/or after each spec item" $ do+    it "wraps each spec item with an action" $ do       ref <- newIORef (0 :: Int)-      let wrapper :: IO () -> IO ()-          wrapper e = do+      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 wrapper $ do+      silence $ H.hspec $ H.around action $ do         H.it "foo" $ do           readIORef ref `shouldReturn` 1           writeIORef ref 2