genvalidity-hspec 1.0.0.2 → 1.0.0.3

raw patch · 9 files changed

+164/−139 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• genvalidity-hspec.cabal +2/−2
• src/Test/Validity/Applicative.hs +119/−106
• src/Test/Validity/Arbitrary.hs +2/−1
• src/Test/Validity/Functor.hs +7/−5
• src/Test/Validity/Monad.hs +14/−14
• src/Test/Validity/Monoid.hs +9/−9
• src/Test/Validity/Shrinking.hs +2/−1
• src/Test/Validity/Utils.hs +3/−1

@@ -1,5 +1,11 @@ # Changelog +## [1.0.0.3] - 2022-10-04++### Changed++* Compatibility with `hspec-core >= 2.11`.+ ## [1.0.0.2] - 2022-09-20  Same as 1.0.0.1, but with the right commit.

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.7.+-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack  name:           genvalidity-hspec-version:        1.0.0.2+version:        1.0.0.3 synopsis:       Standard spec's for GenValidity instances description:    Note: There are companion packages for this library:                 .

@@ -17,6 +17,7 @@ import Data.Data import Data.GenValidity import Data.Kind+import GHC.Stack import Test.Hspec import Test.QuickCheck import Test.Validity.Functions@@ -93,14 +94,15 @@ -- > applicativeSpecOnArbitrary @[] applicativeSpec ::   forall (f :: Type -> Type).-  ( Eq (f Int),+  ( HasCallStack,+    Eq (f Int),     Show (f Int),     Applicative f,     Typeable f,     GenValid (f Int)   ) =>   Spec-applicativeSpec = applicativeSpecWithInts @f genValid+applicativeSpec = withFrozenCallStack $ applicativeSpecWithInts @f genValid  -- | Standard test spec for properties of Applicative instances for values generated with Arbitrary instances --@@ -109,31 +111,38 @@ -- > applicativeSpecOnArbitrary @[] applicativeSpecOnArbitrary ::   forall (f :: Type -> Type).-  (Eq (f Int), Show (f Int), Applicative f, Typeable f, Arbitrary (f Int)) =>+  ( HasCallStack,+    Eq (f Int),+    Show (f Int),+    Applicative f,+    Typeable f,+    Arbitrary (f Int)+  ) =>   Spec-applicativeSpecOnArbitrary = applicativeSpecWithInts @f arbitrary+applicativeSpecOnArbitrary = withFrozenCallStack $ applicativeSpecWithInts @f arbitrary  applicativeSpecWithInts ::   forall (f :: Type -> Type).-  (Show (f Int), Eq (f Int), Applicative f, Typeable f) =>+  (HasCallStack, Show (f Int), Eq (f Int), Applicative f, Typeable f) =>   Gen (f Int) ->   Spec applicativeSpecWithInts gen =-  applicativeSpecOnGens-    @f-    @Int-    genValid-    "int"-    gen-    (unwords [nameOf @f, "of ints"])-    gen-    (unwords [nameOf @f, "of ints"])-    ((+) <$> genValid)-    "increments"-    (pure <$> ((+) <$> genValid))-    (unwords [nameOf @f, "of increments"])-    (pure <$> ((*) <$> genValid))-    (unwords [nameOf @f, "of scalings"])+  withFrozenCallStack $+    applicativeSpecOnGens+      @f+      @Int+      genValid+      "int"+      gen+      (unwords [nameOf @f, "of ints"])+      gen+      (unwords [nameOf @f, "of ints"])+      ((+) <$> genValid)+      "increments"+      (pure <$> ((+) <$> genValid))+      (unwords [nameOf @f, "of increments"])+      (pure <$> ((*) <$> genValid))+      (unwords [nameOf @f, "of scalings"])  -- | Standard test spec for properties of Applicative instances for values generated by given generators (and names for those generator). --@@ -158,7 +167,8 @@ -- >     "appends in a Just" applicativeSpecOnGens ::   forall (f :: Type -> Type) (a :: Type) (b :: Type) (c :: Type).-  ( Show a,+  ( HasCallStack,+    Show a,     Show (f a),     Eq (f a),     Show (f b),@@ -185,97 +195,100 @@   String ->   Spec applicativeSpecOnGens gena genaname gen genname genb genbname genfa genfaname genffa genffaname genffb genffbname =-  parallel $-    describe ("Applicative " ++ nameOf @f) $ do-      describe (unwords [pureTypeStr @f, "and", seqTypeStr @f]) $ do-        it-          ( unwords-              [ "satisfy the identity law: 'pure id <*> v = v' for",-                genDescr @(f a) genname-              ]-          )-          $ equivalentOnGen (pure id <*>) id gen shrinkNothing-        it-          ( unwords-              [ "satisfy the composition law: 'pure (.) <*> u <*> v <*> w = u <*> (v <*> w)' for",-                genDescr @(f (b -> c)) genffbname,-                "composed with",-                genDescr @(f (a -> b)) genffaname,-                "and applied to",-                genDescr @(f a) genname-              ]-          )-          $ equivalentOnGens3-            ( \(Anon u) (Anon v) w ->-                pure (.) <*> (u :: f (b -> c)) <*> (v :: f (a -> b))-                  <*> (w :: f a) ::-                  f c+  withFrozenCallStack $+    parallel $+      describe ("Applicative " ++ nameOf @f) $ do+        describe (unwords [pureTypeStr @f, "and", seqTypeStr @f]) $ do+          it+            ( unwords+                [ "satisfy the identity law: 'pure id <*> v = v' for",+                  genDescr @(f a) genname+                ]             )-            (\(Anon u) (Anon v) w -> u <*> (v <*> w) :: f c)-            ((,,) <$> (Anon <$> genffb) <*> (Anon <$> genffa) <*> gen)-            shrinkNothing-        it-          ( unwords-              [ "satisfy the homomorphism law: 'pure f <*> pure x = pure (f x)' for",-                genDescr @(a -> b) genfaname,-                "sequenced with",-                genDescr @a genaname-              ]-          )-          $ equivalentOnGens2-            (\(Anon f) x -> pure f <*> pure x :: f b)-            (\(Anon f) x -> pure $ f x :: f b)-            ((,) <$> (Anon <$> genfa) <*> gena)-            shrinkNothing-        it-          ( unwords-              [ "satisfy the interchange law: 'u <*> pure y = pure ($ y) <*> u' for",-                genDescr @(f (a -> b)) genffaname,-                "sequenced with",-                genDescr @a genaname-              ]-          )-          $ equivalentOnGens2-            (\(Anon u) y -> u <*> pure y :: f b)-            (\(Anon u) y -> pure ($ y) <*> u :: f b)-            ((,) <$> (Anon <$> genffa) <*> gena)-            shrinkNothing-        it-          ( unwords-              [ "satisfy the law about the functor instance: fmap f x = pure f <*> x for",-                genDescr @(a -> b) genfaname,-                "mapped over",-                genDescr @(f a) genname-              ]-          )-          $ equivalentOnGens2-            (\(Anon f) x -> fmap f x)-            (\(Anon f) x -> pure f <*> x)-            ((,) <$> (Anon <$> genfa) <*> gen)-            shrinkNothing-      describe (seqrTypeStr @f) $-        it-          ( unwords-              [ "is equivalent to its default implementation 'u Type> v = pure (const id) <*> u <*> v' for",-                genDescr @(f a) genname,-                "in front of",-                genDescr @b genbname-              ]-          )+            $ equivalentOnGen (pure id <*>) id gen shrinkNothing+          it+            ( unwords+                [ "satisfy the composition law: 'pure (.) <*> u <*> v <*> w = u <*> (v <*> w)' for",+                  genDescr @(f (b -> c)) genffbname,+                  "composed with",+                  genDescr @(f (a -> b)) genffaname,+                  "and applied to",+                  genDescr @(f a) genname+                ]+            )+            $ equivalentOnGens3+              ( \(Anon u) (Anon v) w ->+                  pure (.)+                    <*> (u :: f (b -> c))+                    <*> (v :: f (a -> b))+                    <*> (w :: f a) ::+                    f c+              )+              (\(Anon u) (Anon v) w -> u <*> (v <*> w) :: f c)+              ((,,) <$> (Anon <$> genffb) <*> (Anon <$> genffa) <*> gen)+              shrinkNothing+          it+            ( unwords+                [ "satisfy the homomorphism law: 'pure f <*> pure x = pure (f x)' for",+                  genDescr @(a -> b) genfaname,+                  "sequenced with",+                  genDescr @a genaname+                ]+            )+            $ equivalentOnGens2+              (\(Anon f) x -> pure f <*> pure x :: f b)+              (\(Anon f) x -> pure $ f x :: f b)+              ((,) <$> (Anon <$> genfa) <*> gena)+              shrinkNothing+          it+            ( unwords+                [ "satisfy the interchange law: 'u <*> pure y = pure ($ y) <*> u' for",+                  genDescr @(f (a -> b)) genffaname,+                  "sequenced with",+                  genDescr @a genaname+                ]+            )+            $ equivalentOnGens2+              (\(Anon u) y -> u <*> pure y :: f b)+              (\(Anon u) y -> pure ($ y) <*> u :: f b)+              ((,) <$> (Anon <$> genffa) <*> gena)+              shrinkNothing+          it+            ( unwords+                [ "satisfy the law about the functor instance: fmap f x = pure f <*> x for",+                  genDescr @(a -> b) genfaname,+                  "mapped over",+                  genDescr @(f a) genname+                ]+            )+            $ equivalentOnGens2+              (\(Anon f) x -> fmap f x)+              (\(Anon f) x -> pure f <*> x)+              ((,) <$> (Anon <$> genfa) <*> gen)+              shrinkNothing+        describe (seqrTypeStr @f)+          $ it+            ( unwords+                [ "is equivalent to its default implementation 'u Type> v = pure (const id) <*> u <*> v' for",+                  genDescr @(f a) genname,+                  "in front of",+                  genDescr @b genbname+                ]+            )           $ equivalentOnGens2             (\u v -> u *> v)             (\u v -> pure (const id) <*> u <*> v)             ((,) <$> gen <*> genb)             shrinkNothing-      describe (seqlTypeStr @f) $-        it-          ( unwords-              [ "is equivalent to its default implementation 'u <* v = pure const <*> u <*> v' for",-                genDescr @b genbname,-                "behind",-                genDescr @(f a) genname-              ]-          )+        describe (seqlTypeStr @f)+          $ it+            ( unwords+                [ "is equivalent to its default implementation 'u <* v = pure const <*> u <*> v' for",+                  genDescr @b genbname,+                  "behind",+                  genDescr @(f a) genname+                ]+            )           $ equivalentOnGens2             (\u v -> u <* v)             (\u v -> pure const <*> u <*> v)

@@ -33,7 +33,8 @@   let name = nameOf @a   describe ("Arbitrary " ++ name) $     describe ("arbitrary :: Gen " ++ name) $-      it "only generates valid values" $ arbitraryGeneratesOnlyValid @a+      it "only generates valid values" $+        arbitraryGeneratesOnlyValid @a  -- | @arbitrary@ only generates valid data --

@@ -145,15 +145,16 @@                 genDescr @(a -> b) gengname               ]           )-          $ forAll (Anon <$> genf) $ \(Anon f) ->+          $ forAll (Anon <$> genf)+          $ \(Anon f) ->             forAll (Anon <$> geng) $ \(Anon g) ->               equivalentOnGen                 (fmap (f . g))                 (fmap f . fmap g)                 gen                 shrinkNothing-      describe (flTypeStr @f) $-        it+      describe (flTypeStr @f)+        $ it           ( unwords               [ "is equivalent to its default implementation for",                 genDescr @a genaname,@@ -161,5 +162,6 @@                 genDescr @(f a) genname               ]           )-          $ forAll gena $ \a ->-            equivalentOnGen (a <$) (fmap $ const a) gen shrinkNothing+        $ forAll gena+        $ \a ->+          equivalentOnGen (a <$) (fmap $ const a) gen shrinkNothing

@@ -194,8 +194,8 @@               ]           )           $ equivalentOnGen (\m -> m >>= return) (\m -> m) gen shrinkNothing-      describe (bindTypeStr @f) $-        it+      describe (bindTypeStr @f)+        $ it           ( unwords               [ "satisfies the third Monad law: 'm >>= (x -> k x >>= h) = (m >>= k) >>= h' for",                 genDescr @(f a) genname,@@ -204,11 +204,11 @@                 genDescr @(b -> f c) gencfname               ]           )-          $ equivalentOnGens3-            (\m (Anon k) (Anon h) -> m >>= (\x -> k x >>= h))-            (\m (Anon k) (Anon h) -> (m >>= k) >>= h)-            ((,,) <$> gen <*> (Anon <$> genbf) <*> (Anon <$> gencf))-            shrinkNothing+        $ equivalentOnGens3+          (\m (Anon k) (Anon h) -> m >>= (\x -> k x >>= h))+          (\m (Anon k) (Anon h) -> (m >>= k) >>= h)+          ((,,) <$> gen <*> (Anon <$> genbf) <*> (Anon <$> gencf))+          shrinkNothing       describe (unwords ["relation with Applicative", nameOf @f]) $ do         it           ( unwords@@ -237,8 +237,8 @@               ]           )           $ equivalentOnGens2 (>>) (*>) ((,) <$> gen <*> genb) shrinkNothing-      describe (unwords ["relation with Functor", nameOf @f]) $-        it+      describe (unwords ["relation with Functor", nameOf @f])+        $ it           ( unwords               [ "satisfies 'fmap f xs = xs >>= return . f' for",                 genDescr @(a -> b) gengname,@@ -246,8 +246,8 @@                 genDescr @(f a) genname               ]           )-          $ equivalentOnGens2-            (\(Anon f) xs -> fmap f xs)-            (\(Anon f) xs -> xs >>= (return . f))-            ((,) <$> (Anon <$> geng) <*> gen)-            shrinkNothing+        $ equivalentOnGens2+          (\(Anon f) xs -> fmap f xs)+          (\(Anon f) xs -> xs >>= (return . f))+          ((,) <$> (Anon <$> geng) <*> gen)+          shrinkNothing

