genvalidity-hspec 0.2.0.5 → 0.3.0.0

raw patch · 41 files changed

+2715/−1098 lines, 41 filesdep ~basedep ~genvaliditydep ~hspecPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, genvalidity, hspec

API changes (from Hackage documentation)

Files

• genvalidity-hspec.cabal +47/−13
• src/Test/Validity.hs +86/−54
• src/Test/Validity/Applicative.hs +281/−0
• src/Test/Validity/Arbitrary.hs +28/−43
• src/Test/Validity/Eq.hs +123/−36
• src/Test/Validity/Functions.hs +21/−24
• src/Test/Validity/Functions/CanFail.hs +99/−124
• src/Test/Validity/Functions/Equivalence.hs +288/−185
• src/Test/Validity/Functions/Idempotence.hs +2/−2
• src/Test/Validity/Functions/Inverse.hs +63/−115
• src/Test/Validity/Functions/Validity.hs +72/−77
• src/Test/Validity/Functor.hs +169/−0
• src/Test/Validity/GenRelativeValidity.hs +99/−63
• src/Test/Validity/GenValidity.hs +90/−49
• src/Test/Validity/Monad.hs +237/−0
• src/Test/Validity/Monoid.hs +111/−0
• src/Test/Validity/Operations.hs +3/−0
• src/Test/Validity/Operations/Associativity.hs +23/−23
• src/Test/Validity/Operations/Commutativity.hs +28/−25
• src/Test/Validity/Operations/Identity.hs +85/−61
• src/Test/Validity/Ord.hs +205/−35
• src/Test/Validity/Relations.hs +10/−2
• src/Test/Validity/Relations/Antireflexivity.hs +62/−0
• src/Test/Validity/Relations/Antisymmetry.hs +50/−31
• src/Test/Validity/Relations/Reflexivity.hs +41/−25
• src/Test/Validity/Relations/Symmetry.hs +27/−26
• src/Test/Validity/Relations/Transitivity.hs +48/−25
• src/Test/Validity/RelativeValidity.hs +50/−53
• src/Test/Validity/Utils.hs +37/−6
• test/DocTest.hs +1/−1
• test/Spec.hs +1/−0
• test/Test/Validity/ApplicativeSpec.hs +48/−0
• test/Test/Validity/ArbitrarySpec.hs +10/−0
• test/Test/Validity/EqSpec.hs +15/−0
• test/Test/Validity/FunctorSpec.hs +41/−0
• test/Test/Validity/GenRelativeValiditySpec.hs +10/−0
• test/Test/Validity/GenValiditySpec.hs +13/−0
• test/Test/Validity/MonadSpec.hs +53/−0
• test/Test/Validity/MonoidSpec.hs +14/−0
• test/Test/Validity/OrdSpec.hs +15/−0
• test/Test/Validity/RelativeValiditySpec.hs +9/−0

@@ -1,7 +1,13 @@ name:                genvalidity-hspec-version:             0.2.0.5+version:             0.3.0.0 synopsis:            Standard spec's for GenValidity instances-description:         Please see README.md+description: +  Note: There are companion packages for this library:+  .+  * <https://hackage.haskell.org/package/genvalidity-hspec-aeson genvalidity-hspec-aeson>+  .+  * <https://hackage.haskell.org/package/genvalidity-hspec-cereal genvalidity-hspec-cereal>+ homepage:            https://github.com/NorfairKing/validity#readme license:             MIT license-file:        LICENSE@@ -10,42 +16,46 @@ copyright:           Copyright: (c) 2016 Tom Sydney Kerckhove category:            Testing build-type:          Simple--- extra-source-files: cabal-version:       >=1.10  library   hs-source-dirs:      src   exposed-modules:       Test.Validity+    , Test.Validity.Applicative     , Test.Validity.Arbitrary     , Test.Validity.Eq-    , Test.Validity.Ord     , Test.Validity.Functions     , Test.Validity.Functions.CanFail     , Test.Validity.Functions.Equivalence     , Test.Validity.Functions.Idempotence     , Test.Validity.Functions.Inverse     , Test.Validity.Functions.Validity-    , Test.Validity.GenValidity+    , Test.Validity.Functor     , Test.Validity.GenRelativeValidity+    , Test.Validity.GenValidity+    , Test.Validity.Monad+    , Test.Validity.Monoid     , Test.Validity.Operations-    , Test.Validity.Operations.Identity     , Test.Validity.Operations.Associativity     , Test.Validity.Operations.Commutativity+    , Test.Validity.Operations.Identity+    , Test.Validity.Ord     , Test.Validity.Relations+    , Test.Validity.Relations.Antireflexivity     , Test.Validity.Relations.Antisymmetry     , Test.Validity.Relations.Reflexivity     , Test.Validity.Relations.Symmetry     , Test.Validity.Relations.Transitivity     , Test.Validity.RelativeValidity     , Test.Validity.Types-  other-modules:-      Test.Validity.Utils-  build-depends:       base                               < 5-                     , validity                 >= 0.3 && < 0.4-                     , genvalidity-                     , QuickCheck-                     , hspec                    >= 2.2 && < 2.3+    , Test.Validity.Utils+  build-depends:+        base                               < 5+      , validity                 >= 0.3 && < 0.4+      , genvalidity              >= 0.3 && < 0.4+      , QuickCheck+      , hspec                    >= 2.2 && < 2.4   default-language:    Haskell2010  @@ -58,6 +68,30 @@   build-depends:      base     , doctest               >= 0.11      && < 0.12     , genvalidity-hspec++test-suite genvalidity-hspec-test+    type: exitcode-stdio-1.0+    main-is: Spec.hs+    other-modules:+        Test.Validity.ApplicativeSpec+      , Test.Validity.ArbitrarySpec+      , Test.Validity.EqSpec+      , Test.Validity.FunctorSpec+      , Test.Validity.GenRelativeValiditySpec+      , Test.Validity.GenValiditySpec+      , Test.Validity.MonoidSpec+      , Test.Validity.MonadSpec+      , Test.Validity.OrdSpec+      , Test.Validity.RelativeValiditySpec+    build-depends:+        base >=4.9 && <=5,+        genvalidity >= 0.3 && < 0.4,+        genvalidity-hspec,+        hspec >= 2.2 && < 2.3+    default-language: Haskell2010+    hs-source-dirs: test/+    ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+  source-repository head   type:     git

@@ -1,34 +1,29 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | To use the 'Spec' functions in this module, you will need @TypeApplications@. module Test.Validity     ( module Data.GenValidity-    , Proxy(Proxy)-       -- * Tests for Arbitrary instances involving Validity     , arbitrarySpec     , arbitraryGeneratesOnlyValid-    , shrinkProducesOnlyValids-       -- * Tests for GenValidity instances     , genValiditySpec-    , genValidityValidGeneratesValid+    , genValidSpec+    , genInvalidSpec+    , genValidGeneratesValid     , genGeneratesValid-    , genValidityInvalidGeneratesInvalid+    , genInvalidGeneratesInvalid     , genGeneratesInvalid-       -- * Tests for RelativeValidity instances     , relativeValiditySpec     , relativeValidityImpliesValidA     , relativeValidityImpliesValidB-       -- * Tests for GenRelativeValidity instances     , genRelativeValiditySpec-    , genRelativeValidityValidGeneratesValid-    , genRelativeValidityInvalidGeneratesInvalid--+    , genRelativeValidGeneratesValid+    , genRelativeInvalidGeneratesInvalid       -- * Standard tests involving functions-       -- ** Standard tests involving validity     , producesValidsOnGen     , producesValidsOnValids@@ -42,62 +37,78 @@     , producesValidsOnValids3     , producesValid3     , producesValidsOnArbitrary3-       -- ** Standard tests involving functions that can fail     , CanFail(..)-     , succeedsOnGen     , succeedsOnValid     , succeeds     , succeedsOnArbitrary-     , succeedsOnGens2     , succeedsOnValids2     , succeeds2     , succeedsOnArbitrary2-     , failsOnGen     , failsOnInvalid-     , failsOnGens2     , failsOnInvalid2-     , validIfSucceedsOnGen     , validIfSucceedsOnValid     , validIfSucceedsOnArbitrary     , validIfSucceeds-     , validIfSucceedsOnGens2     , validIfSucceedsOnValids2     , validIfSucceeds2     , validIfSucceedsOnArbitrary2-       -- ** Standard tests involving equivalence of functions+      -- *** Simple functions+      -- **** One argument     , equivalentOnGen     , equivalentOnValid     , equivalent+    , equivalentOnArbitrary+      -- **** Two arguments     , equivalentOnGens2     , equivalentOnValids2     , equivalent2+    , equivalentOnArbitrary2+      -- **** Three arguments+    , equivalentOnGens3+    , equivalentOnValids3+    , equivalent3+    , equivalentOnArbitrary3+      -- *** First function can fail+      -- **** One argument     , equivalentWhenFirstSucceedsOnGen     , equivalentWhenFirstSucceedsOnValid     , equivalentWhenFirstSucceeds+    , equivalentWhenFirstSucceedsOnArbitrary+      -- **** Two arguments     , equivalentWhenFirstSucceedsOnGens2     , equivalentWhenFirstSucceedsOnValids2     , equivalentWhenFirstSucceeds2+    , equivalentWhenFirstSucceedsOnArbitrary2+      -- *** Second function can fail+      -- **** One argument     , equivalentWhenSecondSucceedsOnGen     , equivalentWhenSecondSucceedsOnValid     , equivalentWhenSecondSucceeds+    , equivalentWhenSecondSucceedsOnArbitrary+      -- **** Two arguments     , equivalentWhenSecondSucceedsOnGens2     , equivalentWhenSecondSucceedsOnValids2     , equivalentWhenSecondSucceeds2+    , equivalentWhenSecondSucceedsOnArbitrary2+      -- *** Both functions can fail+      -- **** One argument     , equivalentWhenSucceedOnGen     , equivalentWhenSucceedOnValid     , equivalentWhenSucceed+    , equivalentWhenSucceedOnArbitrary+      -- **** Two arguments     , equivalentWhenSucceedOnGens2     , equivalentWhenSucceedOnValids2     , equivalentWhenSucceed2-+    , equivalentWhenSucceedOnArbitrary2       -- ** Standard tests involving inverse functions     , inverseFunctionsOnGen     , inverseFunctionsOnValid@@ -115,99 +126,120 @@     , inverseFunctionsIfSucceedOnValid     , inverseFunctionsIfSucceed     , inverseFunctionsIfSucceedOnArbitrary-       -- ** Properties involving idempotence     , idempotentOnGen     , idempotentOnValid     , idempotent     , idempotentOnArbitrary--       -- * Properties of relations-       -- ** Reflexivity     , reflexiveOnElem     , reflexivityOnGen     , reflexivityOnValid     , reflexivity     , reflexivityOnArbitrary-       -- ** Transitivity     , transitiveOnElems     , transitivityOnGens     , transitivityOnValid     , transitivity     , transitivityOnArbitrary-       -- ** Antisymmetry     , antisymmetricOnElemsWithEquality     , antisymmetryOnGensWithEquality-    , antisymmetryOnGensEq+    , antisymmetryOnGens     , antisymmetryOnValid     , antisymmetry     , antisymmetryOnArbitrary-+      -- ** Antireflexivity+    , antireflexiveOnElem+    , antireflexivityOnGen+    , antireflexivityOnValid+    , antireflexivity+    , antireflexivityOnArbitrary       -- ** Symmetry     , symmetricOnElems     , symmetryOnGens     , symmetryOnValid     , symmetry     , symmetryOnArbitrary--       -- * Properties of operations-       -- ** Identity element-       -- *** Left Identity     , leftIdentityOnElemWithEquality     , leftIdentityOnGenWithEquality     , leftIdentityOnGen     , leftIdentityOnValid     , leftIdentity-+    , leftIdentityOnArbitrary       -- *** Right Identity     , rightIdentityOnElemWithEquality     , rightIdentityOnGenWithEquality     , rightIdentityOnGen     , rightIdentityOnValid     , rightIdentity-+    , rightIdentityOnArbitrary       -- *** Identity     , identityOnGen     , identityOnValid     , identity-+    , identityOnArbitrary       -- ** Associativity     , associativeOnGens     , associativeOnValids     , associative     , associativeOnArbitrary-       -- ** Commutativity     , commutativeOnGens     , commutativeOnValids     , commutative     , commutativeOnArbitrary--       -- * Eq properties+    , eqSpecOnValid     , eqSpec-+    , eqSpecOnArbitrary+    , eqSpecOnGen       -- * Ord properties+    , ordSpecOnGen+    , ordSpecOnValid     , ordSpec+    , ordSpecOnArbitrary+      -- * Monoid properties+    , monoidSpecOnValid+    , monoidSpec+    , monoidSpecOnArbitrary+    , monoidSpecOnGen+      -- * Functor properties+    , functorSpecOnValid+    , functorSpec+    , functorSpecOnArbitrary+    , functorSpecOnGens+      -- * Applicative properties+    , applicativeSpecOnValid+    , applicativeSpec+    , applicativeSpecOnArbitrary+    , applicativeSpecOnGens+      -- * Monad properties+    , monadSpecOnValid+    , monadSpec+    , monadSpecOnArbitrary+    , monadSpecOnGens     ) where -import           Data.GenValidity-import           Data.Data+import Data.Data+import Data.GenValidity -import           Test.Validity.Arbitrary-import           Test.Validity.Eq-import           Test.Validity.Functions-import           Test.Validity.GenRelativeValidity-import           Test.Validity.GenValidity-import           Test.Validity.Operations-import           Test.Validity.Ord-import           Test.Validity.Relations-import           Test.Validity.RelativeValidity-import           Test.Validity.Types+import Test.Validity.Arbitrary+import Test.Validity.Eq+import Test.Validity.Functions+import Test.Validity.Functor+import Test.Validity.Applicative+import Test.Validity.Monad+import Test.Validity.GenRelativeValidity+import Test.Validity.GenValidity+import Test.Validity.Monoid+import Test.Validity.Operations+import Test.Validity.Ord+import Test.Validity.Relations+import Test.Validity.RelativeValidity+import Test.Validity.Types

