Add test/Test/Hspec/HedgehogSpec.hs

.gitattributes

@@ -0,0 +1 @@
+*.cabal linguist-generated=true

cabal.project

@@ -0,0 +1,7 @@
+packages:
+  hspec-hedgehog.cabal
+
+package hspec-hedgehog
+  ghc-options: -Werror
+
+tests: True

package.yaml

@@ -0,0 +1,39 @@
+spec-version: 0.36.0
+
+name: hspec-hedgehog
+version: 0.1.1.0
+synopsis: Integrate Hedgehog and Hspec!
+description: Please see the README on GitHub at <https://github.com/parsonsmatt/hspec-hedgehog#readme>
+category: Testing
+author: Matt Parsons
+maintainer: [email protected]
+copyright: 2020 Matt Parsons
+
+extra-source-files:
+  - README.md
+  - ChangeLog.md
+
+github: parsonsmatt/hspec-hedgehog
+
+dependencies:
+  - base >= 4.7 && < 5
+  - hspec >= 2.11.0 && < 3
+  - hspec-core >= 2.11.0 && < 3
+  - hedgehog >= 1.0.2 && < 2
+
+library:
+  source-dirs: src
+  dependencies:
+    - QuickCheck >= 2.9.2 && < 3
+    - splitmix >= 0.0.1 && < 1
+
+tests:
+  hspec-hedgehog-test:
+    main: Spec.hs
+    source-dirs: test
+    build-tools: hspec-discover
+    dependencies:
+      - HUnit
+      - QuickCheck
+      - hspec-hedgehog
+    ghc-options: -threaded -rtsopts -with-rtsopts=-N

test/ExampleSpec.hs

@@ -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

@@ -1,58 +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

@@ -0,0 +1,91 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE LexicalNegation #-}
+{-# 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 (property, eval)
+
+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))
+
+instance Eq SomeException where
+  (==) = exceptionEq
+
+deriving instance Eq FailureReason
+deriving instance Eq ResultStatus
+deriving instance Eq Result
+
+progressCallback :: ProgressCallback
+progressCallback _ = return ()
+
+property :: PropertyT IO () -> PropertyT IO ()
+property = id
+
+joinLines :: [String] -> String
+joinLines = intercalate "\n"
+
+params :: Params
+params = defaultParams {paramsQuickCheckArgs = stdArgs {replay = Just (mkQCGen 23, 0)}}
+
+failingProperty :: PropertyT IO ()
+failingProperty = failure
+
+failingPropertyLine :: Int
+failingPropertyLine = __LINE__ - 3
+
+spec :: Spec
+spec = do
+  let eval p = evaluateExample p params ($ ()) progressCallback
+
+  fdescribe "evaluateExample" $ do
+    context "on Success" $ do
+      it "includes the number of passed tests" $ do
+        eval (property success) `shouldReturn` Result
+            "  ✓ property passed 100 tests."
+            Success
+
+      it "includes classification" $ do
+        eval (label "foo" >> property success) `shouldReturn` Result (joinLines [
+            "  ✓ property passed 100 tests."
+          , "    foo 100% ████████████████████"
+          ]) Success
+
+    context "on Failure" $ do
+      it "includes the number of discarded tests" $ do
+        eval (property discard) `shouldReturn` Result "" (Failure Nothing (Reason
+            "  ⚐ property gave up after 10 discards, passed 0 tests."
+          ))
+
+      it "provides a detailed failure message" $ do
+        let line delta = "    " <> show (failingPropertyLine + delta)
+        Result "" (Failure (Just _loc) (ColorizedReason reason)) <- eval failingProperty
+        stripAnsi reason `shouldBe` joinLines [
+            "  ✗ property failed at test/Test/Hspec/HedgehogSpec.hs:" <> show failingPropertyLine <> ":19"
+          , "    after 1 test."
+          , "    shrink path: 1:"
+          , "  "
+          ,      "       ┏━━ test/Test/Hspec/HedgehogSpec.hs ━━━"
+          , line -1 <> " ┃ failingProperty :: PropertyT IO ()"
+          , line  0 <> " ┃ failingProperty = failure"
+          ,      "       ┃ ^^^^^^^^^^^^^^^^^^^^^^^^^"
+          , "  "
+          , "    This failure can be reproduced by running:"
+          , "    > recheckAt (Seed 14375056955115587481 16778118630780010967) \"1:\" property"
+          , "  "
+          ]