hspec-hedgehog 0.0.1.2 → 0.3.0.0
raw patch · 7 files changed
Files
- ChangeLog.md +27/−0
- README.md +0/−2
- hspec-hedgehog.cabal +29/−19
- src/Test/Hspec/Hedgehog.hs +47/−22
- test/ExampleSpec.hs +59/−0
- test/Spec.hs +1/−53
- test/Test/Hspec/HedgehogSpec.hs +86/−0
ChangeLog.md view
@@ -1,5 +1,32 @@ # 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+ - Provide more information on "gave up"++## 0.1.0.0++- [#25](https://github.com/parsonsmatt/hspec-hedgehog/pull/25) @sol+ - Suppress internal source locations.+- [#24](https://github.com/parsonsmatt/hspec-hedgehog/pull/24) @sol+ - Regard `--color` / `--no-color`.+- [#23](https://github.com/parsonsmatt/hspec-hedgehog/pull/23) @ocharles+ - Improve type inference by constraining the base monad of `PropertyT` to+ `IO`. This makes explicitly using `hedgehog` redundant in many+ situations.+ ## 0.0.1.2 - [#7](https://github.com/parsonsmatt/hspec-hedgehog/pull/7) @parsonsmatt
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.0.1.2-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,25 +31,30 @@ hs-source-dirs: src build-depends:- base >= 4.7 && < 5- , hspec >= 2.4.4 && < 3- , hspec-core >= 2.4.4 && < 3- , hedgehog >= 1.0.2 && < 2- , HUnit >= 1.5 && < 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
@@ -1,11 +1,13 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns #-} @@ -82,26 +84,30 @@ ( -- * 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) import Hedgehog-import Hedgehog.Internal.Config (detectColor)+import Hedgehog.Internal.Config (UseColor(..)) import Hedgehog.Internal.Property (DiscardLimit (..), Property (..), PropertyConfig (..), ShrinkLimit (..), TerminationCriteria (..), TestCount (..), TestLimit (..))-import Hedgehog.Internal.Report as Hedge+import Hedgehog.Internal.Report hiding (renderResult) import Hedgehog.Internal.Runner (checkReport) import qualified Hedgehog.Internal.Seed as Seed import Hedgehog.Internal.Source (ColumnNo (..), LineNo (..),@@ -110,9 +116,7 @@ import Test.Hspec import Test.Hspec.Core.Spec as Hspec import Test.Hspec.QuickCheck (modifyArgs, modifyMaxDiscardRatio,- modifyMaxShrinks, modifyMaxSize,- modifyMaxSuccess)-import Test.HUnit.Base (assertFailure)+ modifyMaxShrinks, modifyMaxSuccess) import Test.QuickCheck.Random (QCGen (..)) import Test.QuickCheck.Test (Args (..)) @@ -142,10 +146,13 @@ -- of 'Example' for a function for more details. -- -- @since 0.0.0.0-instance Example (PropertyT IO ()) where- type Arg (PropertyT IO ()) = ()+instance m ~ IO => Example (PropertyT m ()) where+ type Arg (PropertyT m ()) = () evaluateExample e = evaluateExample (\() -> e) +propertyWithoutCallStack :: PropertyT IO () -> Property+propertyWithoutCallStack = withFrozenCallStack property+ -- | Warning: orphan instance! This instance is used to embed a "Hedgehog" -- property seamlessly into the @hspec@ framework. --@@ -155,13 +162,12 @@ -- Hedgehog tests. -- -- @since 0.0.0.0-instance Example (a -> PropertyT IO ()) where- type Arg (a -> PropertyT IO ()) = a+instance (m ~ IO) => Example (a -> PropertyT m ()) where+ type Arg (a -> PropertyT m ()) = a - evaluateExample (fmap property -> aprop) params aroundAction progressCallback = do+ evaluateExample (fmap propertyWithoutCallStack -> aprop) params aroundAction progressCallback = do ref <- newIORef (Result "" (Pending Nothing Nothing)) aroundAction $ \a -> do- color <- detectColor let size = 0 prop = aprop a propConfig = useQuickCheckArgs (propertyConfig prop)@@ -179,7 +185,7 @@ NoConfidenceTermination (TestLimit _) -> NoConfidenceTermination (TestLimit maxTests) , propertyDiscardLimit =- DiscardLimit $ maxDiscardRatio qcArgs+ DiscardLimit $ maxDiscardRatio qcArgs * maxTests , propertyShrinkLimit = ShrinkLimit $ maxShrinks qcArgs }@@ -197,9 +203,19 @@ Nothing -> Seed.random Just (rng, _) -> pure (uncurry Seed (unseedSMGen (coerce rng))) hedgeResult <- checkReport propConfig size seed (propertyTest prop) cb- ppresult <- renderResult color Nothing hedgeResult- writeIORef ref $ Result "" $ case reportStatus hedgeResult of- Failed FailureReport{..} ->++ 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+ ppresult <- renderResult EnableColor let fromSpan Span{..} = Location@@ -207,10 +223,19 @@ , locationLine = coerce spanStartLine , locationColumn = coerce spanStartColumn }- in- Hspec.Failure (fromSpan <$> failureLocation) $ Reason ppresult- GaveUp ->- Failure Nothing (Reason "GaveUp")- OK ->- Success+ writeIORef ref $ Result "" $ Hspec.Failure (fromSpan <$> failureLocation) $ ColorizedReason ppresult+ GaveUp -> do+ ppresult <- renderResult DisableColor+ writeIORef ref $ Result "" $ Failure Nothing (Reason ppresult)+ OK -> do+ 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,53 +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 "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"+ , " ┃ ^^^^^^^^^^^^^^^^^^^^^^^^^"+ , ""+ ]