hspec-hedgehog 0.1.1.0 → 0.3.0.0
raw patch · 7 files changed
Files
- ChangeLog.md +11/−0
- README.md +0/−2
- hspec-hedgehog.cabal +29/−18
- src/Test/Hspec/Hedgehog.hs +22/−6
- test/ExampleSpec.hs +59/−0
- test/Spec.hs +1/−58
- test/Test/Hspec/HedgehogSpec.hs +86/−0
ChangeLog.md view
@@ -1,5 +1,16 @@ # Changelog for hspec-hedgehog +## 0.3.0.0++- [#45](https://github.com/hspec/hspec-hedgehog/pull/45) @ChickenProp+ - Set `propertyDiscardLimit` correctly.+- [#44](https://github.com/hspec/hspec-hedgehog/pull/44) @ChickenProp+ - Don't re-export `modifyMaxSize`, which is a no-op.++## 0.2.0.0+ - [#29](https://github.com/parsonsmatt/hspec-hedgehog/pull/29) @sol+ - Show less context on failure.+ ## 0.1.1.0 - [#30](https://github.com/parsonsmatt/hspec-hedgehog/pull/30) @sol - Show classification on success
README.md view
@@ -1,7 +1,5 @@ # hspec-hedgehog -[](https://travis-ci.org/parsonsmatt/hspec-hedgehog)- An integration library for [hspec](https://hackage.haskell.org/package/hspec) and [hedgehog](https://hackage.haskell.org/package/hedgehog). Example:
hspec-hedgehog.cabal view
@@ -1,11 +1,16 @@ cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.36.0.+--+-- see: https://github.com/sol/hpack+ name: hspec-hedgehog-version: 0.1.1.0-description: Please see the README on GitHub at <https://github.com/parsonsmatt/hspec-hedgehog#readme>+version: 0.3.0.0+description: Please see the README on GitHub at <https://github.com/hspec/hspec-hedgehog#readme> synopsis: Integrate Hedgehog and Hspec! category: Testing-homepage: https://github.com/parsonsmatt/hspec-hedgehog#readme-bug-reports: https://github.com/parsonsmatt/hspec-hedgehog/issues+homepage: https://github.com/hspec/hspec-hedgehog#readme+bug-reports: https://github.com/hspec/hspec-hedgehog/issues author: Matt Parsons maintainer: parsonsmatt@gmail.com copyright: 2020 Matt Parsons@@ -18,7 +23,7 @@ source-repository head type: git- location: https://github.com/parsonsmatt/hspec-hedgehog+ location: https://github.com/hspec/hspec-hedgehog library exposed-modules:@@ -26,24 +31,30 @@ hs-source-dirs: src build-depends:- base >= 4.7 && < 5- , hspec >= 2.11.0 && < 3- , hspec-core >= 2.11.0 && < 3- , hedgehog >= 1.0.2 && < 2- , QuickCheck >= 2.9.2 && < 3- , splitmix >= 0.0.1 && < 1+ QuickCheck >=2.9.2 && <3+ , base >=4.7 && <5+ , hedgehog >=1.5+ , hspec >=2.11.0 && <3+ , hspec-core >=2.11.0 && <3+ , splitmix >=0.0.1 && <1 default-language: Haskell2010 -test-suite hspec-hedgehog-test+test-suite spec type: exitcode-stdio-1.0- main-is: - Spec.hs+ main-is: Spec.hs+ other-modules:+ ExampleSpec+ Test.Hspec.HedgehogSpec hs-source-dirs: test- ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-tool-depends:+ hspec-discover:hspec-discover build-depends:- base >= 4.7 && < 5+ HUnit+ , QuickCheck+ , base >=4.7 && <5+ , hedgehog >=1.5+ , hspec >=2.11.0 && <3+ , hspec-core >=2.11.0 && <3 , hspec-hedgehog- , hspec- , hedgehog >= 1.0.2 && < 2 default-language: Haskell2010
src/Test/Hspec/Hedgehog.hs view
@@ -84,16 +84,19 @@ ( -- * The Main Function hedgehog -- * Hspec re-exports+ --+ -- | 'Test.Hspec.QuickCheck.modifyMaxSize' isn't re-exported, since+ -- hedgehog has nothing that corresponds to it. , modifyArgs , modifyMaxSuccess , modifyMaxDiscardRatio- , modifyMaxSize , modifyMaxShrinks -- * Hedgehog Re-exports , module Hedgehog ) where import Control.Monad.IO.Class (liftIO)+import Data.Char (isSpace) import Data.Coerce (coerce) import Data.IORef (newIORef, readIORef, writeIORef) import GHC.Stack (withFrozenCallStack)@@ -105,7 +108,6 @@ TerminationCriteria (..), TestCount (..), TestLimit (..)) import Hedgehog.Internal.Report hiding (renderResult)-import qualified Hedgehog.Internal.Report as Hedge import Hedgehog.Internal.Runner (checkReport) import qualified Hedgehog.Internal.Seed as Seed import Hedgehog.Internal.Source (ColumnNo (..), LineNo (..),@@ -114,8 +116,7 @@ import Test.Hspec import Test.Hspec.Core.Spec as Hspec import Test.Hspec.QuickCheck (modifyArgs, modifyMaxDiscardRatio,- modifyMaxShrinks, modifyMaxSize,- modifyMaxSuccess)+ modifyMaxShrinks, modifyMaxSuccess) import Test.QuickCheck.Random (QCGen (..)) import Test.QuickCheck.Test (Args (..)) @@ -184,7 +185,7 @@ NoConfidenceTermination (TestLimit _) -> NoConfidenceTermination (TestLimit maxTests) , propertyDiscardLimit =- DiscardLimit $ maxDiscardRatio qcArgs+ DiscardLimit $ maxDiscardRatio qcArgs * maxTests , propertyShrinkLimit = ShrinkLimit $ maxShrinks qcArgs }@@ -203,7 +204,14 @@ Just (rng, _) -> pure (uncurry Seed (unseedSMGen (coerce rng))) hedgeResult <- checkReport propConfig size seed (propertyTest prop) cb - let renderResult color = Hedge.renderResult color (Just "property") hedgeResult+ let+ config = defaultConfig {+ configContext = Context 3+ , configPrintFailedAtLocation = False+ , configPrintReproduceMessage = False+ , configPrintPrefixIcons = DisablePrefixIcons+ }+ renderResult color = unlines . unindent . lines . dropWhileEnd isSpace <$> renderResultWith config color (Just "") hedgeResult case reportStatus hedgeResult of Failed FailureReport{..} -> do@@ -223,3 +231,11 @@ ppresult <- renderResult DisableColor writeIORef ref $ Result ppresult Success readIORef ref++dropWhileEnd :: (a -> Bool) -> [a] -> [a]+dropWhileEnd p = reverse . dropWhile p . reverse++unindent :: [String] -> [String]+unindent xs = map (drop indentation) xs+ where+ indentation = minimum $ map (length . takeWhile (== ' ')) xs
+ test/ExampleSpec.hs view
@@ -0,0 +1,59 @@+module ExampleSpec (spec) where+import Test.Hspec+import Control.Concurrent (threadDelay)+import Control.Monad.IO.Class (liftIO)+import Data.IORef (atomicModifyIORef', readIORef, newIORef)+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import Test.Hspec.Hedgehog (PropertyT, diff, forAll, hedgehog,+ (/==), (===))+import Test.Hspec.QuickCheck (modifyMaxSuccess)++spec :: Spec+spec = do+ describe "regular tests" $ do+ it "works" $ do+ True `shouldBe` True++ describe "hedgehog" $ do+ it "is useful if you get an ambiguous error" $ hedgehog $ do+ "no ambiguity" === "no ambiguity"++ describe "hedgehog tests" $ do+ it "lets you use PropertyT directly" $ hedgehog $ do+ x <- forAll $ Gen.integral (Range.linear 0 1000)+ y <- forAll $ Gen.integral (Range.linear 0 5000)+ diff (x + y) (>=) (x :: Integer)++ it "lets you use PropertyT directly without forcing the type" $ do+ x <- forAll $ Gen.integral (Range.linear 0 1000)+ y <- forAll $ Gen.integral (Range.linear 0 5000)+ diff (x + y) (>=) (x :: Integer)++ it "renders a progress bit" $ hedgehog $ do+ x <- forAll $ Gen.integral (Range.linear 0 1000)+ y <- forAll $ Gen.integral (Range.linear 1 5000)+ liftIO $ threadDelay (100 * x + y)++ describe "with hooks" $ do+ before (pure "Hello!") $ do+ it "has functions" $ \str -> hedgehog $+ str === "Hello!"++ it "goes before or after" $ \str -> do+ pure () :: PropertyT IO ()+ str === "Hello!"++ it "generates" $ \str -> hedgehog $ do+ wrongLen <- forAll $ Gen.integral (Range.linear 0 3)+ length str /== wrongLen++ describe "modifyMaxSuccess" $ do+ modifyMaxSuccess (\_ -> 10) $ do+ beforeAll (newIORef (0 :: Integer)) $ do+ it "counts to 10" $ \ref -> hedgehog $ do+ liftIO $ atomicModifyIORef' ref (\a -> (a + 1, ()))+ True === True+ it "works" $ \ref -> do+ val <- readIORef ref+ val `shouldBe` 10
test/Spec.hs view
@@ -1,58 +1,1 @@-import Control.Concurrent (threadDelay)-import Control.Monad.IO.Class (liftIO)-import Data.IORef (atomicModifyIORef', readIORef, newIORef)-import qualified Hedgehog.Gen as Gen-import qualified Hedgehog.Range as Range-import Test.Hspec (before, beforeAll, describe, hspec, it, shouldBe)-import Test.Hspec.Hedgehog (PropertyT, diff, forAll, hedgehog,- (/==), (===))-import Test.Hspec.QuickCheck (modifyMaxSuccess)--main :: IO ()-main = hspec $ do- describe "regular tests" $ do- it "works" $ do- True `shouldBe` True-- describe "hedgehog" $ do- it "is useful if you get an ambiguous error" $ hedgehog $ do- "no ambiguity" === "no ambiguity"-- describe "hedgehog tests" $ do- it "lets you use PropertyT directly" $ hedgehog $ do- x <- forAll $ Gen.integral (Range.linear 0 1000)- y <- forAll $ Gen.integral (Range.linear 0 5000)- diff (x + y) (>=) (x :: Integer)- - it "lets you use PropertyT directly without forcing the type" $ do- x <- forAll $ Gen.integral (Range.linear 0 1000)- y <- forAll $ Gen.integral (Range.linear 0 5000)- diff (x + y) (>=) (x :: Integer)-- it "renders a progress bit" $ hedgehog $ do- x <- forAll $ Gen.integral (Range.linear 0 1000)- y <- forAll $ Gen.integral (Range.linear 1 5000)- liftIO $ threadDelay (100 * x + y)-- describe "with hooks" $ do- before (pure "Hello!") $ do- it "has functions" $ \str -> hedgehog $- str === "Hello!"-- it "goes before or after" $ \str -> do- pure () :: PropertyT IO ()- str === "Hello!"-- it "generates" $ \str -> hedgehog $ do- wrongLen <- forAll $ Gen.integral (Range.linear 0 3)- length str /== wrongLen-- describe "modifyMaxSuccess" $ do- modifyMaxSuccess (\_ -> 10) $ do- beforeAll (newIORef (0 :: Integer)) $ do- it "counts to 10" $ \ref -> hedgehog $ do- liftIO $ atomicModifyIORef' ref (\a -> (a + 1, ()))- True === True- it "works" $ \ref -> do- val <- readIORef ref- val `shouldBe` 10+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/Test/Hspec/HedgehogSpec.hs view
@@ -0,0 +1,86 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE NegativeLiterals #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+module Test.Hspec.HedgehogSpec (spec) where++import Test.Hspec+import Test.Hspec.Core.Spec+import Test.Hspec.Core.Util (formatException, stripAnsi)++import Data.List+import Control.Exception++import qualified Test.HUnit.Lang as HUnit+import Test.QuickCheck (stdArgs, replay)+import Test.QuickCheck.Random (mkQCGen)++import Test.Hspec.Hedgehog hiding (eval)++deriving instance Eq Result+deriving instance Eq ResultStatus+deriving instance Eq FailureReason++instance Eq SomeException where+ (==) = exceptionEq++exceptionEq :: SomeException -> SomeException -> Bool+exceptionEq a b+ | Just ea <- fromException a, Just eb <- fromException b = ea == (eb :: ErrorCall)+ | Just ea <- fromException a, Just eb <- fromException b = ea == (eb :: ArithException)+ | otherwise = throw (HUnit.HUnitFailure Nothing $ HUnit.ExpectedButGot Nothing (formatException b) (formatException a))++progressCallback :: ProgressCallback+progressCallback _ = return ()++params :: Params+params = defaultParams {paramsQuickCheckArgs = stdArgs {replay = Just (mkQCGen 23, 0)}}++joinLines :: [String] -> String+joinLines = intercalate "\n"++failingProperty :: PropertyT IO ()+failingProperty = failure++failingPropertyLine :: Int+failingPropertyLine = __LINE__ - 3++spec :: Spec+spec = do+ describe "evaluateExample" $ do+ let+ eval :: PropertyT IO () -> IO Result+ eval p = evaluateExample p params ($ ()) progressCallback++ context "on Success" $ do+ it "includes the number of passed tests" $ do+ eval success `shouldReturn` Result+ "passed 100 tests.\n"+ Success++ it "includes classification" $ do+ eval (label "foo" >> success) `shouldReturn` Result (joinLines [+ "passed 100 tests."+ , "foo 100% ████████████████████\n"+ ]) Success++ context "on Failure" $ do+ it "includes the number of discarded tests" $ do+ eval discard `shouldReturn` Result "" (Failure Nothing (Reason+ "gave up after 1000 discards, passed 0 tests.\n"+ ))++ it "provides a detailed failure message" $ do+ Result "" (Failure (Just _loc) (ColorizedReason reason)) <- eval failingProperty+ let line delta = "" <> show (failingPropertyLine + delta)+ stripAnsi reason `shouldBe` joinLines [+ "failed after 1 test."+ , "shrink path: 1:"+ , ""+ , " ┏━━ test/Test/Hspec/HedgehogSpec.hs ━━━"+ , line -1 <> " ┃ failingProperty :: PropertyT IO ()"+ , line 0 <> " ┃ failingProperty = failure"+ , " ┃ ^^^^^^^^^^^^^^^^^^^^^^^^^"+ , ""+ ]