@@ -0,0 +1,281 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++-- | Applicative properties+--+-- You will need @TypeApplications@ to use these.+module Test.Validity.Applicative+    ( applicativeSpecOnValid+    , applicativeSpec+    , applicativeSpecOnArbitrary+    , applicativeSpecOnGens+    ) where++import Data.Data++import Data.GenValidity++import Test.Hspec+import Test.QuickCheck++import Test.Validity.Functions+import Test.Validity.Operations+import Test.Validity.Relations+import Test.Validity.Utils++pureTypeStr+    :: forall (f :: * -> *).+       (Typeable f)+    => String+pureTypeStr = unwords ["pure", "::", "a", "->", nameOf @f, "a"]++seqTypeStr+    :: forall (f :: * -> *).+       (Typeable f)+    => String+seqTypeStr =+    unwords+        [ "(<*>)"+        , "::"+        , nameOf @f+        , "(a"+        , "->"+        , "b)"+        , "->"+        , nameOf @f+        , "a"+        , "->"+        , nameOf @f+        , "b"+        ]++seqrTypeStr+    :: forall (f :: * -> *).+       (Typeable f)+    => String+seqrTypeStr =+    unwords+        [ "(*>)"+        , "::"+        , nameOf @f+        , "a"+        , "->"+        , nameOf @f+        , "b"+        , "->"+        , nameOf @f+        , "b"+        ]++seqlTypeStr+    :: forall (f :: * -> *).+       (Typeable f)+    => String+seqlTypeStr =+    unwords+        [ "(<*)"+        , "::"+        , nameOf @f+        , "a"+        , "->"+        , nameOf @f+        , "b"+        , "->"+        , nameOf @f+        , "a"+        ]++-- | Standard test spec for properties of Applicative instances for values generated with GenValid instances+--+-- Example usage:+--+-- > applicativeSpecOnArbitrary @[]+applicativeSpecOnValid+    :: forall (f :: * -> *).+       (Eq (f Int), Show (f Int), Applicative f, Typeable f, GenValid (f Int))+    => Spec+applicativeSpecOnValid = applicativeSpecWithInts @f genValid++-- | Standard test spec for properties of Applicative instances for values generated with GenUnchecked instances+--+-- Example usage:+--+-- > applicativeSpecOnArbitrary @[]+applicativeSpec+    :: forall (f :: * -> *).+       ( Eq (f Int)+       , Show (f Int)+       , Applicative f+       , Typeable f+       , GenUnchecked (f Int)+       )+    => Spec+applicativeSpec = applicativeSpecWithInts @f genUnchecked++-- | Standard test spec for properties of Applicative instances for values generated with Arbitrary instances+--+-- Example usage:+--+-- > applicativeSpecOnArbitrary @[]+applicativeSpecOnArbitrary+    :: forall (f :: * -> *).+       (Eq (f Int), Show (f Int), Applicative f, Typeable f, Arbitrary (f Int))+    => Spec+applicativeSpecOnArbitrary = applicativeSpecWithInts @f arbitrary++applicativeSpecWithInts+    :: forall (f :: * -> *).+       (Show (f Int), Eq (f Int), Applicative f, Typeable f)+    => Gen (f Int) -> Spec+applicativeSpecWithInts gen =+    applicativeSpecOnGens+        @f+        @Int+        genUnchecked+        "int"+        gen+        (unwords [nameOf @f, "of ints"])+        gen+        (unwords [nameOf @f, "of ints"])+        ((+) <$> genUnchecked)+        "increments"+        (pure <$> ((+) <$> genUnchecked))+        (unwords [nameOf @f, "of increments"])+        (pure <$> ((*) <$> genUnchecked))+        (unwords [nameOf @f, "of scalings"])++-- | Standard test spec for properties of Applicative instances for values generated by given generators (and names for those generator).+--+-- Unless you are building a specific regression test, you probably want to use the other 'applicativeSpec' functions.+--+-- Example usage:+--+-- > applicativeSpecOnGens+-- >     @Maybe+-- >     @String+-- >     (pure "ABC")+-- >     "ABC"+-- >     (Just <$> pure "ABC")+-- >     "Just an ABC"+-- >     (pure Nothing)+-- >     "purely Nothing"+-- >     ((++) <$> genValid)+-- >     "prepends"+-- >     (pure <$> ((++) <$> genValid))+-- >     "prepends in a Just"+-- >     (pure <$> (flip (++) <$> genValid))+-- >     "appends in a Just"+applicativeSpecOnGens+    :: forall (f :: * -> *) (a :: *) (b :: *) (c :: *).+       ( Show a+       , Eq a+       , Show (f a)+       , Eq (f a)+       , Show (f b)+       , Eq (f b)+       , Show (f c)+       , Eq (f c)+       , Applicative f+       , Typeable f+       , Typeable a+       , Typeable b+       , Typeable c+       )+    => Gen a+    -> String+    -> Gen (f a)+    -> String+    -> Gen (f b)+    -> String+    -> Gen (a -> b)+    -> String+    -> Gen (f (a -> b))+    -> String+    -> Gen (f (b -> c))+    -> 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+            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)+            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)+            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)+            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)+        describe (seqrTypeStr @f) $ do+            it+                (unwords+                     [ "is equivalent to its default implementation 'u *> 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)+        describe (seqlTypeStr @f) $ do+            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)+                    ((,) <$> gen <*> genb)

@@ -1,60 +1,45 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}++-- | Tests for Arbitrary instances involving Validity module Test.Validity.Arbitrary-    ( -- * Tests for Arbitrary instances involving Validity-      arbitrarySpec+    ( arbitrarySpec     , arbitraryGeneratesOnlyValid-    , shrinkProducesOnlyValids     ) where -import           Data.Data-import           Data.Proxy+import Data.Data -import           Data.GenValidity+import Data.GenValidity -import           Test.Hspec-import           Test.QuickCheck+import Test.Hspec+import Test.QuickCheck -import           Test.Validity.Utils-import           Test.Validity.GenValidity+import Test.Validity.GenValidity+import Test.Validity.Utils  -- | A @Spec@ that specifies that @arbitrary@ only generates data that--- satisfy @isValid@ and that @shrink@ only produces data that satisfy--- @isValid@.+-- satisfy @isValid@ -- -- Example usage: ----- > arbitrarySpec (Proxy :: Proxy MyData)+-- > arbitrarySpec @Int arbitrarySpec-    :: (Typeable a, Show a, Validity a, Arbitrary a)-    => Proxy a-    -> Spec-arbitrarySpec proxy = do-    let name = nameOf proxy-    describe ("Arbitrary " ++ name) $ do-        it ("is instantiated such that 'arbitrary' only generates valid \'"-            ++ name-            ++ "\'s.") $-            arbitraryGeneratesOnlyValid proxy--        it ("is instantiated such that 'shrink' only produces valid \'"-            ++ name-            ++ "\'s.") $-            forAll arbitrary $ \a ->-                shrink (a `asProxyTypeOf` proxy) `shouldSatisfy` all isValid+    :: forall a.+       (Typeable a, Show a, Validity a, Arbitrary a)+    => Spec+arbitrarySpec = do+    let name = nameOf @a+    describe ("Arbitrary " ++ name) $+        describe ("arbitrary :: Gen " ++ name) $+        it "only generates valid values" $ arbitraryGeneratesOnlyValid @a  -- | @arbitrary@ only generates valid data+--+-- prop> arbitraryGeneratesOnlyValid @Int arbitraryGeneratesOnlyValid-    :: forall a. (Show a, Validity a, Arbitrary a)-    => Proxy a-    -> Property-arbitraryGeneratesOnlyValid _ =-    genGeneratesValid (arbitrary :: Gen a)---- | @shrink@, applied to valid data only produces valid data-shrinkProducesOnlyValids-    :: forall a. (Show a, Validity a, Arbitrary a)-    => Proxy a-    -> Property-shrinkProducesOnlyValids _ =-    genGeneratesValid (shrink <$> arbitrary :: Gen [a])+    :: forall a.+       (Show a, Validity a, Arbitrary a)+    => Property+arbitraryGeneratesOnlyValid = genGeneratesValid @a arbitrary

@@ -1,47 +1,134 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++-- | Eq properties+--+-- You will need @TypeApplications@ to use these. module Test.Validity.Eq-    ( -- * Eq properties-      eqSpec+    ( eqSpecOnValid+    , eqSpec+    , eqSpecOnArbitrary+    , eqSpecOnGen     ) where -import           Data.Data-import           Data.Proxy+import Data.Data -import           Data.GenValidity+import Data.GenValidity -import           Test.Hspec+import Test.Hspec+import Test.QuickCheck -import           Test.Validity.Relations-import           Test.Validity.Utils+import Test.Validity.Functions+import Test.Validity.Relations+import Test.Validity.Utils -eqSpec-    :: (Show a, Eq a, Typeable a, GenValidity a)-    => Proxy a-    -> Spec-eqSpec proxy = do-    let name = nameOf proxy-        funeqstr = unwords-          [ "(==) ::"-          , name-          , "->"-          , name-          , "-> Bool"-          ]-        eq a b = a `asProxyTypeOf` proxy == b-    describe ("Eq " ++ name) $ do-        it ("is instantated such that "-            ++ funeqstr-            ++ " is reflexive") $-            reflexivity eq+eqTypeStr+    :: forall a.+       Typeable a+    => String+eqTypeStr = binRelStr @a "==" -        it ("is instantated such that "-            ++ funeqstr-            ++ " is symmetric") $-            symmetry eq+neqTypeStr+    :: forall a.+       Typeable a+    => String+neqTypeStr = binRelStr @a "/=" -        it ("is instantated such that "-            ++ funeqstr-            ++ " is transitive") $-            transitivity eq+-- | Standard test spec for properties of Eq instances for valid values+--+-- Example usage:+--+-- > eqSpecOnValid @Double+eqSpecOnValid+    :: forall a.+       (Show a, Eq a, Typeable a, GenValid a)+    => Spec+eqSpecOnValid = eqSpecOnGen @a genValid "valid" +-- | Standard test spec for properties of Eq instances for unchecked values+--+-- Example usage:+--+-- > eqSpec @Int+eqSpec+    :: forall a.+       (Show a, Eq a, Typeable a, GenUnchecked a)+    => Spec+eqSpec = eqSpecOnGen @a genUnchecked "unchecked"++-- | Standard test spec for properties of Eq instances for arbitrary values+--+-- Example usage:+--+-- > eqSpecOnArbitrary @Int+eqSpecOnArbitrary+    :: forall a.+       (Show a, Eq a, Typeable a, Arbitrary a)+    => Spec+eqSpecOnArbitrary = eqSpecOnGen @a arbitrary "arbitrary"++-- | Standard test spec for properties of Eq instances for values generated by a given generator (and name for that generator).+--+-- Example usage:+--+-- > eqSpecOnGen ((* 2) <$> genValid @Int) "even"+eqSpecOnGen+    :: forall a.+       (Show a, Eq a, Typeable a)+    => Gen a -> String -> Spec+eqSpecOnGen gen genname =+    parallel $ do+        let name = nameOf @a+            funeqstr = eqTypeStr @a+            funneqstr = neqTypeStr @a+            gen2 = (,) <$> gen <*> gen+            gen3 = (,,) <$> gen <*> gen <*> gen+        describe ("Eq " ++ name) $ do+            let eq = (==) @a+                neq = (/=) @a+            describe funeqstr $ do+                it+                    (unwords+                         [ "is reflexive for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "'s"+                         ]) $+                    reflexivityOnGen eq gen+                it+                    (unwords+                         [ "is symmetric for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "'s"+                         ]) $+                    symmetryOnGens eq gen2+                it+                    (unwords+                         [ "is transitive for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "'s"+                         ]) $+                    transitivityOnGens eq gen3+                it+                    (unwords+                         [ "is equivalent to (\\a b -> not $ a /= b) for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "'s"+                         ]) $+                    equivalentOnGens2 eq (\a b -> not $ a `neq` b) gen2+            describe funneqstr $ do+                it+                    (unwords+                         [ "is antireflexive for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "'s"+                         ]) $+                    antireflexivityOnGen neq gen+                it+                    (unwords+                         [ "is equivalent to (\\a b -> not $ a == b) for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "'s"+                         ]) $+                    equivalentOnGens2 neq (\a b -> not $ a `eq` b) gen2

@@ -1,10 +1,9 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}-module Test.Validity.Functions-    ( -- * Validity tests involving functions+{-# LANGUAGE ScopedTypeVariables #-} -      -- ** Standard tests involving validity-      producesValidsOnGen+-- | Validity tests involving functions+module Test.Validity.Functions+    ( producesValidsOnGen     , producesValidsOnValids     , producesValid     , producesValidsOnArbitrary@@ -16,61 +15,62 @@     , producesValidsOnValids3     , producesValid3     , producesValidsOnArbitrary3--      -- ** Standard tests involving functions that can fail     , succeedsOnGen     , succeedsOnValid     , succeeds     , succeedsOnArbitrary-     , succeedsOnGens2     , succeedsOnValids2     , succeeds2     , succeedsOnArbitrary2-     , failsOnGen     , failsOnInvalid-     , failsOnGens2     , failsOnInvalid2-     , validIfSucceedsOnGen     , validIfSucceedsOnValid     , validIfSucceedsOnArbitrary     , validIfSucceeds-     , validIfSucceedsOnGens2     , validIfSucceedsOnValids2     , validIfSucceeds2     , validIfSucceedsOnArbitrary2--      -- ** Standard tests involving equivalence of functions     , equivalentOnGen     , equivalentOnValid     , equivalent+    , equivalentOnArbitrary     , equivalentOnGens2     , equivalentOnValids2     , equivalent2+    , equivalentOnArbitrary2     , equivalentWhenFirstSucceedsOnGen     , equivalentWhenFirstSucceedsOnValid     , equivalentWhenFirstSucceeds+    , equivalentWhenFirstSucceedsOnArbitrary     , equivalentWhenFirstSucceedsOnGens2     , equivalentWhenFirstSucceedsOnValids2     , equivalentWhenFirstSucceeds2+    , equivalentWhenFirstSucceedsOnArbitrary2     , equivalentWhenSecondSucceedsOnGen     , equivalentWhenSecondSucceedsOnValid     , equivalentWhenSecondSucceeds+    , equivalentWhenSecondSucceedsOnArbitrary     , equivalentWhenSecondSucceedsOnGens2     , equivalentWhenSecondSucceedsOnValids2     , equivalentWhenSecondSucceeds2+    , equivalentWhenSecondSucceedsOnArbitrary2     , equivalentWhenSucceedOnGen     , equivalentWhenSucceedOnValid     , equivalentWhenSucceed+    , equivalentWhenSucceedOnArbitrary     , equivalentWhenSucceedOnGens2     , equivalentWhenSucceedOnValids2     , equivalentWhenSucceed2--      -- ** Standard tests involving inverse functions+    , equivalentWhenSucceedOnArbitrary2+    , equivalentOnGens3+    , equivalentOnValids3+    , equivalent3+    , equivalentOnArbitrary3     , inverseFunctionsOnGen     , inverseFunctionsOnValid     , inverseFunctions@@ -87,17 +87,14 @@     , inverseFunctionsIfSucceedOnValid     , inverseFunctionsIfSucceed     , inverseFunctionsIfSucceedOnArbitrary--      -- ** Properties involving idempotence     , idempotentOnGen     , idempotentOnValid     , idempotent     , idempotentOnArbitrary     ) where -import           Test.Validity.Functions.CanFail-import           Test.Validity.Functions.Equivalence-import           Test.Validity.Functions.Idempotence-import           Test.Validity.Functions.Inverse-import           Test.Validity.Functions.Validity-+import Test.Validity.Functions.CanFail+import Test.Validity.Functions.Equivalence+import Test.Validity.Functions.Idempotence+import Test.Validity.Functions.Inverse+import Test.Validity.Functions.Validity

@@ -1,223 +1,198 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module Test.Validity.Functions.CanFail-    ( -- ** Standard tests involving functions that can fail-      succeedsOnGen+    ( succeedsOnGen     , succeedsOnValid     , succeeds     , succeedsOnArbitrary-     , succeedsOnGens2     , succeedsOnValids2     , succeeds2     , succeedsOnArbitrary2-     , failsOnGen     , failsOnInvalid-     , failsOnGens2     , failsOnInvalid2-     , validIfSucceedsOnGen     , validIfSucceedsOnValid     , validIfSucceedsOnArbitrary     , validIfSucceeds-     , validIfSucceedsOnGens2     , validIfSucceedsOnValids2     , validIfSucceeds2     , validIfSucceedsOnArbitrary2     ) where -import           Data.GenValidity+import Data.GenValidity -import           Test.Hspec-import           Test.QuickCheck+import Test.Hspec+import Test.QuickCheck -import           Test.Validity.Types+import Test.Validity.Types  -- | The function succeeds if the input is generated by the given generator succeedsOnGen     :: (Show a, Show b, Show (f b), CanFail f)-    => (a -> f b)-    -> Gen a-    -> Property-succeedsOnGen func gen-    = forAll gen $ \a -> func a `shouldNotSatisfy` hasFailed+    => (a -> f b) -> Gen a -> Property+succeedsOnGen func gen = forAll gen $ \a -> func a `shouldNotSatisfy` hasFailed  -- | The function succeeds if the input is generated by @genValid@ succeedsOnValid-    :: (Show a, Show b, Show (f b), GenValidity a, CanFail f)-    => (a -> f b)-    -> Property+    :: (Show a, Show b, Show (f b), GenValid a, CanFail f)+    => (a -> f b) -> Property succeedsOnValid = (`succeedsOnGen` genValid)  -- | The function succeeds if the input is generated by @genUnchecked@ succeeds-    :: (Show a, Show b, Show (f b), GenValidity a, CanFail f)-    => (a -> f b)-    -> Property+    :: (Show a, Show b, Show (f b), GenUnchecked a, CanFail f)+    => (a -> f b) -> Property succeeds = (`succeedsOnGen` genUnchecked)  -- | The function succeeds if the input is generated by @arbitrary@ succeedsOnArbitrary     :: (Show a, Show b, Show (f b), Arbitrary a, CanFail f)-    => (a -> f b)-    -> Property+    => (a -> f b) -> Property succeedsOnArbitrary = (`succeedsOnGen` arbitrary)  -- | The function fails if the input is generated by the given generator failsOnGen     :: (Show a, Show b, Show (f b), CanFail f)-    => (a -> f b)-    -> Gen a-    -> Property-failsOnGen func gen-    = forAll gen $ \a -> func a `shouldSatisfy` hasFailed+    => (a -> f b) -> Gen a -> Property+failsOnGen func gen = forAll gen $ \a -> func a `shouldSatisfy` hasFailed  -- | The function fails if the input is generated by @genInvalid@ failsOnInvalid-    :: (Show a, Show b, Show (f b), GenValidity a, CanFail f)-    => (a -> f b)-    -> Property+    :: (Show a, Show b, Show (f b), GenInvalid a, CanFail f)+    => (a -> f b) -> Property failsOnInvalid = (`failsOnGen` genInvalid)  -- | The function produces output that satisfies @isValid@ if it is given input -- that is generated by the given generator. validIfSucceedsOnGen     :: (Show a, Show b, Show (f b), Validity b, CanFail f)-    => (a -> f b)-    -> Gen a-    -> Property-validIfSucceedsOnGen func gen-    = forAll gen $ \a ->+    => (a -> f b) -> Gen a -> Property+validIfSucceedsOnGen func gen =+    forAll gen $ \a ->         case resultIfSucceeded (func a) of-            Nothing  -> return () -- Can happen+            Nothing -> return () -- Can happen             Just res -> res `shouldSatisfy` isValid  -- | The function produces output that satisfies @isValid@ if it is given input -- that is generated by @arbitrary@. validIfSucceedsOnValid-    :: (Show a, Show b, Show (f b), GenValidity a, Validity b, CanFail f)-    => (a -> f b)-    -> Property+    :: (Show a, Show b, Show (f b), GenValid a, Validity b, CanFail f)+    => (a -> f b) -> Property validIfSucceedsOnValid = (`validIfSucceedsOnGen` genValid) - -- | The function produces output that satisfies @isValid@ if it is given input -- that is generated by @arbitrary@. validIfSucceedsOnArbitrary     :: (Show a, Show b, Show (f b), Arbitrary a, Validity b, CanFail f)-    => (a -> f b)-    -> Property+    => (a -> f b) -> Property validIfSucceedsOnArbitrary = (`validIfSucceedsOnGen` arbitrary)  -- | The function produces output that satisfies @isValid@ if it is given input -- that is generated by @genUnchecked@. validIfSucceeds-    :: (Show a, Show b, Show (f b), GenValidity a, Validity b, CanFail f)-    => (a -> f b)-    -> Property+    :: (Show a, Show b, Show (f b), GenUnchecked a, Validity b, CanFail f)+    => (a -> f b) -> Property validIfSucceeds = (`validIfSucceedsOnGen` genUnchecked) - succeedsOnGens2-    :: (Show a, Show b, Show c, Show (f c),-        CanFail f)-    => (a -> b -> f c)-    -> Gen (a, b)-    -> Property+    :: (Show a, Show b, Show c, Show (f c), CanFail f)+    => (a -> b -> f c) -> Gen (a, b) -> Property succeedsOnGens2 func gen =-    forAll gen $ \(a, b) ->-        func a b `shouldNotSatisfy` hasFailed-+    forAll gen $ \(a, b) -> func a b `shouldNotSatisfy` hasFailed  succeedsOnValids2-    :: (Show a, Show b, Show c, Show (f c),-        GenValidity a, GenValidity b,-        CanFail f)-    => (a -> b -> f c)-    -> Property-succeedsOnValids2 func-    = succeedsOnGens2 func genValid+    :: (Show a, Show b, Show c, Show (f c), GenValid a, GenValid b, CanFail f)+    => (a -> b -> f c) -> Property+succeedsOnValids2 func = succeedsOnGens2 func genValid  succeeds2-    :: (Show a, Show b, Show c, Show (f c),-        GenValidity a, GenValidity b,-        CanFail f)-    => (a -> b -> f c)-    -> Property-succeeds2 func-    = succeedsOnGens2 func genUnchecked+    :: ( Show a+       , Show b+       , Show c+       , Show (f c)+       , GenUnchecked a+       , GenUnchecked b+       , CanFail f+       )+    => (a -> b -> f c) -> Property+succeeds2 func = succeedsOnGens2 func genUnchecked  succeedsOnArbitrary2-    :: (Show a, Show b, Show c, Show (f c),-        Arbitrary a, Arbitrary b,-        CanFail f)-    => (a -> b -> f c)-    -> Property-succeedsOnArbitrary2 func-    = succeedsOnGens2 func arbitrary-+    :: (Show a, Show b, Show c, Show (f c), Arbitrary a, Arbitrary b, CanFail f)+    => (a -> b -> f c) -> Property+succeedsOnArbitrary2 func = succeedsOnGens2 func arbitrary  failsOnGens2-    :: (Show a, Show b, Show c, Show (f c),-        CanFail f)-    => (a -> b -> f c)-    -> Gen a -> Gen b-    -> Property+    :: (Show a, Show b, Show c, Show (f c), CanFail f)+    => (a -> b -> f c) -> Gen a -> Gen b -> Property failsOnGens2 func genA genB =-    forAll genA $ \a ->-        forAll genB $ \b ->-            func a b `shouldSatisfy` hasFailed-+    forAll genA $ \a -> forAll genB $ \b -> func a b `shouldSatisfy` hasFailed  failsOnInvalid2-    :: (Show a, Show b, Show c, Show (f c),-        GenValidity a, GenValidity b,-        CanFail f)-    => (a -> b -> f c)-    -> Property-failsOnInvalid2 func-    =    failsOnGens2 func genInvalid genUnchecked-    .&&. failsOnGens2 func genUnchecked genInvalid-+    :: ( Show a+       , Show b+       , Show c+       , Show (f c)+       , GenInvalid a+       , GenUnchecked a+       , GenInvalid b+       , GenUnchecked b+       , CanFail f+       )+    => (a -> b -> f c) -> Property+failsOnInvalid2 func =+    failsOnGens2 func genInvalid genUnchecked .&&.+    failsOnGens2 func genUnchecked genInvalid  validIfSucceedsOnGens2-    :: (Show a, Show b, Show c, Show (f c),-        Validity c, CanFail f)-    => (a -> b -> f c)-    -> Gen (a, b)-    -> Property+    :: (Show a, Show b, Show c, Show (f c), Validity c, CanFail f)+    => (a -> b -> f c) -> Gen (a, b) -> Property validIfSucceedsOnGens2 func gen =     forAll gen $ \(a, b) ->         case resultIfSucceeded (func a b) of-            Nothing  -> return () -- Can happen+            Nothing -> return () -- Can happen             Just res -> res `shouldSatisfy` isValid  validIfSucceedsOnValids2-    :: (Show a, Show b, Show c, Show (f c),-        GenValidity a, GenValidity b,-        Validity c, CanFail f)-    => (a -> b -> f c)-    -> Property-validIfSucceedsOnValids2 func-    = validIfSucceedsOnGens2 func genValid+    :: ( Show a+       , Show b+       , Show c+       , Show (f c)+       , GenValid a+       , GenValid b+       , Validity c+       , CanFail f+       )+    => (a -> b -> f c) -> Property+validIfSucceedsOnValids2 func = validIfSucceedsOnGens2 func genValid  validIfSucceeds2-    :: (Show a, Show b, Show c, Show (f c),-        GenValidity a, GenValidity b,-        Validity c, CanFail f)-    => (a -> b -> f c)-    -> Property-validIfSucceeds2 func-    = validIfSucceedsOnGens2 func genUnchecked+    :: ( Show a+       , Show b+       , Show c+       , Show (f c)+       , GenUnchecked a+       , GenUnchecked b+       , Validity c+       , CanFail f+       )+    => (a -> b -> f c) -> Property+validIfSucceeds2 func = validIfSucceedsOnGens2 func genUnchecked  validIfSucceedsOnArbitrary2-    :: (Show a, Show b, Show c, Show (f c),-        Arbitrary a, Arbitrary b,-        Validity c, CanFail f)-    => (a -> b -> f c)-    -> Property-validIfSucceedsOnArbitrary2 func-    = validIfSucceedsOnGens2 func arbitrary+    :: ( Show a+       , Show b+       , Show c+       , Show (f c)+       , Arbitrary a+       , Arbitrary b+       , Validity c+       , CanFail f+       )+    => (a -> b -> f c) -> Property+validIfSucceedsOnArbitrary2 func = validIfSucceedsOnGens2 func arbitrary

@@ -1,135 +1,136 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module Test.Validity.Functions.Equivalence-    ( -- ** Standard tests involving equivalence of functions-      equivalentOnGen+    ( equivalentOnGen     , equivalentOnValid     , equivalent+    , equivalentOnArbitrary     , equivalentOnGens2     , equivalentOnValids2     , equivalent2+    , equivalentOnArbitrary2     , equivalentWhenFirstSucceedsOnGen     , equivalentWhenFirstSucceedsOnValid     , equivalentWhenFirstSucceeds+    , equivalentWhenFirstSucceedsOnArbitrary     , equivalentWhenFirstSucceedsOnGens2     , equivalentWhenFirstSucceedsOnValids2     , equivalentWhenFirstSucceeds2+    , equivalentWhenFirstSucceedsOnArbitrary2     , equivalentWhenSecondSucceedsOnGen     , equivalentWhenSecondSucceedsOnValid     , equivalentWhenSecondSucceeds+    , equivalentWhenSecondSucceedsOnArbitrary     , equivalentWhenSecondSucceedsOnGens2     , equivalentWhenSecondSucceedsOnValids2     , equivalentWhenSecondSucceeds2+    , equivalentWhenSecondSucceedsOnArbitrary2     , equivalentWhenSucceedOnGen     , equivalentWhenSucceedOnValid     , equivalentWhenSucceed+    , equivalentWhenSucceedOnArbitrary     , equivalentWhenSucceedOnGens2     , equivalentWhenSucceedOnValids2     , equivalentWhenSucceed2+    , equivalentWhenSucceedOnArbitrary2+    , equivalentOnGens3+    , equivalentOnValids3+    , equivalent3+    , equivalentOnArbitrary3     ) where -import           Data.GenValidity+import Data.GenValidity -import           Test.Hspec-import           Test.QuickCheck+import Test.Hspec+import Test.QuickCheck -import           Test.Validity.Types+import Test.Validity.Types  equivalentOnGen     :: (Show a, Eq a, Show b, Eq b)-    => (a -> b)-    -> (a -> b)-    -> Gen a-    -> Property-equivalentOnGen f g gen =-    forAll gen $ \a ->-        f a `shouldBe` g a+    => (a -> b) -> (a -> b) -> Gen a -> Property+equivalentOnGen f g gen = forAll gen $ \a -> f a `shouldBe` g a  equivalentOnValid-    :: (Show a, Eq a, GenValidity a, Show b, Eq b)-    => (a -> b)-    -> (a -> b)-    -> Property-equivalentOnValid f g-    = equivalentOnGen f g genValid+    :: (Show a, Eq a, GenValid a, Show b, Eq b)+    => (a -> b) -> (a -> b) -> Property+equivalentOnValid f g = equivalentOnGen f g genValid  equivalent-    :: (Show a, Eq a, GenValidity a, Show b, Eq b)-    => (a -> b)-    -> (a -> b)-    -> Property-equivalent f g-    = equivalentOnGen f g genUnchecked+    :: (Show a, Eq a, GenUnchecked a, Show b, Eq b)+    => (a -> b) -> (a -> b) -> Property+equivalent f g = equivalentOnGen f g genUnchecked +-- |+--+-- prop> equivalentOnArbitrary ((* 2) . (+ 1)) ((+ 2) . (* 2) :: Int -> Int)+equivalentOnArbitrary+    :: (Show a, Eq a, Arbitrary a, Show b, Eq b)+    => (a -> b) -> (a -> b) -> Property+equivalentOnArbitrary f g = equivalentOnGen f g arbitrary+ equivalentOnGens2-    :: (Show a, Eq a,-        Show b, Eq b,-        Show c, Eq c)-    => (a -> b -> c)-    -> (a -> b -> c)-    -> Gen (a, b)-    -> Property-equivalentOnGens2 f g gen =-    forAll gen $ \(a, b) ->-        f a b `shouldBe` g a b+    :: (Show a, Show b, Show c, Eq c)+    => (a -> b -> c) -> (a -> b -> c) -> Gen (a, b) -> Property+equivalentOnGens2 f g gen = forAll gen $ \(a, b) -> f a b `shouldBe` g a b  equivalentOnValids2-    :: (Show a, Eq a, GenValidity a,-        Show b, Eq b, GenValidity b,-        Show c, Eq c)-    => (a -> b -> c)-    -> (a -> b -> c)-    -> Property-equivalentOnValids2 f g-    = equivalentOnGens2 f g genValid+    :: (Show a, Eq a, GenValid a, Show b, Eq b, GenValid b, Show c, Eq c)+    => (a -> b -> c) -> (a -> b -> c) -> Property+equivalentOnValids2 f g = equivalentOnGens2 f g genValid  equivalent2-    :: (Show a, Eq a, GenValidity a,-        Show b, Eq b, GenValidity b,-        Show c, Eq c)-    => (a -> b -> c)-    -> (a -> b -> c)-    -> Property-equivalent2 f g-    = equivalentOnGens2 f g genUnchecked+    :: ( Show a+       , Eq a+       , GenUnchecked a+       , Show b+       , Eq b+       , GenUnchecked b+       , Show c+       , Eq c+       )+    => (a -> b -> c) -> (a -> b -> c) -> Property+equivalent2 f g = equivalentOnGens2 f g genUnchecked +-- |+--+-- prop> equivalentOnArbitrary2 (+) ((+) :: Int -> Int -> Int)+equivalentOnArbitrary2+    :: (Show a, Eq a, Arbitrary a, Show b, Eq b, Arbitrary b, Show c, Eq c)+    => (a -> b -> c) -> (a -> b -> c) -> Property+equivalentOnArbitrary2 f g = equivalentOnGens2 f g arbitrary+ equivalentWhenFirstSucceedsOnGen     :: (Show a, Eq a, Show b, Eq b, CanFail f)-    => (a -> f b)-    -> (a -> b)-    -> Gen a-    -> Property+    => (a -> f b) -> (a -> b) -> Gen a -> Property equivalentWhenFirstSucceedsOnGen f g gen =     forAll gen $ \a ->         case resultIfSucceeded (f a) of             Nothing -> return () -- fine-            Just r  -> r `shouldBe` g a+            Just r -> r `shouldBe` g a  equivalentWhenFirstSucceedsOnValid-    :: (Show a, Eq a, GenValidity a, Show b, Eq b, CanFail f)-    => (a -> f b)-    -> (a -> b)-    -> Property-equivalentWhenFirstSucceedsOnValid f g-    = equivalentWhenFirstSucceedsOnGen f g genValid+    :: (Show a, Eq a, GenValid a, Show b, Eq b, CanFail f)+    => (a -> f b) -> (a -> b) -> Property+equivalentWhenFirstSucceedsOnValid f g =+    equivalentWhenFirstSucceedsOnGen f g genValid +equivalentWhenFirstSucceedsOnArbitrary+    :: (Show a, Eq a, Arbitrary a, Show b, Eq b, CanFail f)+    => (a -> f b) -> (a -> b) -> Property+equivalentWhenFirstSucceedsOnArbitrary f g =+    equivalentWhenFirstSucceedsOnGen f g arbitrary+ equivalentWhenFirstSucceeds-    :: (Show a, Eq a, GenValidity a, Show b, Eq b, CanFail f)-    => (a -> f b)-    -> (a -> b)-    -> Property-equivalentWhenFirstSucceeds f g-    = equivalentWhenFirstSucceedsOnGen f g genUnchecked+    :: (Show a, Eq a, GenUnchecked a, Show b, Eq b, CanFail f)+    => (a -> f b) -> (a -> b) -> Property+equivalentWhenFirstSucceeds f g =+    equivalentWhenFirstSucceedsOnGen f g genUnchecked  equivalentWhenFirstSucceedsOnGens2-    :: (Show a, Eq a,-        Show b, Eq b,-        Show c, Eq c,-        CanFail f)-    => (a -> b -> f c)-    -> (a -> b -> c)-    -> Gen (a, b)-    -> Property+    :: (Show a, Eq a, Show b, Eq b, Show c, Eq c, CanFail f)+    => (a -> b -> f c) -> (a -> b -> c) -> Gen (a, b) -> Property equivalentWhenFirstSucceedsOnGens2 f g gen =     forAll gen $ \(a, b) ->         case resultIfSucceeded (f a b) of@@ -137,64 +138,80 @@             Just rs -> rs `shouldBe` g a b  equivalentWhenFirstSucceedsOnValids2-    :: (Show a, Eq a, GenValidity a,-        Show b, Eq b, GenValidity b,-        Show c, Eq c,-        CanFail f)-    => (a -> b -> f c)-    -> (a -> b -> c)-    -> Property-equivalentWhenFirstSucceedsOnValids2 f g-    = equivalentWhenFirstSucceedsOnGens2 f g genValid+    :: ( Show a+       , Eq a+       , GenValid a+       , Show b+       , Eq b+       , GenValid b+       , Show c+       , Eq c+       , CanFail f+       )+    => (a -> b -> f c) -> (a -> b -> c) -> Property+equivalentWhenFirstSucceedsOnValids2 f g =+    equivalentWhenFirstSucceedsOnGens2 f g genValid +equivalentWhenFirstSucceedsOnArbitrary2+    :: ( Show a+       , Eq a+       , Arbitrary a+       , Show b+       , Eq b+       , Arbitrary b+       , Show c+       , Eq c+       , CanFail f+       )+    => (a -> b -> f c) -> (a -> b -> c) -> Property+equivalentWhenFirstSucceedsOnArbitrary2 f g =+    equivalentWhenFirstSucceedsOnGens2 f g arbitrary+ equivalentWhenFirstSucceeds2-    :: (Show a, Eq a, GenValidity a,-        Show b, Eq b, GenValidity b,-        Show c, Eq c,-        CanFail f)-    => (a -> b -> f c)-    -> (a -> b -> c)-    -> Property-equivalentWhenFirstSucceeds2 f g-    = equivalentWhenFirstSucceedsOnGens2 f g genUnchecked+    :: ( Show a+       , Eq a+       , GenUnchecked a+       , Show b+       , Eq b+       , GenUnchecked b+       , Show c+       , Eq c+       , CanFail f+       )+    => (a -> b -> f c) -> (a -> b -> c) -> Property+equivalentWhenFirstSucceeds2 f g =+    equivalentWhenFirstSucceedsOnGens2 f g genUnchecked  equivalentWhenSecondSucceedsOnGen     :: (Show a, Eq a, Show b, Eq b, CanFail f)-    => (a -> b)-    -> (a -> f b)-    -> Gen a-    -> Property+    => (a -> b) -> (a -> f b) -> Gen a -> Property equivalentWhenSecondSucceedsOnGen f g gen =     forAll gen $ \a ->         case resultIfSucceeded (g a) of             Nothing -> return () -- fine-            Just r  -> r `shouldBe` f a+            Just r -> r `shouldBe` f a  equivalentWhenSecondSucceedsOnValid-    :: (Show a, Eq a, GenValidity a, Show b, Eq b, CanFail f)-    => (a -> b)-    -> (a -> f b)-    -> Property-equivalentWhenSecondSucceedsOnValid f g-    = equivalentWhenSecondSucceedsOnGen f g genValid+    :: (Show a, Eq a, GenValid a, Show b, Eq b, CanFail f)+    => (a -> b) -> (a -> f b) -> Property+equivalentWhenSecondSucceedsOnValid f g =+    equivalentWhenSecondSucceedsOnGen f g genValid +equivalentWhenSecondSucceedsOnArbitrary+    :: (Show a, Eq a, Arbitrary a, Show b, Eq b, CanFail f)+    => (a -> b) -> (a -> f b) -> Property+equivalentWhenSecondSucceedsOnArbitrary f g =+    equivalentWhenSecondSucceedsOnGen f g arbitrary+ equivalentWhenSecondSucceeds-    :: (Show a, Eq a, GenValidity a, Show b, Eq b, CanFail f)-    => (a -> b)-    -> (a -> f b)-    -> Property-equivalentWhenSecondSucceeds f g-    = equivalentWhenSecondSucceedsOnGen f g genUnchecked+    :: (Show a, Eq a, GenUnchecked a, Show b, Eq b, CanFail f)+    => (a -> b) -> (a -> f b) -> Property+equivalentWhenSecondSucceeds f g =+    equivalentWhenSecondSucceedsOnGen f g genUnchecked  equivalentWhenSecondSucceedsOnGens2-    :: (Show a, Eq a,-        Show b, Eq b,-        Show c, Eq c,-        CanFail f)-    => (a -> b -> c)-    -> (a -> b -> f c)-    -> Gen (a, b)-    -> Property+    :: (Show a, Eq a, Show b, Eq b, Show c, Eq c, CanFail f)+    => (a -> b -> c) -> (a -> b -> f c) -> Gen (a, b) -> Property equivalentWhenSecondSucceedsOnGens2 f g gen =     forAll gen $ \(a, b) ->         case resultIfSucceeded (g a b) of@@ -202,94 +219,180 @@             Just rs -> rs `shouldBe` f a b  equivalentWhenSecondSucceedsOnValids2-    :: (Show a, Eq a, GenValidity a,-         Show b, Eq b, GenValidity b,-         Show c, Eq c,-         CanFail f)-    => (a -> b -> c)-    -> (a -> b -> f c)-    -> Property-equivalentWhenSecondSucceedsOnValids2 f g-    = equivalentWhenSecondSucceedsOnGens2 f g genValid+    :: ( Show a+       , Eq a+       , GenValid a+       , Show b+       , Eq b+       , GenValid b+       , Show c+       , Eq c+       , CanFail f+       )+    => (a -> b -> c) -> (a -> b -> f c) -> Property+equivalentWhenSecondSucceedsOnValids2 f g =+    equivalentWhenSecondSucceedsOnGens2 f g genValid +equivalentWhenSecondSucceedsOnArbitrary2+    :: ( Show a+       , Eq a+       , Arbitrary a+       , Show b+       , Eq b+       , Arbitrary b+       , Show c+       , Eq c+       , CanFail f+       )+    => (a -> b -> c) -> (a -> b -> f c) -> Property+equivalentWhenSecondSucceedsOnArbitrary2 f g =+    equivalentWhenSecondSucceedsOnGens2 f g arbitrary+ equivalentWhenSecondSucceeds2-    :: (Show a, Eq a, GenValidity a,-        Show b, Eq b, GenValidity b,-        Show c, Eq c,-        CanFail f)-    => (a -> b -> c)-    -> (a -> b -> f c)-    -> Property-equivalentWhenSecondSucceeds2 f g-    = equivalentWhenSecondSucceedsOnGens2 f g genUnchecked+    :: ( Show a+       , Eq a+       , GenUnchecked a+       , Show b+       , Eq b+       , GenUnchecked b+       , Show c+       , Eq c+       , CanFail f+       )+    => (a -> b -> c) -> (a -> b -> f c) -> Property+equivalentWhenSecondSucceeds2 f g =+    equivalentWhenSecondSucceedsOnGens2 f g genUnchecked  equivalentWhenSucceedOnGen     :: (Show a, Eq a, Show b, Eq b, CanFail f)-    => (a -> f b)-    -> (a -> f b)-    -> Gen a-    -> Property+    => (a -> f b) -> (a -> f b) -> Gen a -> Property equivalentWhenSucceedOnGen f g gen =     forAll gen $ \a ->         case do fa <- resultIfSucceeded $ f a                 ga <- resultIfSucceeded $ g a-                return (fa, ga)-            of+                return (fa, ga) of             Nothing -> return () -- fine-            Just (fa, ga)  -> fa `shouldBe` ga+            Just (fa, ga) -> fa `shouldBe` ga  equivalentWhenSucceedOnValid-    :: (Show a, Eq a, GenValidity a, Show b, Eq b, CanFail f)-    => (a -> f b)-    -> (a -> f b)-    -> Property-equivalentWhenSucceedOnValid f g-    = equivalentWhenSucceedOnGen f g genValid+    :: (Show a, Eq a, GenValid a, Show b, Eq b, CanFail f)+    => (a -> f b) -> (a -> f b) -> Property+equivalentWhenSucceedOnValid f g = equivalentWhenSucceedOnGen f g genValid  equivalentWhenSucceed-    :: (Show a, Eq a, GenValidity a, Show b, Eq b, CanFail f)-    => (a -> f b)-    -> (a -> f b)-    -> Property-equivalentWhenSucceed f g-    = equivalentWhenSucceedOnGen f g genUnchecked+    :: (Show a, Eq a, GenUnchecked a, Show b, Eq b, CanFail f)+    => (a -> f b) -> (a -> f b) -> Property+equivalentWhenSucceed f g = equivalentWhenSucceedOnGen f g genUnchecked +equivalentWhenSucceedOnArbitrary+    :: (Show a, Eq a, Arbitrary a, Show b, Eq b, CanFail f)+    => (a -> f b) -> (a -> f b) -> Property+equivalentWhenSucceedOnArbitrary f g = equivalentWhenSucceedOnGen f g arbitrary+ equivalentWhenSucceedOnGens2-    :: (Show a, Eq a,-        Show b, Eq b,-        Show c, Eq c,-        CanFail f)-    => (a -> b -> f c)-    -> (a -> b -> f c)-    -> Gen (a, b)-    -> Property+    :: (Show a, Eq a, Show b, Eq b, Show c, Eq c, CanFail f)+    => (a -> b -> f c) -> (a -> b -> f c) -> Gen (a, b) -> Property equivalentWhenSucceedOnGens2 f g gen =     forAll gen $ \(a, b) ->         case do fab <- resultIfSucceeded $ f a b                 gab <- resultIfSucceeded $ g a b-                return (fab, gab)-                of+                return (fab, gab) of             Nothing -> return () -- fine             Just (fab, gab) -> fab `shouldBe` gab  equivalentWhenSucceedOnValids2-    :: (Show a, Eq a, GenValidity a,-        Show b, Eq b, GenValidity b,-        Show c, Eq c,-        CanFail f)-    => (a -> b -> f c)-    -> (a -> b -> f c)-    -> Property-equivalentWhenSucceedOnValids2 f g-    = equivalentWhenSucceedOnGens2 f g genValid+    :: ( Show a+       , Eq a+       , GenValid a+       , Show b+       , Eq b+       , GenValid b+       , Show c+       , Eq c+       , CanFail f+       )+    => (a -> b -> f c) -> (a -> b -> f c) -> Property+equivalentWhenSucceedOnValids2 f g = equivalentWhenSucceedOnGens2 f g genValid +equivalentWhenSucceedOnArbitrary2+    :: ( Show a+       , Eq a+       , Arbitrary a+       , Show b+       , Eq b+       , Arbitrary b+       , Show c+       , Eq c+       , CanFail f+       )+    => (a -> b -> f c) -> (a -> b -> f c) -> Property+equivalentWhenSucceedOnArbitrary2 f g =+    equivalentWhenSucceedOnGens2 f g arbitrary+ equivalentWhenSucceed2-    :: (Show a, Eq a, GenValidity a,-        Show b, Eq b, GenValidity b,-        Show c, Eq c,-        CanFail f)-    => (a -> b -> f c)-    -> (a -> b -> f c)-    -> Property-equivalentWhenSucceed2 f g-    = equivalentWhenSucceedOnGens2 f g genUnchecked+    :: ( Show a+       , Eq a+       , GenUnchecked a+       , Show b+       , Eq b+       , GenUnchecked b+       , Show c+       , Eq c+       , CanFail f+       )+    => (a -> b -> f c) -> (a -> b -> f c) -> Property+equivalentWhenSucceed2 f g = equivalentWhenSucceedOnGens2 f g genUnchecked++equivalentOnGens3+    :: (Show a, Show b, Show c, Show d, Eq d)+    => (a -> b -> c -> d) -> (a -> b -> c -> d) -> Gen (a, b, c) -> Property+equivalentOnGens3 f g gen =+    forAll gen $ \(a, b, c) -> f a b c `shouldBe` g a b c++equivalentOnValids3+    :: ( Show a+       , Eq a+       , GenValid a+       , Show b+       , Eq b+       , GenValid b+       , Show c+       , Eq c+       , GenValid c+       , Show d+       , Eq d+       )+    => (a -> b -> c -> d) -> (a -> b -> c -> d) -> Property+equivalentOnValids3 f g = equivalentOnGens3 f g genValid++equivalent3+    :: ( Show a+       , Eq a+       , GenUnchecked a+       , Show b+       , Eq b+       , GenUnchecked b+       , Show c+       , Eq c+       , GenUnchecked c+       , Show d+       , Eq d+       )+    => (a -> b -> c -> d) -> (a -> b -> c -> d) -> Property+equivalent3 f g = equivalentOnGens3 f g genUnchecked++equivalentOnArbitrary3+    :: ( Show a+       , Eq a+       , Arbitrary a+       , Show b+       , Eq b+       , Arbitrary b+       , Show c+       , Eq c+       , Arbitrary c+       , Show d+       , Eq d+       )+    => (a -> b -> c -> d) -> (a -> b -> c -> d) -> Property+equivalentOnArbitrary3 f g = equivalentOnGens3 f g arbitrary

@@ -23,13 +23,13 @@         f (f a) `shouldBe` f a  idempotentOnValid-    :: (Show a, Eq a, GenValidity a)+    :: (Show a, Eq a, GenValid a)     => (a -> a)     -> Property idempotentOnValid func = idempotentOnGen func genValid  idempotent-    :: (Show a, Eq a, GenValidity a)+    :: (Show a, Eq a, GenUnchecked a)     => (a -> a)     -> Property idempotent func = idempotentOnGen func genUnchecked

@@ -1,8 +1,9 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Standard tests involving inverse functions module Test.Validity.Functions.Inverse-    ( -- ** Standard tests involving inverse functions-      inverseFunctionsOnGen+    ( inverseFunctionsOnGen     , inverseFunctionsOnValid     , inverseFunctions     , inverseFunctionsOnArbitrary@@ -20,166 +21,113 @@     , inverseFunctionsIfSucceedOnArbitrary     ) where -import           Data.GenValidity+import Data.GenValidity -import           Test.Hspec-import           Test.QuickCheck+import Test.Hspec+import Test.QuickCheck -import           Test.Validity.Types+import Test.Validity.Types  inverseFunctionsOnGen     :: (Show a, Eq a)-    => (a -> b)-    -> (b -> a)-    -> Gen a-    -> Property-inverseFunctionsOnGen f g gen =-    forAll gen $ \a ->-      g (f a) `shouldBe` a-+    => (a -> b) -> (b -> a) -> Gen a -> Property+inverseFunctionsOnGen f g gen = forAll gen $ \a -> g (f a) `shouldBe` a  inverseFunctionsOnValid-    :: (Show a, Eq a, GenValidity a)-    => (a -> b)-    -> (b -> a)-    -> Property-inverseFunctionsOnValid f g-    = inverseFunctionsOnGen f g genValid-+    :: (Show a, Eq a, GenValid a)+    => (a -> b) -> (b -> a) -> Property+inverseFunctionsOnValid f g = inverseFunctionsOnGen f g genValid  inverseFunctions-    :: (Show a, Eq a, GenValidity a)-    => (a -> b)-    -> (b -> a)-    -> Property-inverseFunctions f g-    = inverseFunctionsOnGen f g genUnchecked+    :: (Show a, Eq a, GenUnchecked a)+    => (a -> b) -> (b -> a) -> Property+inverseFunctions f g = inverseFunctionsOnGen f g genUnchecked  -- | -- 'id' is its own inverse function for every type: -- prop> inverseFunctionsOnArbitrary id (id :: Int -> Int) inverseFunctionsOnArbitrary     :: (Show a, Eq a, Arbitrary a)-    => (a -> b)-    -> (b -> a)-    -> Property-inverseFunctionsOnArbitrary f g-    = inverseFunctionsOnGen f g arbitrary-+    => (a -> b) -> (b -> a) -> Property+inverseFunctionsOnArbitrary f g = inverseFunctionsOnGen f g arbitrary  inverseFunctionsIfFirstSucceedsOnGen     :: (Show a, Eq a, CanFail f)-    => (a -> f b)-    -> (b -> a)-    -> Gen a-    -> Property+    => (a -> f b) -> (b -> a) -> Gen a -> Property inverseFunctionsIfFirstSucceedsOnGen f g gen =     forAll gen $ \a ->-      case resultIfSucceeded (f a) of-          Nothing -> return () -- fine-          Just b  -> g b `shouldBe` a-+        case resultIfSucceeded (f a) of+            Nothing -> return () -- fine+            Just b -> g b `shouldBe` a  inverseFunctionsIfFirstSucceedsOnValid-    :: (Show a, Eq a, GenValidity a, CanFail f)-    => (a -> f b)-    -> (b -> a)-    -> Property-inverseFunctionsIfFirstSucceedsOnValid f g-    = inverseFunctionsIfFirstSucceedsOnGen f g genValid-+    :: (Show a, Eq a, GenValid a, CanFail f)+    => (a -> f b) -> (b -> a) -> Property+inverseFunctionsIfFirstSucceedsOnValid f g =+    inverseFunctionsIfFirstSucceedsOnGen f g genValid  inverseFunctionsIfFirstSucceeds-    :: (Show a, Eq a, GenValidity a, CanFail f)-    => (a -> f b)-    -> (b -> a)-    -> Property-inverseFunctionsIfFirstSucceeds f g-    = inverseFunctionsIfFirstSucceedsOnGen f g genUnchecked+    :: (Show a, Eq a, GenUnchecked a, CanFail f)+    => (a -> f b) -> (b -> a) -> Property+inverseFunctionsIfFirstSucceeds f g =+    inverseFunctionsIfFirstSucceedsOnGen f g genUnchecked  inverseFunctionsIfFirstSucceedsOnArbitrary     :: (Show a, Eq a, Arbitrary a, CanFail f)-    => (a -> f b)-    -> (b -> a)-    -> Property-inverseFunctionsIfFirstSucceedsOnArbitrary f g-    = inverseFunctionsIfFirstSucceedsOnGen f g arbitrary-+    => (a -> f b) -> (b -> a) -> Property+inverseFunctionsIfFirstSucceedsOnArbitrary f g =+    inverseFunctionsIfFirstSucceedsOnGen f g arbitrary  inverseFunctionsIfSecondSucceedsOnGen     :: (Show a, Eq a, CanFail f)-    => (a -> b)-    -> (b -> f a)-    -> Gen a-    -> Property+    => (a -> b) -> (b -> f a) -> Gen a -> Property inverseFunctionsIfSecondSucceedsOnGen f g gen =     forAll gen $ \a ->-      case resultIfSucceeded (g (f a)) of-          Nothing -> return () -- fine-          Just r  -> r `shouldBe` a-+        case resultIfSucceeded (g (f a)) of+            Nothing -> return () -- fine+            Just r -> r `shouldBe` a  inverseFunctionsIfSecondSucceedsOnValid-    :: (Show a, Eq a, GenValidity a, CanFail f)-    => (a -> b)-    -> (b -> f a)-    -> Property-inverseFunctionsIfSecondSucceedsOnValid f g-    = inverseFunctionsIfSecondSucceedsOnGen f g genValid-+    :: (Show a, Eq a, GenValid a, CanFail f)+    => (a -> b) -> (b -> f a) -> Property+inverseFunctionsIfSecondSucceedsOnValid f g =+    inverseFunctionsIfSecondSucceedsOnGen f g genValid  inverseFunctionsIfSecondSucceeds-    :: (Show a, Eq a, GenValidity a, CanFail f)-    => (a -> b)-    -> (b -> f a)-    -> Property-inverseFunctionsIfSecondSucceeds f g-    = inverseFunctionsIfSecondSucceedsOnGen f g genUnchecked+    :: (Show a, Eq a, GenUnchecked a, CanFail f)+    => (a -> b) -> (b -> f a) -> Property+inverseFunctionsIfSecondSucceeds f g =+    inverseFunctionsIfSecondSucceedsOnGen f g genUnchecked  inverseFunctionsIfSecondSucceedsOnArbitrary     :: (Show a, Eq a, Arbitrary a, CanFail f)-    => (a -> b)-    -> (b -> f a)-    -> Property-inverseFunctionsIfSecondSucceedsOnArbitrary f g-    = inverseFunctionsIfSecondSucceedsOnGen f g arbitrary-+    => (a -> b) -> (b -> f a) -> Property+inverseFunctionsIfSecondSucceedsOnArbitrary f g =+    inverseFunctionsIfSecondSucceedsOnGen f g arbitrary  inverseFunctionsIfSucceedOnGen     :: (Show a, Eq a, CanFail f, CanFail g)-    => (a -> f b)-    -> (b -> g a)-    -> Gen a-    -> Property+    => (a -> f b) -> (b -> g a) -> Gen a -> Property inverseFunctionsIfSucceedOnGen f g gen =     forAll gen $ \a ->-      case do fa <- resultIfSucceeded $ f a-              resultIfSucceeded $ g fa-          of-          Nothing -> return () -- fine-          Just r  -> r `shouldBe` a-+        case do fa <- resultIfSucceeded $ f a+                resultIfSucceeded $ g fa of+            Nothing -> return () -- fine+            Just r -> r `shouldBe` a  inverseFunctionsIfSucceedOnValid-    :: (Show a, Eq a, GenValidity a, CanFail f, CanFail g)-    => (a -> f b)-    -> (b -> g a)-    -> Property-inverseFunctionsIfSucceedOnValid f g-    = inverseFunctionsIfSucceedOnGen f g genValid+    :: (Show a, Eq a, GenValid a, CanFail f, CanFail g)+    => (a -> f b) -> (b -> g a) -> Property+inverseFunctionsIfSucceedOnValid f g =+    inverseFunctionsIfSucceedOnGen f g genValid  inverseFunctionsIfSucceed-    :: (Show a, Eq a, GenValidity a, CanFail f, CanFail g)-    => (a -> f b)-    -> (b -> g a)-    -> Property-inverseFunctionsIfSucceed f g-    = inverseFunctionsIfSucceedOnGen f g genUnchecked+    :: (Show a, Eq a, GenUnchecked a, CanFail f, CanFail g)+    => (a -> f b) -> (b -> g a) -> Property+inverseFunctionsIfSucceed f g = inverseFunctionsIfSucceedOnGen f g genUnchecked  inverseFunctionsIfSucceedOnArbitrary     :: (Show a, Eq a, Arbitrary a, CanFail f, CanFail g)-    => (a -> f b)-    -> (b -> g a)-    -> Property-inverseFunctionsIfSucceedOnArbitrary f g-    = inverseFunctionsIfSucceedOnGen f g arbitrary+    => (a -> f b) -> (b -> g a) -> Property+inverseFunctionsIfSucceedOnArbitrary f g =+    inverseFunctionsIfSucceedOnGen f g arbitrary

@@ -1,8 +1,9 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Standard tests involving validity module Test.Validity.Functions.Validity-    ( -- ** Standard tests involving validity-      producesValidsOnGen+    ( producesValidsOnGen     , producesValidsOnValids     , producesValid     , producesValidsOnArbitrary@@ -16,107 +17,101 @@     , producesValidsOnArbitrary3     ) where -import           Data.GenValidity+import Data.GenValidity -import           Test.Hspec-import           Test.QuickCheck+import Test.Hspec+import Test.QuickCheck  -- | The function produces valid output when the input is generated as -- specified by the given generator. producesValidsOnGen     :: (Show a, Show b, Validity b)-    => (a -> b)-    -> Gen a-    -> Property-producesValidsOnGen func gen-    = forAll gen $ \a -> func a `shouldSatisfy` isValid+    => (a -> b) -> Gen a -> Property+producesValidsOnGen func gen = forAll gen $ \a -> func a `shouldSatisfy` isValid  -- | The function produces valid output when the input is generated by--- @arbitrary@-producesValidsOnArbitrary-    :: (Show a, Show b, Arbitrary a, Validity b)-    => (a -> b)-    -> Property-producesValidsOnArbitrary = (`producesValidsOnGen` arbitrary)+-- @genValid@+producesValidsOnValids+    :: (Show a, Show b, GenValid a, Validity b)+    => (a -> b) -> Property+producesValidsOnValids = (`producesValidsOnGen` genValid)  -- | The function produces valid output when the input is generated by -- @genUnchecked@ producesValid-    :: (Show a, Show b, GenValidity a, Validity b)-    => (a -> b)-    -> Property+    :: (Show a, Show b, GenUnchecked a, Validity b)+    => (a -> b) -> Property producesValid = (`producesValidsOnGen` genUnchecked)  -- | The function produces valid output when the input is generated by--- @genValid@-producesValidsOnValids-    :: (Show a, Show b, GenValidity a, Validity b)-    => (a -> b)-    -> Property-producesValidsOnValids = (`producesValidsOnGen` genValid)+-- @arbitrary@+producesValidsOnArbitrary+    :: (Show a, Show b, Arbitrary a, Validity b)+    => (a -> b) -> Property+producesValidsOnArbitrary = (`producesValidsOnGen` arbitrary)  producesValidsOnGens2     :: (Show a, Show b, Show c, Validity c)-    => (a -> b -> c)-    -> Gen (a, b)-    -> Property-producesValidsOnGens2 func gen-    = forAll gen $ \(a, b) ->-        func a b `shouldSatisfy` isValid+    => (a -> b -> c) -> Gen (a, b) -> Property+producesValidsOnGens2 func gen =+    forAll gen $ \(a, b) -> func a b `shouldSatisfy` isValid  producesValidsOnValids2-    :: (Show a, Show b, Show c, GenValidity a, GenValidity b, Validity c)-    => (a -> b -> c)-    -> Property-producesValidsOnValids2 func-    = producesValidsOnGens2 func genValid+    :: (Show a, Show b, Show c, GenValid a, GenValid b, Validity c)+    => (a -> b -> c) -> Property+producesValidsOnValids2 func = producesValidsOnGens2 func genValid +producesValid2+    :: (Show a, Show b, Show c, GenUnchecked a, GenUnchecked b, Validity c)+    => (a -> b -> c) -> Property+producesValid2 func = producesValidsOnGens2 func genUnchecked+ producesValidsOnArbitrary2     :: (Show a, Show b, Show c, Arbitrary a, Arbitrary b, Validity c)-    => (a -> b -> c)-    -> Property-producesValidsOnArbitrary2 func-    = producesValidsOnGens2 func arbitrary--producesValid2-    :: (Show a, Show b, Show c, GenValidity a, GenValidity b, Validity c)-    => (a -> b -> c)-    -> Property-producesValid2 func-    = producesValidsOnGens2 func genUnchecked+    => (a -> b -> c) -> Property+producesValidsOnArbitrary2 func = producesValidsOnGens2 func arbitrary  producesValidsOnGens3     :: (Show a, Show b, Show c, Show d, Validity d)-    => (a -> b -> c -> d)-    -> Gen (a, b, c)-    -> Property-producesValidsOnGens3 func gen-    = forAll gen $ \(a, b, c) ->-        func a b c `shouldSatisfy` isValid--producesValid3-    :: (Show a, Show b, Show c, Show d,-        GenValidity a, GenValidity b, GenValidity c,-        Validity d)-    => (a -> b -> c -> d)-    -> Property-producesValid3 func-    = producesValidsOnGens3 func genUnchecked+    => (a -> b -> c -> d) -> Gen (a, b, c) -> Property+producesValidsOnGens3 func gen =+    forAll gen $ \(a, b, c) -> func a b c `shouldSatisfy` isValid  producesValidsOnValids3-    :: (Show a, Show b, Show c, Show d,-        GenValidity a, GenValidity b, GenValidity c,-        Validity d)-    => (a -> b -> c -> d)-    -> Property-producesValidsOnValids3 func-    = producesValidsOnGens3 func genValid+    :: ( Show a+       , Show b+       , Show c+       , Show d+       , GenValid a+       , GenValid b+       , GenValid c+       , Validity d+       )+    => (a -> b -> c -> d) -> Property+producesValidsOnValids3 func = producesValidsOnGens3 func genValid +producesValid3+    :: ( Show a+       , Show b+       , Show c+       , Show d+       , GenUnchecked a+       , GenUnchecked b+       , GenUnchecked c+       , Validity d+       )+    => (a -> b -> c -> d) -> Property+producesValid3 func = producesValidsOnGens3 func genUnchecked+ producesValidsOnArbitrary3-    :: (Show a, Show b, Show c, Show d,-        Arbitrary a, Arbitrary b, Arbitrary c,-        Validity d)-    => (a -> b -> c -> d)-    -> Property-producesValidsOnArbitrary3 func-    = producesValidsOnGens3 func arbitrary+    :: ( Show a+       , Show b+       , Show c+       , Show d+       , Arbitrary a+       , Arbitrary b+       , Arbitrary c+       , Validity d+       )+    => (a -> b -> c -> d) -> Property+producesValidsOnArbitrary3 func = producesValidsOnGens3 func arbitrary

@@ -0,0 +1,169 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++-- | Functor properties+--+-- You will need @TypeApplications@ to use these.+module Test.Validity.Functor+    ( functorSpecOnValid+    , functorSpec+    , functorSpecOnArbitrary+    , functorSpecOnGens+    ) where++import Data.Data++import Data.GenValidity++import Test.Hspec+import Test.QuickCheck++import Test.Validity.Functions+import Test.Validity.Operations+import Test.Validity.Relations+import Test.Validity.Utils++fmapTypeStr+    :: forall (f :: * -> *).+       (Typeable f)+    => String+fmapTypeStr =+    unwords+        [ "fmap"+        , "::"+        , "(a"+        , "->"+        , "b)"+        , "->"+        , nameOf @f+        , "a"+        , "->"+        , nameOf @f+        , "b"+        ]++flTypeStr+    :: forall (f :: * -> *).+       (Typeable f)+    => String+flTypeStr =+    unwords ["(<$)", "::", "a", "->", nameOf @f, "b", "->", nameOf @f, "a"]++-- | Standard test spec for properties of Functor instances for values generated with GenValid instances+--+-- Example usage:+--+-- > functorSpecOnArbitrary @[]+functorSpecOnValid+    :: forall (f :: * -> *).+       (Eq (f Int), Show (f Int), Functor f, Typeable f, GenValid (f Int))+    => Spec+functorSpecOnValid = functorSpecWithInts @f genValid++-- | Standard test spec for properties of Functor instances for values generated with GenUnchecked instances+--+-- Example usage:+--+-- > functorSpecOnArbitrary @[]+functorSpec+    :: forall (f :: * -> *).+       (Eq (f Int), Show (f Int), Functor f, Typeable f, GenUnchecked (f Int))+    => Spec+functorSpec = functorSpecWithInts @f genUnchecked++-- | Standard test spec for properties of Functor instances for values generated with Arbitrary instances+--+-- Example usage:+--+-- > functorSpecOnArbitrary @[]+functorSpecOnArbitrary+    :: forall (f :: * -> *).+       (Eq (f Int), Show (f Int), Functor f, Typeable f, Arbitrary (f Int))+    => Spec+functorSpecOnArbitrary = functorSpecWithInts @f arbitrary++functorSpecWithInts+    :: forall (f :: * -> *).+       (Eq (f Int), Show (f Int), Functor f, Typeable f)+    => Gen (f Int) -> Spec+functorSpecWithInts gen =+    functorSpecOnGens+        @f+        @Int+        genUnchecked+        "int"+        gen+        (unwords [nameOf @f, "of ints"])+        ((+) <$> genUnchecked)+        "increments"+        ((*) <$> genUnchecked)+        "scalings"++-- | Standard test spec for properties of Functor instances for values generated by given generators (and names for those generator).+--+-- Example usage:+--+-- > functorSpecOnGens+-- >     @[]+-- >     @Int+-- >     (pure 4) "four"+-- >     (genListOf $ pure 5) "list of fives"+-- >     ((+) <$> genValid) "additions"+-- >     ((*) <$> genValid) "multiplications"+functorSpecOnGens+    :: forall (f :: * -> *) (a :: *) (b :: *) (c :: *).+       ( Show a+       , Show (f a)+       , Show (f c)+       , Eq (f a)+       , Eq (f c)+       , Functor f+       , Typeable f+       , Typeable a+       , Typeable b+       , Typeable c+       )+    => Gen a+    -> String+    -> Gen (f a)+    -> String+    -> Gen (b -> c)+    -> String+    -> Gen (a -> b)+    -> String+    -> Spec+functorSpecOnGens gena genaname gen genname genf genfname geng gengname =+    parallel $+    describe ("Functor " ++ nameOf @f) $ do+        describe (fmapTypeStr @f) $ do+            it+                (unwords+                     [ "satisfies the first Fuctor law: 'fmap id == id' for"+                     , genDescr @(f a) genname+                     ]) $+                equivalentOnGen (fmap @f id) (id @(f a)) gen+            it+                (unwords+                     [ "satisfieds the second Functor law: 'fmap (f . g) == fmap f . fmap g' for"+                     , genDescr @(f a) genname+                     , "'s"+                     , "given to"+                     , genDescr @(b -> c) genfname+                     , "and"+                     , genDescr @(a -> b) gengname+                     ]) $+                forAll (Anon <$> genf) $ \(Anon f) ->+                    forAll (Anon <$> geng) $ \(Anon g) ->+                        equivalentOnGen (fmap (f . g)) (fmap f . fmap g) gen+        describe (flTypeStr @f) $+            it+                (unwords+                     [ "is equivalent to its default implementation for"+                     , genDescr @a genaname+                     , "and"+                     , genDescr @(f a) genname+                     ]) $+            forAll gena $ \a -> equivalentOnGen ((<$) a) (fmap $ const a) gen

@@ -1,22 +1,28 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Tests for GenRelativeValidity instances+--+-- You will need @TypeApplications@ to use these. module Test.Validity.GenRelativeValidity-    ( -- * Tests for GenRelativeValidity instances-      genRelativeValiditySpec-    , genRelativeValidityValidGeneratesValid-    , genRelativeValidityInvalidGeneratesInvalid+    ( genRelativeValiditySpec+    , genRelativeValidSpec+    , genRelativeInvalidSpec+    , genRelativeValidGeneratesValid+    , genRelativeInvalidGeneratesInvalid     ) where -import           Data.Data-import           Data.Proxy+import Data.Data -import           Data.GenRelativeValidity-import           Data.GenValidity+import Data.GenRelativeValidity+import Data.GenValidity -import           Test.Hspec-import           Test.QuickCheck+import Test.Hspec+import Test.QuickCheck -import           Test.Validity.Utils+import Test.Validity.Utils  -- | A @Spec@ that specifies that @genValidFor@ and @genInvalidFor@ work as -- intended.@@ -26,60 +32,90 @@ -- -- Example usage: ----- > relativeGenValiditySpec (proxy :: MyDataFor) (proxy :: MyOtherData)+-- > relativeGenValiditySpec @MyDataFor @MyOtherData genRelativeValiditySpec-    :: (Typeable a, Typeable b,-        Show a, Show b,-        GenValidity a, GenValidity b,-        RelativeValidity a b,-        GenRelativeValidity a b)-    => Proxy a-    -> Proxy b-    -> Spec-genRelativeValiditySpec one two = do-    let nameOne = nameOf one-    let nameTwo = nameOf two-    describe ("GenRelativeValidity " ++ nameOne ++ " " ++ nameTwo) $ do-        describe ("genValidFor   :: " ++ nameTwo ++ " -> Gen " ++ nameOne) $-            it ("only generates valid \'"-                ++ nameOne-                ++ "\'s for the "-                ++ nameTwo) $-                genRelativeValidityValidGeneratesValid one two+    :: forall a b.+       ( Typeable a+       , Typeable b+       , Show a+       , Show b+       , GenValid a+       , GenValid b+       , RelativeValidity a b+       , GenRelativeValid a b+       , GenRelativeInvalid a b+       )+    => Spec+genRelativeValiditySpec = do+    genRelativeValidSpec @a @b+    genRelativeValidSpec @a @b -        describe ("genInvalidFor :: " ++ nameTwo ++ " -> Gen " ++ nameOne) $-            it ("only generates invalid \'"-                ++ nameOne-                ++ "\'s for the "-                ++ nameTwo) $-                genRelativeValidityInvalidGeneratesInvalid one two+genRelativeValidSpec+    :: forall a b.+       ( Typeable a+       , Typeable b+       , Show a+       , Show b+       , GenValid a+       , GenValid b+       , RelativeValidity a b+       , GenRelativeValid a b+       )+    => Spec+genRelativeValidSpec =+    parallel $ do+        let nameOne = nameOf @a+        let nameTwo = nameOf @a+        describe ("GenRelativeValidity " ++ nameOne ++ " " ++ nameTwo) $ do+            describe ("genValidFor   :: " ++ nameTwo ++ " -> Gen " ++ nameOne) $+                it+                    ("only generates valid \'" +++                     nameOne ++ "\'s for the " ++ nameTwo) $+                genRelativeValidGeneratesValid @a @b +genRelativeInvalidSpec+    :: forall a b.+       ( Typeable a+       , Typeable b+       , Show a+       , Show b+       , GenValid a+       , GenValid b+       , RelativeValidity a b+       , GenRelativeInvalid a b+       )+    => Spec+genRelativeInvalidSpec =+    parallel $ do+        let nameOne = nameOf @a+        let nameTwo = nameOf @a+        describe ("GenRelativeInvalid " ++ nameOne ++ " " ++ nameTwo) $ do+            describe ("genInvalidFor   :: " ++ nameTwo ++ " -> Gen " ++ nameOne) $+                it+                    ("only generates invalid \'" +++                     nameOne ++ "\'s for the " ++ nameTwo) $+                genRelativeInvalidGeneratesInvalid @a @b+ -- | @genValidFor b@ only generates values that satisfy @isValidFor b@-genRelativeValidityValidGeneratesValid-    :: (Show a, Show b,-        GenValidity a, GenValidity b,-        RelativeValidity a b,-        GenRelativeValidity a b)-    => Proxy a-    -> Proxy b-    -> Property-genRelativeValidityValidGeneratesValid one two =-    forAll genValid $ \b ->-        forAll (genValidFor b) $ \a ->-            (a `asProxyTypeOf` one)-                `shouldSatisfy` (`isValidFor` (b `asProxyTypeOf` two))+genRelativeValidGeneratesValid+    :: forall a b.+       (Show a, Show b, GenValid b, RelativeValidity a b, GenRelativeValid a b)+    => Property+genRelativeValidGeneratesValid =+    forAll genValid $ \(b :: b) ->+        forAll (genValidFor b) $ \(a :: a) -> a `shouldSatisfy` (`isValidFor` b)  -- | @genInvalidFor b@ only generates values that do not satisfy @isValidFor b@-genRelativeValidityInvalidGeneratesInvalid-    :: (Show a, Show b,-        GenValidity a, GenValidity b,-        RelativeValidity a b,-        GenRelativeValidity a b)-    => Proxy a-    -> Proxy b-    -> Property-genRelativeValidityInvalidGeneratesInvalid one two =-    forAll genUnchecked $ \b ->-        forAll (genInvalidFor b) $ \a ->-            (a `asProxyTypeOf` one)-                `shouldNotSatisfy` (`isValidFor` (b `asProxyTypeOf` two))+genRelativeInvalidGeneratesInvalid+    :: forall a b.+       ( Show a+       , Show b+       , GenUnchecked b+       , RelativeValidity a b+       , GenRelativeInvalid a b+       )+    => Property+genRelativeInvalidGeneratesInvalid =+    forAll genUnchecked $ \(b :: b) ->+        forAll (genInvalidFor b) $ \(a :: a) ->+            a `shouldNotSatisfy` (`isValidFor` b)

@@ -1,77 +1,118 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Tests for GenValidity instances module Test.Validity.GenValidity-    ( -- * Tests for GenValidity instances-      genValiditySpec-    , genValidityValidGeneratesValid+    ( genValiditySpec+    , genValidSpec+    , genInvalidSpec+    , genValidGeneratesValid     , genGeneratesValid-    , genValidityInvalidGeneratesInvalid+    , genInvalidGeneratesInvalid     , genGeneratesInvalid     ) where -import           Data.Data+import Data.Data -import           Data.GenValidity+import Data.GenValidity -import           Test.Hspec-import           Test.QuickCheck+import Test.Hspec+import Test.QuickCheck -import           Test.Validity.Utils+import Test.Validity.Utils --- | A @Spec@ that specifies that @genValid@ only generates valid data and that--- @genInvalid@ only generates invalid data.+-- | A spec for properties of 'GenValid' and 'GenInvalid' instances. -- -- In general it is a good idea to add this spec to your test suite if you -- write a custom implementation of @genValid@ or @genInvalid@. -- -- Example usage: ----- > genValiditySpec (Proxy :: Proxy MyData)+-- > genValiditySpec @Int genValiditySpec-    :: (Typeable a, Show a, GenValidity a)-    => Proxy a-    -> Spec-genValiditySpec proxy = do-    let name = nameOf proxy-    describe ("GenValidity " ++ name) $ do-        describe ("genValid   :: Gen " ++ name) $-            it ("only generates valid \'" ++ name ++ "\'s") $-                genValidityValidGeneratesValid proxy+    :: forall a.+       (Typeable a, Show a, GenValid a, GenInvalid a)+    => Spec+genValiditySpec = do+    genValidSpec @a+    genInvalidSpec @a -        describe ("genInvalid :: Gen " ++ name) $-            it ("only generates invalid \'" ++ name ++ "\'s") $-                genValidityInvalidGeneratesInvalid proxy+-- | A @Spec@ that specifies that @genValid@ only generates valid data.+--+-- Example usage:+--+-- > genValidSpec @Int+genValidSpec+    :: forall a.+       (Typeable a, Show a, GenValid a)+    => Spec+genValidSpec =+    parallel $ do+        let name = nameOf @a+        describe ("GenValid " ++ name) $ do+            describe ("genValid   :: Gen " ++ name) $+                it ("only generates valid \'" ++ name ++ "\'s") $+                genValidGeneratesValid @a +-- | A @Spec@ that specifies that @genInvalid@ only generates invalid data.+--+-- Example usage:+--+-- > genInvalidSpec @Double+genInvalidSpec+    :: forall a.+       (Typeable a, Show a, GenInvalid a)+    => Spec+genInvalidSpec =+    parallel $ do+        let name = nameOf @a+        describe ("GenInvalid " ++ name) $ do+            describe ("genInvalid :: Gen " ++ name) $+                it ("only generates invalid \'" ++ name ++ "\'s") $+                genInvalidGeneratesInvalid @a+ -- | @genValid@ only generates valid data-genValidityValidGeneratesValid-    :: forall a. (Show a, GenValidity a)-    => Proxy a-    -> Property-genValidityValidGeneratesValid _ =-    genGeneratesValid (genValid :: Gen a)+--+-- prop> genValidGeneratesValid @()+-- prop> genValidGeneratesValid @Bool+-- prop> genValidGeneratesValid @Ordering+-- prop> genValidGeneratesValid @Char+-- prop> genValidGeneratesValid @Int+-- prop> genValidGeneratesValid @Float+-- prop> genValidGeneratesValid @Double+-- prop> genValidGeneratesValid @Integer+-- prop> genValidGeneratesValid @(Maybe Int)+-- prop> genValidGeneratesValid @[Int]+genValidGeneratesValid+    :: forall a.+       (Show a, GenValid a)+    => Property+genValidGeneratesValid = genGeneratesValid @a genValid  -- | The given generator generates only valid data points genGeneratesValid-    :: (Show a, Validity a)-    => Gen a-    -> Property-genGeneratesValid gen =-    forAll gen (`shouldSatisfy` isValid)-+    :: forall a.+       (Show a, Validity a)+    => Gen a -> Property+genGeneratesValid gen = forAll gen (`shouldSatisfy` isValid)  -- | @genValid@ only generates invalid data-genValidityInvalidGeneratesInvalid-    :: forall a. (Show a, GenValidity a)-    => Proxy a-    -> Property-genValidityInvalidGeneratesInvalid _ =-    genGeneratesInvalid (genInvalid :: Gen a)+--+-- prop> genInvalidGeneratesInvalid @Float+-- prop> genInvalidGeneratesInvalid @Double+-- prop> genInvalidGeneratesInvalid @(Maybe Double)+-- prop> genInvalidGeneratesInvalid @[Double]+genInvalidGeneratesInvalid+    :: forall a.+       (Show a, GenInvalid a)+    => Property+genInvalidGeneratesInvalid = genGeneratesInvalid @a genInvalid  -- | The given generator generates only invalid data points genGeneratesInvalid-    :: (Show a, Validity a)-    => Gen a-    -> Property-genGeneratesInvalid gen =-    forAll gen (`shouldNotSatisfy` isValid)-+    :: forall a.+       (Show a, Validity a)+    => Gen a -> Property+genGeneratesInvalid gen = forAll gen (`shouldNotSatisfy` isValid)

@@ -0,0 +1,237 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++-- | Monad properties+--+-- You will need @TypeApplications@ to use these.+module Test.Validity.Monad+    ( monadSpecOnValid+    , monadSpec+    , monadSpecOnArbitrary+    , monadSpecOnGens+    ) where++import Data.Data++import Control.Monad (ap)+import Data.GenValidity+import Test.QuickCheck.Gen (unGen)+import Test.QuickCheck.Random (mkQCGen)++import Test.Hspec+import Test.QuickCheck++import Test.Validity.Functions+import Test.Validity.Operations+import Test.Validity.Relations+import Test.Validity.Utils++returnTypeStr+    :: forall (m :: * -> *).+       (Typeable m)+    => String+returnTypeStr = unwords ["return", "::", "a", "->", nameOf @m, "a"]++bindTypeStr+    :: forall (m :: * -> *).+       (Typeable m)+    => String+bindTypeStr =+    unwords+        [ "(>>=)"+        , "::"+        , nameOf @m+        , "a"+        , "->"+        , "(b"+        , "->"+        , nameOf @m+        , "a)"+        , "->"+        , nameOf @m+        , "b"+        ]++-- | Standard test spec for properties of Monad instances for values generated with GenValid instances+--+-- Example usage:+--+-- > monadSpecOnArbitrary @[]+monadSpecOnValid+    :: forall (f :: * -> *).+       (Eq (f Int), Show (f Int), Monad f, Typeable f, GenValid (f Int))+    => Spec+monadSpecOnValid = monadSpecWithInts @f genValid++-- | Standard test spec for properties of Monad instances for values generated with GenUnchecked instances+--+-- Example usage:+--+-- > monadSpecOnArbitrary @[]+monadSpec+    :: forall (f :: * -> *).+       (Eq (f Int), Show (f Int), Monad f, Typeable f, GenUnchecked (f Int))+    => Spec+monadSpec = monadSpecWithInts @f genUnchecked++-- | Standard test spec for properties of Monad instances for values generated with Arbitrary instances+--+-- Example usage:+--+-- > monadSpecOnArbitrary @[]+monadSpecOnArbitrary+    :: forall (f :: * -> *).+       (Eq (f Int), Show (f Int), Monad f, Typeable f, Arbitrary (f Int))+    => Spec+monadSpecOnArbitrary = monadSpecWithInts @f arbitrary++monadSpecWithInts+    :: forall (f :: * -> *).+       (Eq (f Int), Show (f Int), Monad f, Typeable f)+    => Gen (f Int) -> Spec+monadSpecWithInts gen =+    monadSpecOnGens+        @f+        @Int+        genUnchecked+        "int"+        gen+        (unwords [nameOf @f, "of ints"])+        gen+        (unwords [nameOf @f, "of ints"])+        ((+) <$> genUnchecked)+        "increments"+        (do a <- genUnchecked+            let qcgen = mkQCGen a+            let func = unGen gen qcgen+            pure $ \b -> func b)+        "perturbations using the int"+        (do a <- genUnchecked+            let qcgen = mkQCGen a+            let func = unGen gen qcgen+            pure $ \b -> func (2 * b))+        "perturbations using the double the int"+        (pure <$> ((+) <$> genUnchecked))+        (unwords [nameOf @f, "of additions"])++-- | Standard test spec for properties of Monad instances for values generated by given generators (and names for those generator).+--+-- Example usage:+--+-- > monadSpecOnGens+-- >     @[]+-- >     @Int+-- >     (pure 4)+-- >     "four"+-- >     (genListOf $ pure 5)+-- >     "list of fives"+-- >     (genListOf $ pure 6)+-- >     "list of sixes"+-- >     ((*) <$> genValid)+-- >     "factorisations"+-- >     (pure $ \a -> [a])+-- >     "singletonisation"+-- >     (pure $ \a -> [a])+-- >     "singletonisation"+-- >     (pure $ pure (+ 1))+-- >     "increment in list"+monadSpecOnGens+    :: forall (f :: * -> *) (a :: *) (b :: *) (c :: *).+       ( Show a+       , Eq a+       , Show (f a)+       , Show (f b)+       , Show (f c)+       , Eq (f a)+       , Eq (f b)+       , Eq (f c)+       , Monad f+       , Typeable f+       , Typeable a+       , Typeable b+       , Typeable c+       )+    => Gen a+    -> String+    -> Gen (f a)+    -> String+    -> Gen (f b)+    -> String+    -> Gen (a -> b)+    -> String+    -> Gen (a -> f b)+    -> String+    -> Gen (b -> f c)+    -> String+    -> Gen (f (a -> b))+    -> String+    -> Spec+monadSpecOnGens gena genaname gen genname genb genbname geng gengname genbf genbfname gencf gencfname genfab genfabname =+    parallel $+    describe ("Monad " ++ nameOf @f) $ do+        describe (unwords [returnTypeStr @f, "and", bindTypeStr @f]) $ do+            it+                (unwords+                     ["satisfy the first Monad law: 'return a >>= k = k a' for", genDescr @a genaname, "and", genDescr @(a -> f b) genbfname]) $+                equivalentOnGens2+                    (\a (Anon k) -> return a >>= k)+                    (\a (Anon k) -> k a)+                    ((,) <$> gena <*> (Anon <$> genbf))+            it+                (unwords+                     [ "satisfy the second Monad law: 'm >>= return = m' for"+                     , genDescr @(f a) genname+                     ]) $+                equivalentOnGen (\m -> m >>= return) (\m -> m) gen+        describe (bindTypeStr @f) $+            it+                (unwords+                     [ "satisfies the third Monad law: 'm >>= (x -> k x >>= h) = (m >>= k) >>= h' for"+                     , genDescr @(f a) genname+                     , genDescr @(a -> f b) genbfname+                     , "and"+                     , 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))+        describe (unwords ["relation with Applicative", nameOf @f]) $ do+            it+                (unwords+                     ["satisfies 'pure = return' for", genDescr @(f a) genname]) $+                equivalentOnGen (pure @f) (return @f) gena+            it+                (unwords+                     [ "satisfies '(<*>) = ap' for"+                     , genDescr @(f (a -> b)) $ genfabname+                     , "and"+                     , genDescr @(f a) genname+                     ]) $+                equivalentOnGens2+                    (\(Anon a) b -> a <*> b)+                    (\(Anon a) b -> ap a b)+                    ((,) <$> (Anon <$> genfab) <*> gen)+            it+                (unwords+                     [ "satisfies '(>>) = (*>)' for"+                     , genDescr @(f a) genname+                     , "and"+                     , genDescr @(f b) genbname+                     ]) $+                equivalentOnGens2 (>>) (*>) ((,) <$> gen <*> genb)+        describe (unwords ["relation with Functor", nameOf @f]) $ do+            it+                (unwords+                     [ "satisfies 'fmap f xs = xs >>= return . f' for"+                     , genDescr @(a -> b) gengname+                     , "and"+                     , genDescr @(f a) genname+                     ]) $+                equivalentOnGens2+                    (\(Anon f) xs -> fmap f xs)+                    (\(Anon f) xs -> xs >>= (return . f))+                    ((,) <$> (Anon <$> geng) <*> gen)

@@ -0,0 +1,111 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++-- | Monoid properties+--+-- You will need @TypeApplications@ to use these.+module Test.Validity.Monoid+    ( monoidSpecOnValid+    , monoidSpec+    , monoidSpecOnArbitrary+    , monoidSpecOnGen+    ) where++import Data.Data++import Data.GenValidity++import Test.Hspec+import Test.QuickCheck++import Test.Validity.Functions+import Test.Validity.Operations+import Test.Validity.Relations+import Test.Validity.Utils++memptyTypeStr+    :: forall a.+       Typeable a+    => String+memptyTypeStr = unwords ["mempty", "::", nameOf @a]++mappendTypeStr+    :: forall a.+       Typeable a+    => String+mappendTypeStr = unwords ["mappend", "::", an, "->", an, "->", an]+  where+    an = nameOf @a++mconcatTypeStr+    :: forall a.+       Typeable a+    => String+mconcatTypeStr = unwords ["mconcat", "::", "[" ++ an ++ "]", "->", an]+  where+    an = nameOf @a++-- | Standard test spec for properties of 'Monoid' instances for valid values+--+-- Example usage:+--+-- > monoidSpecOnValid @[Double]+monoidSpecOnValid+    :: forall a.+       (Show a, Eq a, Monoid a, Typeable a, GenValid a)+    => Spec+monoidSpecOnValid = monoidSpecOnGen @a genValid "valid"++-- | Standard test spec for properties of 'Monoid' instances for unchecked values+--+-- Example usage:+--+-- > monoidSpec @[Int]+monoidSpec+    :: forall a.+       (Show a, Eq a, Monoid a, Typeable a, GenUnchecked a)+    => Spec+monoidSpec = monoidSpecOnGen @a genUnchecked "unchecked"++-- | Standard test spec for properties of 'Monoid' instances for arbitrary values+--+-- Example usage:+--+-- > monoidSpecOnArbitrary @[Int]+monoidSpecOnArbitrary+    :: forall a.+       (Show a, Eq a, Monoid a, Typeable a, Arbitrary a)+    => Spec+monoidSpecOnArbitrary = monoidSpecOnGen @a arbitrary "arbitrary"++-- | Standard test spec for properties of Monoid instances for values generated by a given generator (and name for that generator).+--+-- Example usage:+--+-- > monoidSpecOnGen (pure "a") "singleton list of 'a'"+monoidSpecOnGen+    :: forall a.+       (Show a, Eq a, Monoid a, Typeable a)+    => Gen a -> String -> Spec+monoidSpecOnGen gen genname =+    parallel $ do+        let name = nameOf @a+            memptystr = memptyTypeStr @a+            mappendstr = mappendTypeStr @a+            mconcatstr = mconcatTypeStr @a+            gen3 = (,,) <$> gen <*> gen <*> gen+            genl = genListOf gen+        describe ("Monoid " ++ name) $ do+            let mem = mempty @a+                mapp = mappend @a+                mcon = mconcat @a+            describe memptystr $+                it (unwords ["is the identity for", mappendstr]) $+                identityOnGen mapp mem gen+            describe mappendstr $+                it "is an associative operation" $ associativeOnGens mapp gen3+            describe mconcatstr $+                it "is equivalent to its default implementation" $+                equivalentOnGen mcon (foldr mapp mem) genl

@@ -11,6 +11,7 @@     , leftIdentityOnGen     , leftIdentityOnValid     , leftIdentity+    , leftIdentityOnArbitrary      -- *** Right identity     , rightIdentityOnElemWithEquality@@ -18,11 +19,13 @@     , rightIdentityOnGen     , rightIdentityOnValid     , rightIdentity+    , rightIdentityOnArbitrary      -- *** Identity     , identityOnGen     , identityOnValid     , identity+    , identityOnArbitrary      -- ** Associativity     , associativeOnGens

@@ -1,44 +1,44 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module Test.Validity.Operations.Associativity-    ( -- ** Associativity-      associativeOnGens+    ( associativeOnGens     , associativeOnValids     , associative     , associativeOnArbitrary     ) where -import           Data.GenValidity+import Data.GenValidity -import           Test.Hspec-import           Test.QuickCheck+import Test.Hspec+import Test.QuickCheck  associativeOnGens     :: (Show a, Eq a)-    => (a -> a -> a)-    -> Gen (a, a, a)-    -> Property+    => (a -> a -> a) -> Gen (a, a, a) -> Property associativeOnGens op gen =     forAll gen $ \(a, b, c) ->         ((a `op` b) `op` c) `shouldBe` (a `op` (b `op` c))  associativeOnValids-    :: (Show a, Eq a, GenValidity a)-    => (a -> a -> a)-    -> Property-associativeOnValids op-    = associativeOnGens op genValid+    :: (Show a, Eq a, GenValid a)+    => (a -> a -> a) -> Property+associativeOnValids op = associativeOnGens op genValid +-- |+--+-- prop> associative ((*) @Int)+-- prop> associative ((+) @Int) associative-    :: (Show a, Eq a, GenValidity a)-    => (a -> a -> a)-    -> Property-associative op-    = associativeOnGens op genUnchecked+    :: (Show a, Eq a, GenUnchecked a)+    => (a -> a -> a) -> Property+associative op = associativeOnGens op genUnchecked +-- |+--+-- prop> associativeOnArbitrary ((*) @Int)+-- prop> associativeOnArbitrary ((+) @Int) associativeOnArbitrary     :: (Show a, Eq a, Arbitrary a)-    => (a -> a -> a)-    -> Property-associativeOnArbitrary op-    = associativeOnGens op arbitrary+    => (a -> a -> a) -> Property+associativeOnArbitrary op = associativeOnGens op arbitrary

@@ -1,44 +1,47 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module Test.Validity.Operations.Commutativity-    ( -- ** Commutativity-      commutativeOnGens+    ( commutativeOnGens     , commutativeOnValids     , commutative     , commutativeOnArbitrary     ) where -import           Data.GenValidity+import Data.GenValidity -import           Test.Hspec-import           Test.QuickCheck+import Test.Hspec+import Test.QuickCheck  commutativeOnGens     :: (Show a, Eq a)-    => (a -> a -> a)-    -> Gen (a, a)-    -> Property+    => (a -> a -> a) -> Gen (a, a) -> Property commutativeOnGens op gen =-    forAll gen $ \(a, b) ->-        (a `op` b) `shouldBe` (b `op` a)+    forAll gen $ \(a, b) -> (a `op` b) `shouldBe` (b `op` a) +-- |+--+-- prop> commutative ((+) @Double)+-- prop> commutative ((*) @Double) commutativeOnValids-    :: (Show a, Eq a, GenValidity a)-    => (a -> a -> a)-    -> Property-commutativeOnValids op-    = commutativeOnGens op genValid+    :: (Show a, Eq a, GenValid a)+    => (a -> a -> a) -> Property+commutativeOnValids op = commutativeOnGens op genValid +-- |+--+-- prop> commutative ((+) @Int)+-- prop> commutative ((*) @Int) commutative-    :: (Show a, Eq a, GenValidity a)-    => (a -> a -> a)-    -> Property-commutative op-    = commutativeOnGens op genUnchecked+    :: (Show a, Eq a, GenUnchecked a)+    => (a -> a -> a) -> Property+commutative op = commutativeOnGens op genUnchecked +-- |+--+-- prop> commutativeOnArbitrary ((+) @Int)+-- prop> commutativeOnArbitrary ((*) @Int) commutativeOnArbitrary     :: (Show a, Eq a, Arbitrary a)-    => (a -> a -> a)-    -> Property-commutativeOnArbitrary op-    = commutativeOnGens op arbitrary+    => (a -> a -> a) -> Property+commutativeOnArbitrary op = commutativeOnGens op arbitrary

@@ -1,28 +1,28 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module Test.Validity.Operations.Identity-    ( -- *** Left identity-      leftIdentityOnElemWithEquality+    ( leftIdentityOnElemWithEquality     , leftIdentityOnGenWithEquality     , leftIdentityOnGen     , leftIdentityOnValid     , leftIdentity--      -- *** Right identity+    , leftIdentityOnArbitrary     , rightIdentityOnElemWithEquality     , rightIdentityOnGenWithEquality     , rightIdentityOnGen     , rightIdentityOnValid     , rightIdentity-+    , rightIdentityOnArbitrary     , identityOnGen     , identityOnValid     , identity+    , identityOnArbitrary     ) where -import           Data.GenValidity+import Data.GenValidity -import           Test.QuickCheck+import Test.QuickCheck  -- | --@@ -32,18 +32,18 @@ --   \forall a: (b \star a) \doteq a -- \] leftIdentityOnElemWithEquality-    :: (b -> a -> a)    -- ^ A binary operation+    :: (b -> a -> a) -- ^ A binary operation     -> (a -> a -> Bool) -- ^ An equality-    -> b                -- ^ A candidate left-identity-    -> a                -- ^ An element+    -> b -- ^ A candidate left-identity+    -> a -- ^ An element     -> Bool leftIdentityOnElemWithEquality op eq b a = (b `op` a) `eq` a  leftIdentityOnGenWithEquality     :: Show a-    => (b -> a -> a)    -- ^ A binary operation+    => (b -> a -> a) -- ^ A binary operation     -> (a -> a -> Bool) -- ^ An equality-    -> b                -- ^ A candidate left-identity+    -> b -- ^ A candidate left-identity     -> Gen a     -> Property leftIdentityOnGenWithEquality op eq b gen =@@ -52,47 +52,55 @@ leftIdentityOnGen     :: (Show a, Eq a)     => (b -> a -> a) -- ^ A binary operation-    -> b             -- ^ A candidate left-identity+    -> b -- ^ A candidate left-identity     -> Gen a     -> Property leftIdentityOnGen op = leftIdentityOnGenWithEquality op (==) +-- |+--+-- prop> leftIdentityOnValid (flip ((^) @Double @Int)) 1 leftIdentityOnValid-    :: (Show a, Eq a, GenValidity a)-    => (b -> a -> a)-    -> b-    -> Property-leftIdentityOnValid op b-    = leftIdentityOnGen op b genValid+    :: (Show a, Eq a, GenValid a)+    => (b -> a -> a) -> b -> Property+leftIdentityOnValid op b = leftIdentityOnGen op b genValid +-- |+--+-- prop> leftIdentity (flip ((^) @Int @Int)) 1 leftIdentity-    :: (Show a, Eq a, GenValidity a)-    => (b -> a -> a)-    -> b-    -> Property-leftIdentity op b-    = leftIdentityOnGen op b genUnchecked+    :: (Show a, Eq a, GenUnchecked a)+    => (b -> a -> a) -> b -> Property+leftIdentity op b = leftIdentityOnGen op b genUnchecked  -- | --+-- prop> leftIdentityOnArbitrary (flip ((^) @Int @Int)) 1+leftIdentityOnArbitrary+    :: (Show a, Eq a, Arbitrary a)+    => (b -> a -> a) -> b -> Property+leftIdentityOnArbitrary op b = leftIdentityOnGen op b arbitrary++-- |+-- -- \[ --   RightIdentity(\star, \doteq, b) --   \quad\equiv\quad --   \forall a: (a \star b) \doteq a -- \] rightIdentityOnElemWithEquality-    :: (a -> b -> a)    -- ^ A binary operation+    :: (a -> b -> a) -- ^ A binary operation     -> (a -> a -> Bool) -- ^ An equality-    -> b                -- ^ A candidate right-identity-    -> a                -- ^ An element+    -> b -- ^ A candidate right-identity+    -> a -- ^ An element     -> Bool rightIdentityOnElemWithEquality op eq b a = (a `op` b) `eq` a  rightIdentityOnGenWithEquality     :: Show a-    => (a -> b -> a)    -- ^ A binary operation+    => (a -> b -> a) -- ^ A binary operation     -> (a -> a -> Bool) -- ^ An equality-    -> b                -- ^ A candidate right-identity+    -> b -- ^ A candidate right-identity     -> Gen a     -> Property rightIdentityOnGenWithEquality op eq b gen =@@ -100,49 +108,65 @@  rightIdentityOnGen     :: (Show a, Eq a)-    => (a -> b -> a)    -- ^ A binary operation-    -> b                -- ^ A candidate right-identity+    => (a -> b -> a) -- ^ A binary operation+    -> b -- ^ A candidate right-identity     -> Gen a     -> Property rightIdentityOnGen op = rightIdentityOnGenWithEquality op (==) +-- |+--+-- prop> rightIdentityOnValid ((^) @Double) 1 rightIdentityOnValid-    :: (Show a, Eq a, GenValidity a)-    => (a -> b -> a)-    -> b-    -> Property-rightIdentityOnValid op b-    = rightIdentityOnGen op b genValid+    :: (Show a, Eq a, GenValid a)+    => (a -> b -> a) -> b -> Property+rightIdentityOnValid op b = rightIdentityOnGen op b genValid +-- |+--+-- prop> rightIdentity ((^) @Int) 1 rightIdentity-    :: (Show a, Eq a, GenValidity a)-    => (a -> b -> a)-    -> b-    -> Property-rightIdentity op b-    = rightIdentityOnGen op b genUnchecked+    :: (Show a, Eq a, GenUnchecked a)+    => (a -> b -> a) -> b -> Property+rightIdentity op b = rightIdentityOnGen op b genUnchecked +-- |+--+-- prop> rightIdentityOnArbitrary ((^) @Int) 1+rightIdentityOnArbitrary+    :: (Show a, Eq a, Arbitrary a)+    => (a -> b -> a) -> b -> Property+rightIdentityOnArbitrary op b = rightIdentityOnGen op b arbitrary+ identityOnGen     :: (Show a, Eq a)-    => (a -> a -> a)-    -> a-    -> Gen a-    -> Property+    => (a -> a -> a) -> a -> Gen a -> Property identityOnGen op e gen =     leftIdentityOnGen op e gen .&&. rightIdentityOnGen op e gen +-- |+--+-- prop> identityOnValid ((*) @Double) 1+-- prop> identityOnValid ((+) @Double) 0 identityOnValid-    :: (Show a, Eq a, GenValidity a)-    => (a -> a -> a)-    -> a-    -> Property-identityOnValid op a-    = identityOnGen op a genValid+    :: (Show a, Eq a, GenValid a)+    => (a -> a -> a) -> a -> Property+identityOnValid op a = identityOnGen op a genValid +-- |+--+-- prop> identity ((*) @Int) 1+-- prop> identity ((+) @Int) 0 identity-    :: (Show a, Eq a, GenValidity a)-    => (a -> a -> a)-    -> a-    -> Property-identity op e-    = identityOnGen op e genUnchecked+    :: (Show a, Eq a, GenUnchecked a)+    => (a -> a -> a) -> a -> Property+identity op e = identityOnGen op e genUnchecked++-- |+--+-- prop> identityOnArbitrary ((*) @Int) 1+-- prop> identityOnArbitrary ((+) @Int) 0+identityOnArbitrary+    :: (Show a, Eq a, Arbitrary a)+    => (a -> a -> a) -> a -> Property+identityOnArbitrary op a = identityOnGen op a arbitrary

@@ -1,46 +1,216 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++-- | Ord properties+--+-- You will need @TypeApplications@ to use these. module Test.Validity.Ord-    ( -- * Ord properties-      ordSpec+    ( ordSpecOnGen+    , ordSpecOnValid+    , ordSpec+    , ordSpecOnArbitrary     ) where -import           Data.Data-import           Data.Proxy+import Data.Data -import           Data.GenValidity+import Data.GenValidity -import           Test.Hspec+import Test.Hspec+import Test.QuickCheck -import           Test.Validity.Relations-import           Test.Validity.Utils+import Test.Validity.Functions+import Test.Validity.Relations+import Test.Validity.Utils +{-# ANN module "HLint: ignore Use <=" #-}++{-# ANN module "HLint: ignore Use >=" #-}++{-# ANN module "HLint: ignore Use <" #-}++{-# ANN module "HLint: ignore Use >" #-}++leTypeStr+    :: forall a.+       Typeable a+    => String+leTypeStr = binRelStr @a "<="++geTypeStr+    :: forall a.+       Typeable a+    => String+geTypeStr = binRelStr @a ">="++ltTypeStr+    :: forall a.+       Typeable a+    => String+ltTypeStr = binRelStr @a "<"++gtTypeStr+    :: forall a.+       Typeable a+    => String+gtTypeStr = binRelStr @a ">"++-- | Standard test spec for properties of Ord instances for valid values+--+-- Example usage:+--+-- > ordSpecOnValid @Double+ordSpecOnValid+    :: forall a.+       (Show a, Ord a, Typeable a, Arbitrary a)+    => Spec+ordSpecOnValid = ordSpecOnGen @a arbitrary "unchecked"++-- | Standard test spec for properties of Ord instances for unchecked values+--+-- Example usage:+--+-- > ordSpec @Int ordSpec-    :: (Show a, Eq a, Ord a, Typeable a, GenValidity a)-    => Proxy a-    -> Spec-ordSpec proxy = do-    let name = nameOf proxy-        funlestr = unwords-          [ "(<=) ::"-          , name-          , "->"-          , name-          , "-> Ordering"-          ]-        cmp a b = a `asProxyTypeOf` proxy <= b-    describe ("Ord " ++ name) $ do-        it ("is instantated such that "-            ++ funlestr-            ++ " is reflexive") $-            reflexivity cmp+    :: forall a.+       (Show a, Ord a, Typeable a, GenUnchecked a)+    => Spec+ordSpec = ordSpecOnGen @a genUnchecked "unchecked" -        it ("is instantated such that "-            ++ funlestr-            ++ " is antisymmetric") $-            antisymmetry cmp+-- | Standard test spec for properties of Ord instances for arbitrary values+--+-- Example usage:+--+-- > ordSpecOnArbitrary @Int+ordSpecOnArbitrary+    :: forall a.+       (Show a, Ord a, Typeable a, Arbitrary a)+    => Spec+ordSpecOnArbitrary = ordSpecOnGen @a arbitrary "unchecked" -        it ("is instantated such that "-            ++ funlestr-            ++ " is transitive") $-            transitivity cmp+-- | Standard test spec for properties of Ord instances for values generated by a given generator (and name for that generator).+--+-- Example usage:+--+-- > ordSpecOnGen ((* 2) <$> genValid @Int) "even"+ordSpecOnGen+    :: forall a.+       (Show a, Eq a, Ord a, Typeable a)+    => Gen a -> String -> Spec+ordSpecOnGen gen genname =+    parallel $ do+        let name = nameOf @a+            funlestr = leTypeStr @a+            fungestr = geTypeStr @a+            funltstr = ltTypeStr @a+            fungtstr = gtTypeStr @a+            cmple = ((<=) @a)+            cmpge = ((>=) @a)+            cmplt = ((<) @a)+            cmpgt = ((>) @a)+            gen2 = (,) <$> gen <*> gen+            gen3 = (,,) <$> gen <*> gen <*> gen+        describe ("Ord " ++ name) $ do+            describe funlestr $ do+                it+                    (unwords+                         [ "is reflexive for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "'s"+                         ]) $+                    reflexivityOnGen cmple gen+                it+                    (unwords+                         [ "is antisymmetric for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "'s"+                         ]) $+                    antisymmetryOnGens cmple gen2+                it+                    (unwords+                         [ "is transitive for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "'s"+                         ]) $+                    transitivityOnGens cmple gen3+                it+                    (unwords+                         [ "is equivalent to (\\a b -> compare a b /= GT) for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "'s"+                         ]) $+                    equivalentOnGens2 cmple (\a b -> compare a b /= GT) gen2+            describe fungestr $ do+                it+                    (unwords+                         [ "is reflexive for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "'s"+                         ]) $+                    reflexivityOnGen cmpge gen+                it+                    (unwords+                         [ "is antisymmetric for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "'s"+                         ]) $+                    antisymmetryOnGens cmpge gen2+                it+                    (unwords+                         [ "is transitive for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "'s"+                         ]) $+                    transitivityOnGens cmpge gen3+                it+                    (unwords+                         [ "is equivalent to (\\a b -> compare a b /= LT) for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "'s"+                         ]) $+                    equivalentOnGens2 cmpge (\a b -> compare a b /= LT) gen2+            describe funltstr $ do+                it+                    (unwords+                         [ "is antireflexive for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "'s"+                         ]) $+                    antireflexivityOnGen cmplt gen+                it+                    (unwords+                         [ "is transitive for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "'s"+                         ]) $+                    transitivityOnGens cmplt gen3+                it+                    (unwords+                         [ "is equivalent to (\\a b -> compare a b == LT) for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "'s"+                         ]) $+                    equivalentOnGens2 cmplt (\a b -> compare a b == LT) gen2+            describe fungtstr $ do+                it+                    (unwords+                         [ "is antireflexive for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "'s"+                         ]) $+                    antireflexivityOnGen cmpgt gen+                it+                    (unwords+                         [ "is transitive for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "'s"+                         ]) $+                    transitivityOnGens cmpgt gen3+                it+                    (unwords+                         [ "is equivalent to (\\a b -> compare a b == GT) for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "'s"+                         ]) $+                    equivalentOnGens2 cmpgt (\a b -> compare a b == GT) gen2

@@ -21,11 +21,18 @@     -- ** Antisymmetry     , antisymmetricOnElemsWithEquality     , antisymmetryOnGensWithEquality-    , antisymmetryOnGensEq+    , antisymmetryOnGens     , antisymmetryOnValid     , antisymmetry     , antisymmetryOnArbitrary +    -- ** Antireflexivity+    , antireflexiveOnElem+    , antireflexivityOnGen+    , antireflexivityOnValid+    , antireflexivity+    , antireflexivityOnArbitrary+     -- ** Symmetry     , symmetricOnElems     , symmetryOnGens@@ -34,8 +41,9 @@     , symmetryOnArbitrary     ) where -import           Test.Validity.Relations.Reflexivity+import           Test.Validity.Relations.Antireflexivity import           Test.Validity.Relations.Antisymmetry+import           Test.Validity.Relations.Reflexivity import           Test.Validity.Relations.Symmetry import           Test.Validity.Relations.Transitivity 

@@ -0,0 +1,62 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Validity.Relations.Antireflexivity+    ( antireflexiveOnElem+    , antireflexivityOnGen+    , antireflexivityOnValid+    , antireflexivity+    , antireflexivityOnArbitrary+    ) where++import Data.GenValidity++import Test.QuickCheck++-- |+--+-- \[+--   Antireflexive(\prec)+--   \quad\equiv\quad+--   \forall a: \neg (a \prec a)+-- \]+antireflexiveOnElem+    :: (a -> a -> Bool) -- ^ A relation+    -> a -- ^ An element+    -> Bool+antireflexiveOnElem func a = not $ func a a++antireflexivityOnGen+    :: Show a+    => (a -> a -> Bool) -> Gen a -> Property+antireflexivityOnGen func gen = forAll gen $ antireflexiveOnElem func++-- |+--+-- prop> antireflexivityOnValid ((<) @Double)+-- prop> antireflexivityOnValid ((/=) @Double)+-- prop> antireflexivityOnValid ((>) @Double)+antireflexivityOnValid+    :: (Show a, GenValid a)+    => (a -> a -> Bool) -> Property+antireflexivityOnValid func = antireflexivityOnGen func genValid++-- |+--+-- prop> antireflexivity ((<) @Int)+-- prop> antireflexivity ((/=) @Int)+-- prop> antireflexivity ((>) @Int)+antireflexivity+    :: (Show a, GenUnchecked a)+    => (a -> a -> Bool) -> Property+antireflexivity func = antireflexivityOnGen func genUnchecked++-- |+--+-- prop> antireflexivityOnArbitrary ((<) @Int)+-- prop> antireflexivityOnArbitrary ((/=) @Int)+-- prop> antireflexivityOnArbitrary ((>) @Int)+antireflexivityOnArbitrary+    :: (Show a, Arbitrary a)+    => (a -> a -> Bool) -> Property+antireflexivityOnArbitrary func = antireflexivityOnGen func arbitrary

@@ -1,19 +1,20 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module Test.Validity.Relations.Antisymmetry     ( antisymmetricOnElemsWithEquality     , antisymmetryOnGensWithEquality-    , antisymmetryOnGensEq+    , antisymmetryOnGens     , antisymmetryOnValid     , antisymmetry     , antisymmetryOnArbitrary     ) where -import           Data.GenValidity+import Data.GenValidity -import           Test.QuickCheck+import Test.QuickCheck -import           Test.Validity.Utils+import Test.Validity.Utils  -- | --@@ -25,48 +26,66 @@ antisymmetricOnElemsWithEquality     :: (a -> a -> Bool) -- ^ A relation     -> (a -> a -> Bool) -- ^ An equivalence relation-    -> a -> a           -- ^ Two elements+    -> a+    -> a -- ^ Two elements     -> Bool antisymmetricOnElemsWithEquality func eq a b =     (func a b && func b a) ===> (a `eq` b)  antisymmetryOnGensWithEquality     :: Show a-    => (a -> a -> Bool)-    -> Gen (a, a)-    -> (a -> a -> Bool)-    -> Property+    => (a -> a -> Bool) -> Gen (a, a) -> (a -> a -> Bool) -> Property antisymmetryOnGensWithEquality func gen eq =     forAll gen $ uncurry $ antisymmetricOnElemsWithEquality func eq -antisymmetryOnGensEq+antisymmetryOnGens     :: (Show a, Eq a)-    => (a -> a -> Bool)-    -> Gen (a, a)-    -> Property-antisymmetryOnGensEq func gen-    = antisymmetryOnGensWithEquality func gen (==)+    => (a -> a -> Bool) -> Gen (a, a) -> Property+antisymmetryOnGens func gen = antisymmetryOnGensWithEquality func gen (==) +-- |+--+-- prop> antisymmetryOnValid ((>) @Double)+-- prop> antisymmetryOnValid ((>=) @Double)+-- prop> antisymmetryOnValid ((<=) @Double)+-- prop> antisymmetryOnValid ((<) @Double)+-- prop> antisymmetryOnValid (Data.List.isPrefixOf @Double)+-- prop> antisymmetryOnValid (Data.List.isSuffixOf @Double)+-- prop> antisymmetryOnValid (Data.List.isInfixOf @Double)+-- prop> antisymmetryOnValid (Data.List.isSubsequenceOf @Double) antisymmetryOnValid-    :: (Show a, Eq a, GenValidity a)-    => (a -> a -> Bool)-    -> Property-antisymmetryOnValid func =-    antisymmetryOnGensEq func genValid+    :: (Show a, Eq a, GenValid a)+    => (a -> a -> Bool) -> Property+antisymmetryOnValid func = antisymmetryOnGens func genValid +-- |+--+-- prop> antisymmetry ((>) @Int)+-- prop> antisymmetry ((>=) @Int)+-- prop> antisymmetry ((<=) @Int)+-- prop> antisymmetry ((<) @Int)+-- prop> antisymmetry (Data.List.isPrefixOf @Int)+-- prop> antisymmetry (Data.List.isSuffixOf @Int)+-- prop> antisymmetry (Data.List.isInfixOf @Int)+-- prop> antisymmetry (Data.List.isSubsequenceOf @Int)+-- prop> antisymmetry ((\x y -> even x && odd y) :: Int -> Int -> Bool) antisymmetry-    :: (Show a, Eq a, GenValidity a)-    => (a -> a -> Bool)-    -> Property-antisymmetry func =-    antisymmetryOnGensEq func genUnchecked+    :: (Show a, Eq a, GenUnchecked a)+    => (a -> a -> Bool) -> Property+antisymmetry func = antisymmetryOnGens func genUnchecked  -- | ----- prop> antisymmetryOnArbitrary ((<=) :: Int -> Int -> Bool)+-- prop> antisymmetryOnArbitrary ((>) @Int)+-- prop> antisymmetryOnArbitrary ((>=) @Int)+-- prop> antisymmetryOnArbitrary ((<=) @Int)+-- prop> antisymmetryOnArbitrary ((<) @Int)+-- prop> antisymmetryOnArbitrary (Data.List.isPrefixOf @Int)+-- prop> antisymmetryOnArbitrary (Data.List.isSuffixOf @Int)+-- prop> antisymmetryOnArbitrary (Data.List.isInfixOf @Int)+-- prop> antisymmetryOnArbitrary (Data.List.isSubsequenceOf @Int)+-- prop> antisymmetryOnArbitrary ((\x y -> even x && odd y) :: Int -> Int -> Bool) antisymmetryOnArbitrary     :: (Show a, Eq a, Arbitrary a)-    => (a -> a -> Bool)-    -> Property-antisymmetryOnArbitrary func =-    antisymmetryOnGensEq func arbitrary+    => (a -> a -> Bool) -> Property+antisymmetryOnArbitrary func = antisymmetryOnGens func arbitrary

@@ -1,5 +1,6 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module Test.Validity.Relations.Reflexivity     ( reflexiveOnElem     , reflexivityOnGen@@ -8,51 +9,66 @@     , reflexivityOnArbitrary     ) where -import           Data.GenValidity+import Data.GenValidity -import           Test.QuickCheck+import Test.QuickCheck  -- | -- -- \[---   Reflexive(prec)+--   Reflexive(\prec) --   \quad\equiv\quad --   \forall a: (a \prec a) -- \] reflexiveOnElem     :: (a -> a -> Bool) -- ^ A relation-    -> a                -- ^ An element+    -> a -- ^ An element     -> Bool reflexiveOnElem func a = func a a  reflexivityOnGen     :: Show a-    => (a -> a -> Bool)-    -> Gen a-    -> Property-reflexivityOnGen func gen =-    forAll gen $ reflexiveOnElem func+    => (a -> a -> Bool) -> Gen a -> Property+reflexivityOnGen func gen = forAll gen $ reflexiveOnElem func +-- |+--+-- prop> reflexivityOnValid ((<=) @Double)+-- prop> reflexivityOnValid ((==) @Double)+-- prop> reflexivityOnValid ((>=) @Double)+-- prop> reflexivityOnValid (Data.List.isPrefixOf @Double)+-- prop> reflexivityOnValid (Data.List.isSuffixOf @Double)+-- prop> reflexivityOnValid (Data.List.isInfixOf @Double)+-- prop> reflexivityOnValid (Data.List.isSubsequenceOf @Double) reflexivityOnValid-    :: (Show a, GenValidity a)-    => (a -> a -> Bool)-    -> Property-reflexivityOnValid func-    = reflexivityOnGen func genValid+    :: (Show a, GenValid a)+    => (a -> a -> Bool) -> Property+reflexivityOnValid func = reflexivityOnGen func genValid +-- |+--+-- prop> reflexivity ((<=) @Int)+-- prop> reflexivity ((==) @Int)+-- prop> reflexivity ((>=) @Int)+-- prop> reflexivity (Data.List.isPrefixOf @Int)+-- prop> reflexivity (Data.List.isSuffixOf @Int)+-- prop> reflexivity (Data.List.isInfixOf @Int)+-- prop> reflexivity (Data.List.isSubsequenceOf @Int) reflexivity-    :: (Show a, GenValidity a)-    => (a -> a -> Bool)-    -> Property-reflexivity func-    = reflexivityOnGen func genUnchecked+    :: (Show a, GenUnchecked a)+    => (a -> a -> Bool) -> Property+reflexivity func = reflexivityOnGen func genUnchecked  -- | ----- prop> reflexivityOnArbitrary ((==) :: Int -> Int -> Bool)+-- prop> reflexivityOnArbitrary ((<=) @Int)+-- prop> reflexivityOnArbitrary ((==) @Int)+-- prop> reflexivityOnArbitrary ((>=) @Int)+-- prop> reflexivityOnArbitrary (Data.List.isPrefixOf @Int)+-- prop> reflexivityOnArbitrary (Data.List.isSuffixOf @Int)+-- prop> reflexivityOnArbitrary (Data.List.isInfixOf @Int)+-- prop> reflexivityOnArbitrary (Data.List.isSubsequenceOf @Int) reflexivityOnArbitrary     :: (Show a, Arbitrary a)-    => (a -> a -> Bool)-    -> Property-reflexivityOnArbitrary func-    = reflexivityOnGen func arbitrary+    => (a -> a -> Bool) -> Property+reflexivityOnArbitrary func = reflexivityOnGen func arbitrary

@@ -1,5 +1,6 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module Test.Validity.Relations.Symmetry     ( symmetricOnElems     , symmetryOnGens@@ -8,11 +9,11 @@     , symmetryOnArbitrary     ) where -import           Data.GenValidity+import Data.GenValidity -import           Test.QuickCheck+import Test.QuickCheck -import           Test.Validity.Utils+import Test.Validity.Utils  -- | --@@ -23,39 +24,39 @@ -- \] symmetricOnElems     :: (a -> a -> Bool) -- ^ A relation-    -> a -> a           -- ^ Two elements+    -> a+    -> a -- ^ Two elements     -> Bool symmetricOnElems func a b = func a b <==> func b a  symmetryOnGens     :: Show a-    => (a -> a -> Bool)-    -> Gen (a, a)-    -> Property-symmetryOnGens func gen =-    forAll gen $ uncurry $ symmetricOnElems func+    => (a -> a -> Bool) -> Gen (a, a) -> Property+symmetryOnGens func gen = forAll gen $ uncurry $ symmetricOnElems func +-- |+--+-- prop> symmetryOnValid ((==) @Double)+-- prop> symmetryOnValid ((/=) @Double) symmetryOnValid-    :: (Show a, GenValidity a)-    => (a -> a -> Bool)-    -> Property-symmetryOnValid func =-    symmetryOnGens func genValid+    :: (Show a, GenValid a)+    => (a -> a -> Bool) -> Property+symmetryOnValid func = symmetryOnGens func genValid +-- |+--+-- prop> symmetry ((==) @Int)+-- prop> symmetry ((/=) @Int) symmetry-    :: (Show a, GenValidity a)-    => (a -> a -> Bool)-    -> Property-symmetry func =-    symmetryOnGens func genUnchecked-+    :: (Show a, GenUnchecked a)+    => (a -> a -> Bool) -> Property+symmetry func = symmetryOnGens func genUnchecked  -- | ----- prop> symmetryOnArbitrary ((==) :: Int -> Int -> Bool)+-- prop> symmetryOnArbitrary ((==) @Int)+-- prop> symmetryOnArbitrary ((/=) @Int) symmetryOnArbitrary     :: (Show a, Arbitrary a)-    => (a -> a -> Bool)-    -> Property-symmetryOnArbitrary func =-    symmetryOnGens func arbitrary+    => (a -> a -> Bool) -> Property+symmetryOnArbitrary func = symmetryOnGens func arbitrary

@@ -1,5 +1,6 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module Test.Validity.Relations.Transitivity     ( transitiveOnElems     , transitivityOnGens@@ -8,11 +9,11 @@     , transitivityOnArbitrary     ) where -import           Data.GenValidity+import Data.GenValidity -import           Test.QuickCheck+import Test.QuickCheck -import           Test.Validity.Utils+import Test.Validity.Utils  -- | --@@ -23,40 +24,62 @@ -- \] transitiveOnElems     :: (a -> a -> Bool) -- ^ A relation-    -> a -> a -> a      -- ^ Three elements+    -> a+    -> a+    -> a -- ^ Three elements     -> Bool transitiveOnElems func a b c = (func a b && func b c) ===> func a c  transitivityOnGens     :: Show a-    => (a -> a -> Bool)-    -> Gen (a, a, a)-    -> Property+    => (a -> a -> Bool) -> Gen (a, a, a) -> Property transitivityOnGens func gen =     forAll gen $ \(a, b, c) -> transitiveOnElems func a b c +-- |+--+-- prop> transitivityOnValid ((>) @Double)+-- prop> transitivityOnValid ((>=) @Double)+-- prop> transitivityOnValid ((==) @Double)+-- prop> transitivityOnValid ((<=) @Double)+-- prop> transitivityOnValid ((<) @Double)+-- prop> transitivityOnValid (Data.List.isPrefixOf @Double)+-- prop> transitivityOnValid (Data.List.isSuffixOf @Double)+-- prop> transitivityOnValid (Data.List.isInfixOf @Double)+-- prop> transitivityOnValid (Data.List.isSubsequenceOf @Double) transitivityOnValid-    :: (Show a, GenValidity a)-    => (a -> a -> Bool)-    -> Property-transitivityOnValid func-    = transitivityOnGens func genValid-+    :: (Show a, GenValid a)+    => (a -> a -> Bool) -> Property+transitivityOnValid func = transitivityOnGens func genValid +-- |+--+-- prop> transitivity ((>) @Int)+-- prop> transitivity ((>=) @Int)+-- prop> transitivity ((==) @Int)+-- prop> transitivity ((<=) @Int)+-- prop> transitivity ((<) @Int)+-- prop> transitivity (Data.List.isPrefixOf @Int)+-- prop> transitivity (Data.List.isSuffixOf @Int)+-- prop> transitivity (Data.List.isInfixOf @Int)+-- prop> transitivity (Data.List.isSubsequenceOf @Int) transitivity-    :: (Show a, GenValidity a)-    => (a -> a -> Bool)-    -> Property-transitivity func-    = transitivityOnGens func genUnchecked+    :: (Show a, GenUnchecked a)+    => (a -> a -> Bool) -> Property+transitivity func = transitivityOnGens func genUnchecked  -- | ----- prop> transitivityOnArbitrary ((==) :: Int -> Int -> Bool)+-- prop> transitivityOnArbitrary ((>) @Int)+-- prop> transitivityOnArbitrary ((>=) @Int)+-- prop> transitivityOnArbitrary ((==) @Int)+-- prop> transitivityOnArbitrary ((<=) @Int)+-- prop> transitivityOnArbitrary ((<) @Int)+-- prop> transitivityOnArbitrary (Data.List.isPrefixOf @Int)+-- prop> transitivityOnArbitrary (Data.List.isSuffixOf @Int)+-- prop> transitivityOnArbitrary (Data.List.isInfixOf @Int)+-- prop> transitivityOnArbitrary (Data.List.isSubsequenceOf @Int) transitivityOnArbitrary     :: (Show a, Arbitrary a)-    => (a -> a -> Bool)-    -> Property-transitivityOnArbitrary func-    = transitivityOnGens func arbitrary-+    => (a -> a -> Bool) -> Property+transitivityOnArbitrary func = transitivityOnGens func arbitrary

@@ -1,22 +1,26 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Tests for RelativeValidity instances+--+-- You will need @TypeApplications@ to use these. module Test.Validity.RelativeValidity-    ( -- * Tests for RelativeValidity instances-      relativeValiditySpec+    ( relativeValiditySpec     , relativeValidityImpliesValidA     , relativeValidityImpliesValidB     ) where -import           Data.Data-import           Data.Proxy+import Data.Data -import           Data.GenRelativeValidity-import           Data.GenValidity+import Data.GenRelativeValidity+import Data.GenValidity -import           Test.Hspec-import           Test.QuickCheck+import Test.Hspec+import Test.QuickCheck -import           Test.Validity.Utils+import Test.Validity.Utils  -- | A @Spec@ that specifies that @isValidFor@ implies @isValid@ --@@ -25,53 +29,46 @@ -- -- Example usage: ----- > relativeValiditySpec--- >     (Proxy :: Proxy MyDataFor)--- >     (Proxy :: Proxy MyOtherData)+-- > relativeValiditySpec @MyDataFor @MyOtherData relativeValiditySpec-    :: (Typeable a, Typeable b,-        Show a, Show b,-        GenValidity a, GenValidity b, GenRelativeValidity a b)-    => Proxy a-    -> Proxy b-    -> Spec-relativeValiditySpec one two = do-    let nameOne = nameOf one-        nameTwo = nameOf two-    describe ("RelativeValidity " ++ nameOne ++ " " ++ nameTwo) $-        describe ("isValidFor :: "-                  ++ nameOne-                  ++ " -> "-                  ++ nameTwo-                  ++ " -> Bool") $ do-            it ("implies isValid " ++ nameOne ++ " for any " ++ nameTwo) $-                relativeValidityImpliesValidA one two-            it ("implies isValid " ++ nameTwo ++ " for any " ++ nameOne) $-                relativeValidityImpliesValidB one two+    :: forall a b.+       ( Typeable a+       , Typeable b+       , Show a+       , Show b+        , Validity a+        , Validity b+       , GenUnchecked a+       , GenUnchecked b+       , RelativeValidity a b+       )+    => Spec+relativeValiditySpec =+    parallel $ do+        let nameOne = nameOf @a+            nameTwo = nameOf @b+        describe ("RelativeValidity " ++ nameOne ++ " " ++ nameTwo) $+            describe+                ("isValidFor :: " ++ nameOne ++ " -> " ++ nameTwo ++ " -> Bool") $ do+                it ("implies isValid " ++ nameOne ++ " for any " ++ nameTwo) $+                    relativeValidityImpliesValidA @a @b+                it ("implies isValid " ++ nameTwo ++ " for any " ++ nameOne) $+                    relativeValidityImpliesValidB @a @b  -- | @isValidFor a b@ implies @isValid a@ for all @b@ relativeValidityImpliesValidA-    :: (Show a, Show b,-        GenValidity a, GenValidity b, RelativeValidity a b)-    => Proxy a-    -> Proxy b-    -> Property-relativeValidityImpliesValidA one two =-    forAll genUnchecked $ \a ->-        forAll genUnchecked $ \b ->-            not ((a `asProxyTypeOf` one) `isValidFor` (b `asProxyTypeOf` two))-            || isValid a+    :: forall a b.+       (Show a, Show b, Validity a, GenUnchecked a, GenUnchecked b, RelativeValidity a b)+    => Property+relativeValidityImpliesValidA =+    forAll genUnchecked $ \(a :: a) ->+        forAll genUnchecked $ \(b :: b) -> (a `isValidFor` b) ===> isValid a  -- | @isValidFor a b@ implies @isValid b@ for all @a@ relativeValidityImpliesValidB-    :: (Show a, Show b,-        GenValidity a, GenValidity b, RelativeValidity a b)-    => Proxy a-    -> Proxy b-    -> Property-relativeValidityImpliesValidB one two =-    forAll genUnchecked $ \a ->-        forAll genUnchecked $ \b ->-            not ((a `asProxyTypeOf` one) `isValidFor` (b `asProxyTypeOf` two))-              || isValid b-+    :: forall a b.+       (Show a, Show b, Validity b, GenUnchecked a, GenUnchecked b, RelativeValidity a b)+    => Property+relativeValidityImpliesValidB =+    forAll genUnchecked $ \(a :: a) ->+        forAll genUnchecked $ \(b :: b) -> (a `isValidFor` b) ===> isValid b

@@ -1,12 +1,19 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+ module Test.Validity.Utils     ( (<==>)     , (===>)     , nameOf+    , genDescr+    , binRelStr+    , Anon(..)     ) where -import           Data.Data+import Data.Data  (===>) :: Bool -> Bool -> Bool (===>) a b = not a || b@@ -14,7 +21,31 @@ (<==>) :: Bool -> Bool -> Bool (<==>) a b = a ===> b && b ===> a -nameOf :: Typeable a => Proxy a -> String-nameOf proxy =-    let (_, [ty]) = splitTyConApp $ typeOf proxy-    in show ty+nameOf+    :: forall a.+       Typeable a+    => String+nameOf = show $ typeRep (Proxy @a)++genDescr+    :: forall a.+       Typeable a+    => String -> String+genDescr genname = unwords ["\"" ++ genname, "::", nameOf @a ++ "\""]++binRelStr+    :: forall a.+       Typeable a+    => String -> String+binRelStr op = unwords ["(" ++ op ++ ")", "::", name, "->", name, "->", "Bool"]+  where+    name = nameOf @a++data Anon a =+    Anon a++instance Show (Anon a) where+    show _ = "Anonymous"++instance Functor Anon where+    fmap f (Anon a) = Anon (f a)

@@ -1,4 +1,4 @@ import Test.DocTest  main :: IO ()-main = doctest ["-isrc", "src"]+main = doctest ["-isrc", "src", "-XTypeApplications"]

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -0,0 +1,48 @@+{-# LANGUAGE TypeApplications #-}++module Test.Validity.ApplicativeSpec where++import Test.Hspec++import Data.GenValidity+import Test.Validity.Applicative++spec :: Spec+spec = do+    applicativeSpecOnValid @[]+    applicativeSpecOnValid @Maybe+    applicativeSpec @(Either Int)+    applicativeSpec @[]+    applicativeSpec @Maybe+    applicativeSpecOnArbitrary @[]+    applicativeSpecOnArbitrary @Maybe+    applicativeSpecOnGens+        @[]+        @Int+        (pure 4)+        "four"+        (genListOf $ pure 5)+        "list of fives"+        (pure [])+        "purely empty list"+        ((+) <$> genValid)+        "increments"+        (pure <$> ((+) <$> genValid))+        "increments in a list"+        (pure <$> ((*) <$> genValid))+        "scalings in a list"+    applicativeSpecOnGens+        @Maybe+        @String+        (pure "ABC")+        "ABC"+        (Just <$> pure "ABC")+        "Just an ABC"+        (pure Nothing)+        "purely Nothing"+        ((++) <$> genValid)+        "prepends"+        (pure <$> ((++) <$> genValid))+        "prepends in a Just"+        (pure <$> (flip (++) <$> genValid))+        "appends in a Just"

@@ -0,0 +1,10 @@+{-# LANGUAGE TypeApplications #-}++module Test.Validity.ArbitrarySpec where++import Test.Hspec++import Test.Validity.Arbitrary++spec :: Spec+spec = arbitrarySpec @Int

@@ -0,0 +1,15 @@+{-# LANGUAGE TypeApplications #-}++module Test.Validity.EqSpec where++import Test.Hspec++import Data.GenValidity+import Test.Validity.Eq++spec :: Spec+spec = do+    eqSpecOnValid @Double+    eqSpec @Int+    eqSpecOnArbitrary @Int+    eqSpecOnGen ((* 2) <$> genValid @Int) "even"

@@ -0,0 +1,41 @@+{-# LANGUAGE TypeApplications #-}++module Test.Validity.FunctorSpec where++import Test.Hspec++import Data.GenValidity+import Test.Validity.Functor++spec :: Spec+spec = do+    functorSpec @[]+    functorSpec @Maybe+    functorSpec @(Either Int)+    functorSpec @((,) Int)+    functorSpecOnValid @[]+    functorSpecOnValid @Maybe+    functorSpecOnArbitrary @[]+    functorSpecOnArbitrary @Maybe+    functorSpecOnGens+        @[]+        @Int+        (pure 4)+        "four"+        (genListOf $ pure 5)+        "list of fives"+        ((+) <$> genValid)+        "increments"+        ((*) <$> genValid)+        "scalings"+    functorSpecOnGens+        @Maybe+        @String+        (pure "ABC")+        "ABC"+        (Just <$> pure "ABC")+        "Just an ABC"+        ((++) <$> genValid)+        "prepends"+        ((flip (++)) <$> genValid)+        "appends"

@@ -0,0 +1,10 @@+{-# LANGUAGE TypeApplications #-}++module Test.Validity.GenRelativeValiditySpec where++import Test.Hspec++-- import Test.Validity.GenRelativeValidity++spec :: Spec+spec = pure () -- TODO add examples once we have some instances

@@ -0,0 +1,13 @@+{-# LANGUAGE TypeApplications #-}++module Test.Validity.GenValiditySpec where++import Test.Hspec++import Test.Validity.GenValidity++spec :: Spec+spec = do+    genValiditySpec @Double+    genValidSpec @Double+    genInvalidSpec @Double

@@ -0,0 +1,53 @@+{-# LANGUAGE TypeApplications #-}++module Test.Validity.MonadSpec where++import Test.Hspec++import Data.GenValidity+import Test.Validity.Monad++spec :: Spec+spec+ = do+    monadSpec @[]+    monadSpec @Maybe+    monadSpec @(Either Int)+    monadSpecOnValid @[]+    monadSpecOnValid @Maybe+    monadSpecOnArbitrary @[]+    monadSpecOnArbitrary @Maybe+    monadSpecOnGens+        @[]+        @Int+        (pure 4)+        "four"+        (genListOf $ pure 5)+        "list of fives"+        (genListOf $ pure 6)+        "list of sixes"+        ((*) <$> genValid)+        "factorisations"+        (pure $ \a -> [a])+        "singletonisation"+        (pure $ \a -> [a])+        "singletonisation"+        (pure $ pure (+ 1))+        "increment in list"+    monadSpecOnGens+        @Maybe+        @String+        (pure "ABC")+        "ABC"+        (Just <$> pure "ABC")+        "Just an ABC"+        (Just <$> pure "CDE")+        "Just an ABC"+        ((flip (++)) <$> genValid)+        "appends"+        (pure $ \a -> Just a)+        "justisation"+        (pure $ \a -> Just a)+        "justisation"+        (pure $ pure (++ "a"))+        "append 'a' in Just"

@@ -0,0 +1,14 @@+{-# LANGUAGE TypeApplications #-}++module Test.Validity.MonoidSpec where++import Test.Hspec++import Test.Validity.Monoid++spec :: Spec+spec = do+    monoidSpecOnValid @[Double]+    monoidSpec @[Int]+    monoidSpecOnArbitrary @[Int]+    monoidSpecOnGen (pure "a") "singleton list of 'a'"

@@ -0,0 +1,15 @@+{-# LANGUAGE TypeApplications #-}++module Test.Validity.OrdSpec where++import Test.Hspec++import Data.GenValidity+import Test.Validity.Ord++spec :: Spec+spec = do+    ordSpecOnValid @Double+    ordSpec @Int+    ordSpecOnArbitrary @Int+    ordSpecOnGen ((* 2) <$> genValid @Int) "even"

@@ -0,0 +1,9 @@+{-# LANGUAGE TypeApplications #-}++module Test.Validity.RelativeValiditySpec where++import Test.Hspec++-- import Test.Validity.RelativeValidity+spec :: Spec+spec = pure ()