@@ -103,8 +103,8 @@       let mem = mempty @a           mapp = mappend @a           mcon = mconcat @a-      describe memptystr $-        it+      describe memptystr+        $ it           ( unwords               [ "is the identity for",                 mappendstr,@@ -112,20 +112,20 @@                 genDescr @a genname               ]           )-          $ identityOnGen mapp mem gen s-      describe mappendstr $-        it+        $ identityOnGen mapp mem gen s+      describe mappendstr+        $ it           ( unwords               [ "is an associative operation for",                 genDescr @(a, a, a) genname               ]           )-          $ associativeOnGens mapp gen3 s3-      describe mconcatstr $-        it+        $ associativeOnGens mapp gen3 s3+      describe mconcatstr+        $ it           ( unwords               [ "is equivalent to its default implementation for",                 genDescr @[a] genname               ]           )-          $ equivalentOnGen mcon (foldr mapp mem) genl sl+        $ equivalentOnGen mcon (foldr mapp mem) genl sl

@@ -35,7 +35,8 @@ shrinkValidSpec =   describe ("shrinkValid :: " ++ nameOf @(a -> [a])) $ do     it "preserves validity" $-      forAll (genValid @a) $ \a -> forM_ (shrinkValid a) shouldBeValid+      forAll (genValid @a) $+        \a -> forM_ (shrinkValid a) shouldBeValid     it "never shrinks to itself for valid values" $       shrinkValidDoesNotShrinkToItself @a 

@@ -4,6 +4,7 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -Wno-deprecations #-}  -- | Utilities for defining your own validity 'Spec's --@@ -69,6 +70,7 @@ -- but it has been copied here for convenience. -- https://github.com/hspec/hspec/commit/020c7ecc4a73c24af38e9fab049f60bb9aec6981#diff-29cb22f0ef6e98086a71fc045847bd21L22 mapSpecTree' :: (SpecTree a -> SpecTree b) -> SpecM a r -> SpecM b r+ #if MIN_VERSION_hspec(2,10,0) mapSpecTree' f (SpecM specs) = SpecM (mapWriterT (fmap (second (fmap (map f)))) specs) #else@@ -107,7 +109,7 @@       resultStatus =         if succesful           then Success-          else Failure Nothing $ Reason "Should have failed but didn't."+          else Failure Nothing $ Test.Hspec.Core.Spec.Reason "Should have failed but didn't."     }  shouldFail :: Property -> Property