packages feed

genvalidity-sydtest (empty) → 0.0.0.0

raw patch · 52 files changed

+4849/−0 lines, 52 filesdep +QuickCheckdep +basedep +genvaliditysetup-changed

Dependencies added: QuickCheck, base, genvalidity, genvalidity-sydtest, pretty-show, sydtest, validity

Files

+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2016-2020 Tom Sydney Kerckhove++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ genvalidity-sydtest.cabal view
@@ -0,0 +1,104 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           genvalidity-sydtest+version:        0.0.0.0+synopsis:       Standard properties for functions on `Validity` types for the sydtest framework+category:       Testing+homepage:       https://github.com/NorfairKing/validity#readme+bug-reports:    https://github.com/NorfairKing/validity/issues+author:         Tom Sydney Kerckhove+maintainer:     syd@cs-syd.eu+copyright:      Copyright: (c) 2020 Tom Sydney Kerckhove+license:        MIT+license-file:   LICENSE+build-type:     Simple++source-repository head+  type: git+  location: https://github.com/NorfairKing/validity++library+  exposed-modules:+      Test.Syd.Validity+      Test.Syd.Validity.Applicative+      Test.Syd.Validity.Arbitrary+      Test.Syd.Validity.Eq+      Test.Syd.Validity.Functions+      Test.Syd.Validity.Functions.CanFail+      Test.Syd.Validity.Functions.Equivalence+      Test.Syd.Validity.Functions.Idempotence+      Test.Syd.Validity.Functions.Inverse+      Test.Syd.Validity.Functions.Validity+      Test.Syd.Validity.Functor+      Test.Syd.Validity.GenRelativeValidity+      Test.Syd.Validity.GenValidity+      Test.Syd.Validity.GenValidity.Property+      Test.Syd.Validity.Monad+      Test.Syd.Validity.Monoid+      Test.Syd.Validity.Operations+      Test.Syd.Validity.Operations.Associativity+      Test.Syd.Validity.Operations.Commutativity+      Test.Syd.Validity.Operations.Identity+      Test.Syd.Validity.Ord+      Test.Syd.Validity.Property+      Test.Syd.Validity.Property.Utils+      Test.Syd.Validity.Relations+      Test.Syd.Validity.Relations.Antireflexivity+      Test.Syd.Validity.Relations.Antisymmetry+      Test.Syd.Validity.Relations.Reflexivity+      Test.Syd.Validity.Relations.Symmetry+      Test.Syd.Validity.Relations.Transitivity+      Test.Syd.Validity.RelativeValidity+      Test.Syd.Validity.Show+      Test.Syd.Validity.Shrinking+      Test.Syd.Validity.Shrinking.Property+      Test.Syd.Validity.Types+      Test.Syd.Validity.Utils+  other-modules:+      Paths_genvalidity_sydtest+  hs-source-dirs:+      src+  ghc-options: -Wall -fwarn-redundant-constraints+  build-depends:+      QuickCheck+    , base >=4.7 && <5+    , genvalidity >=0.7+    , pretty-show+    , sydtest+    , validity >=0.9+  default-language: Haskell2010++test-suite genvalidity-sydtest-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Test.Syd.Validity.ApplicativeSpec+      Test.Syd.Validity.ArbitrarySpec+      Test.Syd.Validity.EqSpec+      Test.Syd.Validity.FunctorSpec+      Test.Syd.Validity.GenRelativeValiditySpec+      Test.Syd.Validity.GenValiditySpec+      Test.Syd.Validity.MonadSpec+      Test.Syd.Validity.MonoidSpec+      Test.Syd.Validity.Operations.CommutativitySpec+      Test.Syd.Validity.OrdSpec+      Test.Syd.Validity.RelativeValiditySpec+      Test.Syd.Validity.ShowSpec+      Test.Syd.Validity.ShrinkingSpec+      Paths_genvalidity_sydtest+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+  build-tool-depends:+      sydtest-discover:sydtest-discover+  build-depends:+      QuickCheck+    , base >=4.7 && <5+    , genvalidity+    , genvalidity-sydtest+    , sydtest+  default-language: Haskell2010
+ src/Test/Syd/Validity.hs view
@@ -0,0 +1,289 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | To use the 'Spec' functions in this module, you will need @TypeApplications@.+--+--+-- The most interesting functions in this module for most uses are:+--+-- * 'genValidSpec'+-- * 'eqSpecOnValid'+-- * 'ordSpecOnValid'+-- * 'producesValidsOnValids'+-- * 'forAllValid'+-- * 'shouldBeValid'+module Test.Syd.Validity+    ( -- * Writing properties+      -- ** Cheap generation with shrinking+      forAllUnchecked+    , forAllValid+    , forAllInvalid+      -- ** Cheap assertions+    , shouldBeValid+    , shouldBeInvalid+      -- * Tests for GenValidity instances+    , genValiditySpec+    , genValidSpec+    , genInvalidSpec+    , genValidGeneratesValid+    , genGeneratesValid+    , genInvalidGeneratesInvalid+    , genGeneratesInvalid+    , shrinkValiditySpec+    , shrinkValidSpec+    , shrinkValidSpecWithLimit+    , shrinkInvalidSpec+    , shrinkValidPreservesValidOnGenValid+    , shrinkInvalidPreservesInvalidOnGenInvalid+    , shrinkPreservesValidOnGenValid+    , shrinkPreservesInvalidOnGenInvalid+    , shrinkValidPreservesValid+    , shrinkInvalidPreservesInvalid+    , shrinkingStaysValid+    , shrinkingStaysInvalid+    , shrinkingPreserves+      -- * Tests for Arbitrary instances involving Validity+    , arbitrarySpec+    , arbitraryGeneratesOnlyValid+      -- * Tests for RelativeValidity instances+    , relativeValiditySpec+    , relativeValidityImpliesValidA+    , relativeValidityImpliesValidB+      -- * Tests for GenRelativeValidity instances+    , genRelativeValiditySpec+    , genRelativeValidGeneratesValid+    , genRelativeInvalidGeneratesInvalid+      -- * Standard tests involving functions+      -- ** Standard tests involving validity+    , producesValidsOnGen+    , producesValidsOnValids+    , producesValid+    , producesValidsOnArbitrary+    , producesValidsOnGens2+    , producesValidsOnValids2+    , producesValid2+    , producesValidsOnArbitrary2+    , producesValidsOnGens3+    , 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+    , validIfSucceedsOnGens3+    , validIfSucceedsOnValids3+    , validIfSucceeds3+    , validIfSucceedsOnArbitrary3+      -- ** 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+    , inverseFunctions+    , inverseFunctionsOnArbitrary+    , inverseFunctionsIfFirstSucceedsOnGen+    , inverseFunctionsIfFirstSucceedsOnValid+    , inverseFunctionsIfFirstSucceeds+    , inverseFunctionsIfFirstSucceedsOnArbitrary+    , inverseFunctionsIfSecondSucceedsOnGen+    , inverseFunctionsIfSecondSucceedsOnValid+    , inverseFunctionsIfSecondSucceeds+    , inverseFunctionsIfSecondSucceedsOnArbitrary+    , inverseFunctionsIfSucceedOnGen+    , 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+    , 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+      -- * Show and Read properties+    , showReadSpecOnValid+    , showReadSpec+    , showReadSpecOnArbitrary+    , showReadSpecOnGen+      -- * Eq properties+    , eqSpecOnValid+    , eqSpecOnInvalid+    , eqSpec+    , eqSpecOnArbitrary+    , eqSpecOnGen+      -- * Ord properties+    , ordSpecOnGen+    , ordSpecOnValid+    , ordSpecOnInvalid+    , 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+      -- * Re-exports+    , module Data.GenValidity+    ) where++import Data.GenValidity++import Test.Syd.Validity.Applicative+import Test.Syd.Validity.Arbitrary+import Test.Syd.Validity.Eq+import Test.Syd.Validity.Functions+import Test.Syd.Validity.Functor+import Test.Syd.Validity.GenRelativeValidity+import Test.Syd.Validity.GenValidity+import Test.Syd.Validity.Monad+import Test.Syd.Validity.Monoid+import Test.Syd.Validity.Operations+import Test.Syd.Validity.Ord+import Test.Syd.Validity.Property+import Test.Syd.Validity.RelativeValidity+import Test.Syd.Validity.Show+import Test.Syd.Validity.Shrinking+import Test.Syd.Validity.Utils
+ src/Test/Syd/Validity/Applicative.hs view
@@ -0,0 +1,284 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++-- | Applicative properties+--+-- You will need @TypeApplications@ to use these.+module Test.Syd.Validity.Applicative+    ( applicativeSpecOnValid+    , applicativeSpec+    , applicativeSpecOnArbitrary+    , applicativeSpecOnGens+    ) where++import Data.Data++import Data.GenValidity+import Data.Kind++import Test.Syd+import Test.QuickCheck++import Test.Syd.Validity.Functions+import Test.Syd.Validity.Utils++{-# ANN module "HLint: ignore Avoid lambda" #-}++pureTypeStr ::+       forall (f :: Type -> Type). (Typeable f)+    => String+pureTypeStr = unwords ["pure", "::", "a", "->", nameOf @f, "a"]++seqTypeStr ::+       forall (f :: Type -> Type). (Typeable f)+    => String+seqTypeStr =+    unwords+        [ "(<*>)"+        , "::"+        , nameOf @f+        , "(a"+        , "->"+        , "b)"+        , "->"+        , nameOf @f+        , "a"+        , "->"+        , nameOf @f+        , "b"+        ]++seqrTypeStr ::+       forall (f :: Type -> Type). (Typeable f)+    => String+seqrTypeStr =+    unwords+        [ "(*>)"+        , "::"+        , nameOf @f+        , "a"+        , "->"+        , nameOf @f+        , "b"+        , "->"+        , nameOf @f+        , "b"+        ]++seqlTypeStr ::+       forall (f :: Type -> Type). (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 :: Type -> Type).+       (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 :: Type -> Type).+       ( 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 :: Type -> Type).+       (Eq (f Int), Show (f Int), Applicative f, Typeable f, Arbitrary (f Int))+    => Spec+applicativeSpecOnArbitrary = applicativeSpecWithInts @f arbitrary++applicativeSpecWithInts ::+       forall (f :: Type -> Type).+       (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 :: Type -> Type) (a :: Type) (b :: Type) (c :: Type).+       ( Show 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 shrinkNothing+            it+                (unwords+                     [ "satisfy the composition law: 'pure (.) <*> u <*> v <*> w = u <*> (v <*> w)' for"+                     , genDescr @(f (b -> c)) genffbname+                     , "composed with"+                     , genDescr @(f (a -> b)) genffaname+                     , "and applied to"+                     , genDescr @(f a) genname+                     ]) $+                equivalentOnGens3+                    (\(Anon u) (Anon v) w ->+                         pure (.) <*> (u :: f (b -> c)) <*> (v :: f (a -> b)) <*>+                         (w :: f a) :: f c)+                    (\(Anon u) (Anon v) w -> u <*> (v <*> w) :: f c)+                    ((,,) <$> (Anon <$> genffb) <*> (Anon <$> genffa) <*> gen)+                    shrinkNothing+            it+                (unwords+                     [ "satisfy the homomorphism law: 'pure f <*> pure x = pure (f x)' for"+                     , genDescr @(a -> b) genfaname+                     , "sequenced with"+                     , genDescr @a genaname+                     ]) $+                equivalentOnGens2+                    (\(Anon f) x -> pure f <*> pure x :: f b)+                    (\(Anon f) x -> pure $ f x :: f b)+                    ((,) <$> (Anon <$> genfa) <*> gena)+                    shrinkNothing+            it+                (unwords+                     [ "satisfy the interchange law: 'u <*> pure y = pure ($ y) <*> u' for"+                     , genDescr @(f (a -> b)) genffaname+                     , "sequenced with"+                     , genDescr @a genaname+                     ]) $+                equivalentOnGens2+                    (\(Anon u) y -> u <*> pure y :: f b)+                    (\(Anon u) y -> pure ($ y) <*> u :: f b)+                    ((,) <$> (Anon <$> genffa) <*> gena)+                    shrinkNothing+            it+                (unwords+                     [ "satisfy the law about the functor instance: fmap f x = pure f <*> x for"+                     , genDescr @(a -> b) genfaname+                     , "mapped over"+                     , genDescr @(f a) genname+                     ]) $+                equivalentOnGens2+                    (\(Anon f) x -> fmap f x)+                    (\(Anon f) x -> pure f <*> x)+                    ((,) <$> (Anon <$> genfa) <*> gen)+                    shrinkNothing+        describe (seqrTypeStr @f) $+            it+                (unwords+                     [ "is equivalent to its default implementation 'u Type> v = pure (const id) <*> u <*> v' for"+                     , genDescr @(f a) genname+                     , "in front of"+                     , genDescr @b genbname+                     ]) $+            equivalentOnGens2+                (\u v -> u *> v)+                (\u v -> pure (const id) <*> u <*> v)+                ((,) <$> gen <*> genb)+                shrinkNothing+        describe (seqlTypeStr @f) $+            it+                (unwords+                     [ "is equivalent to its default implementation 'u <* v = pure const <*> u <*> v' for"+                     , genDescr @b genbname+                     , "behind"+                     , genDescr @(f a) genname+                     ]) $+            equivalentOnGens2+                (\u v -> u <* v)+                (\u v -> pure const <*> u <*> v)+                ((,) <$> gen <*> genb)+                shrinkNothing
+ src/Test/Syd/Validity/Arbitrary.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}++-- | Tests for Arbitrary instances involving Validity+--+-- You will need @TypeApplications@ to use these.+module Test.Syd.Validity.Arbitrary+    ( arbitrarySpec+    , arbitraryGeneratesOnlyValid+    ) where++import Data.Data++import Data.GenValidity++import Test.Syd+import Test.QuickCheck++import Test.Syd.Validity.GenValidity+import Test.Syd.Validity.Utils++-- | A @Spec@ that specifies that @arbitrary@ only generates data that+-- satisfy @isValid@+--+-- Example usage:+--+-- > arbitrarySpec @Int+arbitrarySpec ::+       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)+    => Property+arbitraryGeneratesOnlyValid = genGeneratesValid @a arbitrary
+ src/Test/Syd/Validity/Eq.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++-- | Eq properties+--+-- You will need @TypeApplications@ to use these.+module Test.Syd.Validity.Eq+    ( eqSpecOnValid+    , eqSpecOnInvalid+    , eqSpec+    , eqSpecOnArbitrary+    , eqSpecOnGen+    ) where++import Data.Data++import Data.GenValidity++import Test.Syd+import Test.QuickCheck++import Test.Syd.Validity.Functions+import Test.Syd.Validity.Relations+import Test.Syd.Validity.Utils++eqTypeStr ::+       forall a. Typeable a+    => String+eqTypeStr = binRelStr @a "=="++neqTypeStr ::+       forall a. Typeable a+    => String+neqTypeStr = binRelStr @a "/="++-- | 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" shrinkValid++-- | Standard test spec for properties of Eq instances for invalid values+--+-- Example usage:+--+-- > eqSpecOnInvalid @Double+eqSpecOnInvalid ::+       forall a. (Show a, Eq a, Typeable a, GenInvalid a)+    => Spec+eqSpecOnInvalid = eqSpecOnGen @a genInvalid "invalid" shrinkInvalid++-- | 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" shrinkUnchecked++-- | 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" shrink++-- | 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+    -> (a -> [a])+    -> Spec+eqSpecOnGen gen genname s =+    parallel $ do+        let name = nameOf @a+            funeqstr = eqTypeStr @a+            funneqstr = neqTypeStr @a+            gen2 = (,) <$> gen <*> gen+            gen3 = (,,) <$> gen <*> gen <*> gen+            s2 = shrinkT2 s+        describe ("Eq " ++ name) $ do+            let eq = (==) @a+                neq = (/=) @a+            describe funeqstr $ do+                it+                    (unwords+                         [ "is reflexive for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "s"+                         ]) $+                    reflexivityOnGen eq gen s+                it+                    (unwords+                         [ "is symmetric for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "s"+                         ]) $+                    symmetryOnGens eq gen2 s+                it+                    (unwords+                         [ "is transitive for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "s"+                         ]) $+                    transitivityOnGens eq gen3 s+                it+                    (unwords+                         [ "is equivalent to (\\a b -> not $ a /= b) for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "s"+                         ]) $+                    equivalentOnGens2 eq (\a b -> not $ a `neq` b) gen2 s2+            describe funneqstr $ do+                it+                    (unwords+                         [ "is antireflexive for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "s"+                         ]) $+                    antireflexivityOnGen neq gen s+                it+                    (unwords+                         [ "is equivalent to (\\a b -> not $ a == b) for"+                         , "\"" ++ genname+                         , name ++ "\"" ++ "s"+                         ]) $+                    equivalentOnGens2 neq (\a b -> not $ a `eq` b) gen2 s2
+ src/Test/Syd/Validity/Functions.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Validity tests involving functions+module Test.Syd.Validity.Functions+    ( producesValidsOnGen+    , producesValidsOnValids+    , producesValid+    , producesValidsOnArbitrary+    , producesValidsOnGens2+    , producesValidsOnValids2+    , producesValid2+    , producesValidsOnArbitrary2+    , producesValidsOnGens3+    , producesValidsOnValids3+    , producesValid3+    , producesValidsOnArbitrary3+    , succeedsOnGen+    , succeedsOnValid+    , succeeds+    , succeedsOnArbitrary+    , succeedsOnGens2+    , succeedsOnValids2+    , succeeds2+    , succeedsOnArbitrary2+    , failsOnGen+    , failsOnInvalid+    , failsOnGens2+    , failsOnInvalid2+    , validIfSucceedsOnGen+    , validIfSucceedsOnValid+    , validIfSucceedsOnArbitrary+    , validIfSucceeds+    , validIfSucceedsOnGens2+    , validIfSucceedsOnValids2+    , validIfSucceeds2+    , validIfSucceedsOnArbitrary2+    , validIfSucceedsOnGens3+    , validIfSucceedsOnValids3+    , validIfSucceeds3+    , validIfSucceedsOnArbitrary3+    , 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+    , inverseFunctionsOnGen+    , inverseFunctionsOnValid+    , inverseFunctions+    , inverseFunctionsOnArbitrary+    , inverseFunctionsIfFirstSucceedsOnGen+    , inverseFunctionsIfFirstSucceedsOnValid+    , inverseFunctionsIfFirstSucceeds+    , inverseFunctionsIfFirstSucceedsOnArbitrary+    , inverseFunctionsIfSecondSucceedsOnGen+    , inverseFunctionsIfSecondSucceedsOnValid+    , inverseFunctionsIfSecondSucceeds+    , inverseFunctionsIfSecondSucceedsOnArbitrary+    , inverseFunctionsIfSucceedOnGen+    , inverseFunctionsIfSucceedOnValid+    , inverseFunctionsIfSucceed+    , inverseFunctionsIfSucceedOnArbitrary+    , idempotentOnGen+    , idempotentOnValid+    , idempotent+    , idempotentOnArbitrary+    ) where++import Test.Syd.Validity.Functions.CanFail+import Test.Syd.Validity.Functions.Equivalence+import Test.Syd.Validity.Functions.Idempotence+import Test.Syd.Validity.Functions.Inverse+import Test.Syd.Validity.Functions.Validity
+ src/Test/Syd/Validity/Functions/CanFail.hs view
@@ -0,0 +1,213 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Syd.Validity.Functions.CanFail+  ( succeedsOnGen,+    succeedsOnValid,+    succeeds,+    succeedsOnArbitrary,+    succeedsOnGens2,+    succeedsOnValids2,+    succeeds2,+    succeedsOnArbitrary2,+    failsOnGen,+    failsOnInvalid,+    failsOnGens2,+    failsOnInvalid2,+    validIfSucceedsOnGen,+    validIfSucceedsOnValid,+    validIfSucceedsOnArbitrary,+    validIfSucceeds,+    validIfSucceedsOnGens2,+    validIfSucceedsOnValids2,+    validIfSucceeds2,+    validIfSucceedsOnArbitrary2,+    validIfSucceedsOnGens3,+    validIfSucceedsOnValids3,+    validIfSucceeds3,+    validIfSucceedsOnArbitrary3,+  )+where++import Data.GenValidity+import Test.Syd+import Test.QuickCheck+import Test.Syd.Validity.Property.Utils+import Test.Syd.Validity.Types++-- | The function succeeds if the input is generated by the given generator+succeedsOnGen ::+  (Show a, Show (f b), CanFail f) => (a -> f b) -> Gen a -> (a -> [a]) -> Property+succeedsOnGen func gen s = forAllShrink gen s $ \a -> func a `shouldSatisfy` (not . hasFailed)++-- | The function succeeds if the input is generated by @genValid@+succeedsOnValid :: (Show a, Show (f b), GenValid a, CanFail f) => (a -> f b) -> Property+succeedsOnValid f = succeedsOnGen f genValid shrinkValid++-- | The function succeeds if the input is generated by @genUnchecked@+succeeds :: (Show a, Show (f b), GenUnchecked a, CanFail f) => (a -> f b) -> Property+succeeds f = succeedsOnGen f genUnchecked shrinkUnchecked++-- | The function succeeds if the input is generated by @arbitrary@+succeedsOnArbitrary ::+  (Show a, Show (f b), Arbitrary a, CanFail f) => (a -> f b) -> Property+succeedsOnArbitrary f = succeedsOnGen f arbitrary shrink++-- | The function fails if the input is generated by the given generator+failsOnGen ::+  (Show a, Show (f b), CanFail f) => (a -> f b) -> Gen a -> (a -> [a]) -> Property+failsOnGen func gen s = forAllShrink gen s $ \a -> func a `shouldSatisfy` hasFailed++-- | The function fails if the input is generated by @genInvalid@+failsOnInvalid :: (Show a, Show (f b), GenInvalid a, CanFail f) => (a -> f b) -> Property+failsOnInvalid f = failsOnGen f genInvalid shrinkInvalid++-- | The function produces output that satisfies @isValid@ if it is given input+-- that is generated by the given generator.+validIfSucceedsOnGen ::+  (Show a, Show b, Validity b, CanFail f) => (a -> f b) -> Gen a -> (a -> [a]) -> Property+validIfSucceedsOnGen func gen s =+  forAllShrink gen s $ \a ->+    case resultIfSucceeded (func a) of+      Nothing -> return () -- Can happen+      Just res -> shouldBeValid res++-- | The function produces output that satisfies @isValid@ if it is given input+-- that is generated by @arbitrary@.+validIfSucceedsOnValid ::+  (Show a, Show b, GenValid a, Validity b, CanFail f) => (a -> f b) -> Property+validIfSucceedsOnValid f = validIfSucceedsOnGen f genValid shrinkValid++-- | The function produces output that satisfies @isValid@ if it is given input+-- that is generated by @arbitrary@.+validIfSucceedsOnArbitrary ::+  (Show a, Show b, Arbitrary a, Validity b, CanFail f) => (a -> f b) -> Property+validIfSucceedsOnArbitrary f = validIfSucceedsOnGen f arbitrary shrink++-- | The function produces output that satisfies @isValid@ if it is given input+-- that is generated by @genUnchecked@.+validIfSucceeds :: (Show a, Show b, GenUnchecked a, Validity b, CanFail f) => (a -> f b) -> Property+validIfSucceeds f = validIfSucceedsOnGen f genUnchecked shrinkUnchecked++succeedsOnGens2 ::+  (Show a, Show b, Show (f c), CanFail f) =>+  (a -> b -> f c) ->+  Gen (a, b) ->+  ((a, b) -> [(a, b)]) ->+  Property+succeedsOnGens2 func gen s =+  forAllShrink gen s $ \(a, b) -> func a b `shouldSatisfy` (not . hasFailed)++succeedsOnValids2 ::+  (Show a, Show b, Show (f c), GenValid a, GenValid b, CanFail f) =>+  (a -> b -> f c) ->+  Property+succeedsOnValids2 func = succeedsOnGens2 func genValid shrinkValid++succeeds2 ::+  (Show a, Show b, Show (f c), GenUnchecked a, GenUnchecked b, CanFail f) =>+  (a -> b -> f c) ->+  Property+succeeds2 func = succeedsOnGens2 func genUnchecked shrinkUnchecked++succeedsOnArbitrary2 ::+  (Show a, Show b, Show (f c), Arbitrary a, Arbitrary b, CanFail f) =>+  (a -> b -> f c) ->+  Property+succeedsOnArbitrary2 func = succeedsOnGens2 func arbitrary shrink++failsOnGens2 ::+  (Show a, Show b, Show (f c), CanFail f) =>+  (a -> b -> f c) ->+  Gen a ->+  (a -> [a]) ->+  Gen b ->+  (b -> [b]) ->+  Property+failsOnGens2 func genA sA genB sB =+  forAllShrink genA sA $ \a -> forAllShrink genB sB $ \b -> func a b `shouldSatisfy` hasFailed++failsOnInvalid2 ::+  ( Show a,+    Show b,+    Show (f c),+    GenUnchecked a,+    GenUnchecked b,+    GenInvalid a,+    GenInvalid b,+    CanFail f+  ) =>+  (a -> b -> f c) ->+  Property+failsOnInvalid2 func =+  failsOnGens2 func genInvalid shrinkInvalid genUnchecked shrinkUnchecked+    .&&. failsOnGens2 func genUnchecked shrinkUnchecked genInvalid shrinkInvalid++validIfSucceedsOnGens2 ::+  (Show a, Show b, Show c, Validity c, CanFail f) =>+  (a -> b -> f c) ->+  Gen (a, b) ->+  ((a, b) -> [(a, b)]) ->+  Property+validIfSucceedsOnGens2 func gen s =+  forAllShrink gen s $ \(a, b) ->+    case resultIfSucceeded (func a b) of+      Nothing -> return () -- Can happen+      Just res -> shouldBeValid res++validIfSucceedsOnValids2 ::+  (Show a, Show b, Show c, GenValid a, GenValid b, Validity c, CanFail f) =>+  (a -> b -> f c) ->+  Property+validIfSucceedsOnValids2 func = validIfSucceedsOnGens2 func genValid shrinkValid++validIfSucceeds2 ::+  (Show a, Show b, Show c, GenUnchecked a, GenUnchecked b, Validity c, CanFail f) =>+  (a -> b -> f c) ->+  Property+validIfSucceeds2 func = validIfSucceedsOnGens2 func genUnchecked shrinkUnchecked++validIfSucceedsOnArbitrary2 ::+  (Show a, Show b, Show c, Arbitrary a, Arbitrary b, Validity c, CanFail f) =>+  (a -> b -> f c) ->+  Property+validIfSucceedsOnArbitrary2 func = validIfSucceedsOnGens2 func arbitrary shrink++validIfSucceedsOnGens3 ::+  (Show a, Show b, Show c, Show d, Validity d, CanFail f) =>+  (a -> b -> c -> f d) ->+  Gen (a, b, c) ->+  ((a, b, c) -> [(a, b, c)]) ->+  Property+validIfSucceedsOnGens3 func gen s =+  forAllShrink gen s $ \(a, b, c) ->+    case resultIfSucceeded (func a b c) of+      Nothing -> return () -- Can happen+      Just res -> shouldBeValid res++validIfSucceedsOnValids3 ::+  (Show a, Show b, Show c, Show d, GenValid a, GenValid b, GenValid c, Validity d, CanFail f) =>+  (a -> b -> c -> f d) ->+  Property+validIfSucceedsOnValids3 func = validIfSucceedsOnGens3 func genValid shrinkValid++validIfSucceeds3 ::+  ( Show a,+    Show b,+    Show c,+    Show d,+    GenUnchecked a,+    GenUnchecked b,+    GenUnchecked c,+    Validity d,+    CanFail f+  ) =>+  (a -> b -> c -> f d) ->+  Property+validIfSucceeds3 func = validIfSucceedsOnGens3 func genUnchecked shrinkUnchecked++validIfSucceedsOnArbitrary3 ::+  (Show a, Show b, Show c, Show d, Arbitrary a, Arbitrary b, Arbitrary c, Validity d, CanFail f) =>+  (a -> b -> c -> f d) ->+  Property+validIfSucceedsOnArbitrary3 func = validIfSucceedsOnGens3 func arbitrary shrink
+ src/Test/Syd/Validity/Functions/Equivalence.hs view
@@ -0,0 +1,459 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Syd.Validity.Functions.Equivalence+    ( 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 Test.Syd+import Test.QuickCheck++import Test.Syd.Validity.Types++equivalentOnGen ::+       (Show a, Show b, Eq b)+    => (a -> b)+    -> (a -> b)+    -> Gen a+    -> (a -> [a])+    -> Property+equivalentOnGen f g gen s = forAllShrink gen s $ \a -> f a `shouldBe` g a++equivalentOnValid ::+       (Show a, GenValid a, Show b, Eq b)+    => (a -> b)+    -> (a -> b)+    -> Property+equivalentOnValid f g = equivalentOnGen f g genValid shrinkValid++equivalent ::+       (Show a, GenUnchecked a, Show b, Eq b)+    => (a -> b)+    -> (a -> b)+    -> Property+equivalent f g = equivalentOnGen f g genUnchecked shrinkUnchecked++-- |+--+-- prop> equivalentOnArbitrary ((* 2) . (+ 1)) ((+ 2) . (* 2) :: Int -> Int)+equivalentOnArbitrary ::+       (Show a, Arbitrary a, Show b, Eq b)+    => (a -> b)+    -> (a -> b)+    -> Property+equivalentOnArbitrary f g = equivalentOnGen f g arbitrary shrink++equivalentOnGens2 ::+       (Show a, Show b, Show c, Eq c)+    => (a -> b -> c)+    -> (a -> b -> c)+    -> Gen (a, b)+    -> ((a, b) -> [(a, b)])+    -> Property+equivalentOnGens2 f g gen s =+    forAllShrink gen s $ \(a, b) -> f a b `shouldBe` g a b++equivalentOnValids2 ::+       (Show a, GenValid a, Show b, GenValid b, Show c, Eq c)+    => (a -> b -> c)+    -> (a -> b -> c)+    -> Property+equivalentOnValids2 f g = equivalentOnGens2 f g genValid shrinkValid++equivalent2 ::+       (Show a, GenUnchecked a, Show b, GenUnchecked b, Show c, Eq c)+    => (a -> b -> c)+    -> (a -> b -> c)+    -> Property+equivalent2 f g = equivalentOnGens2 f g genUnchecked shrinkUnchecked++-- |+--+-- prop> equivalentOnArbitrary2 (+) ((+) :: Int -> Int -> Int)+equivalentOnArbitrary2 ::+       (Show a, Arbitrary a, Show b, Arbitrary b, Show c, Eq c)+    => (a -> b -> c)+    -> (a -> b -> c)+    -> Property+equivalentOnArbitrary2 f g = equivalentOnGens2 f g arbitrary shrink++equivalentWhenFirstSucceedsOnGen ::+       (Show a, Show b, Eq b, CanFail f)+    => (a -> f b)+    -> (a -> b)+    -> Gen a+    -> (a -> [a])+    -> Property+equivalentWhenFirstSucceedsOnGen f g gen s =+    forAllShrink gen s $ \a ->+        case resultIfSucceeded (f a) of+            Nothing -> return () -- fine+            Just r -> r `shouldBe` g a++equivalentWhenFirstSucceedsOnValid ::+       (Show a, GenValid a, Show b, Eq b, CanFail f)+    => (a -> f b)+    -> (a -> b)+    -> Property+equivalentWhenFirstSucceedsOnValid f g =+    equivalentWhenFirstSucceedsOnGen f g genValid shrinkValid++equivalentWhenFirstSucceedsOnArbitrary ::+       (Show a, Arbitrary a, Show b, Eq b, CanFail f)+    => (a -> f b)+    -> (a -> b)+    -> Property+equivalentWhenFirstSucceedsOnArbitrary f g =+    equivalentWhenFirstSucceedsOnGen f g arbitrary shrink++equivalentWhenFirstSucceeds ::+       (Show a, GenUnchecked a, Show b, Eq b, CanFail f)+    => (a -> f b)+    -> (a -> b)+    -> Property+equivalentWhenFirstSucceeds f g =+    equivalentWhenFirstSucceedsOnGen f g genUnchecked shrinkUnchecked++equivalentWhenFirstSucceedsOnGens2 ::+       (Show a, Show b, Show c, Eq c, CanFail f)+    => (a -> b -> f c)+    -> (a -> b -> c)+    -> Gen (a, b)+    -> ((a, b) -> [(a, b)])+    -> Property+equivalentWhenFirstSucceedsOnGens2 f g gen s =+    forAllShrink gen s $ \(a, b) ->+        case resultIfSucceeded (f a b) of+            Nothing -> return () -- fine+            Just rs -> rs `shouldBe` g a b++equivalentWhenFirstSucceedsOnValids2 ::+       ( Show a+       , GenValid a+       , Show b+       , GenValid b+       , Show c+       , Eq c+       , CanFail f+       )+    => (a -> b -> f c)+    -> (a -> b -> c)+    -> Property+equivalentWhenFirstSucceedsOnValids2 f g =+    equivalentWhenFirstSucceedsOnGens2 f g genValid shrinkValid++equivalentWhenFirstSucceedsOnArbitrary2 ::+       ( Show a+       , Arbitrary a+       , Show b+       , Arbitrary b+       , Show c+       , Eq c+       , CanFail f+       )+    => (a -> b -> f c)+    -> (a -> b -> c)+    -> Property+equivalentWhenFirstSucceedsOnArbitrary2 f g =+    equivalentWhenFirstSucceedsOnGens2 f g arbitrary shrink++equivalentWhenFirstSucceeds2 ::+       ( Show a+       , GenUnchecked a+       , Show b+       , GenUnchecked b+       , Show c+       , Eq c+       , CanFail f+       )+    => (a -> b -> f c)+    -> (a -> b -> c)+    -> Property+equivalentWhenFirstSucceeds2 f g =+    equivalentWhenFirstSucceedsOnGens2 f g genUnchecked shrinkUnchecked++equivalentWhenSecondSucceedsOnGen ::+       (Show a, Show b, Eq b, CanFail f)+    => (a -> b)+    -> (a -> f b)+    -> Gen a+    -> (a -> [a])+    -> Property+equivalentWhenSecondSucceedsOnGen f g gen s =+    forAllShrink gen s $ \a ->+        case resultIfSucceeded (g a) of+            Nothing -> return () -- fine+            Just r -> r `shouldBe` f a++equivalentWhenSecondSucceedsOnValid ::+       (Show a, GenValid a, Show b, Eq b, CanFail f)+    => (a -> b)+    -> (a -> f b)+    -> Property+equivalentWhenSecondSucceedsOnValid f g =+    equivalentWhenSecondSucceedsOnGen f g genValid shrinkValid++equivalentWhenSecondSucceedsOnArbitrary ::+       (Show a, Arbitrary a, Show b, Eq b, CanFail f)+    => (a -> b)+    -> (a -> f b)+    -> Property+equivalentWhenSecondSucceedsOnArbitrary f g =+    equivalentWhenSecondSucceedsOnGen f g arbitrary shrink++equivalentWhenSecondSucceeds ::+       (Show a, GenUnchecked a, Show b, Eq b, CanFail f)+    => (a -> b)+    -> (a -> f b)+    -> Property+equivalentWhenSecondSucceeds f g =+    equivalentWhenSecondSucceedsOnGen f g genUnchecked shrinkUnchecked++equivalentWhenSecondSucceedsOnGens2 ::+       (Show a, Show b, Show c, Eq c, CanFail f)+    => (a -> b -> c)+    -> (a -> b -> f c)+    -> Gen (a, b)+    -> ((a, b) -> [(a, b)])+    -> Property+equivalentWhenSecondSucceedsOnGens2 f g gen s =+    forAllShrink gen s $ \(a, b) ->+        case resultIfSucceeded (g a b) of+            Nothing -> return () -- fine+            Just rs -> rs `shouldBe` f a b++equivalentWhenSecondSucceedsOnValids2 ::+       ( Show a+       , GenValid a+       , Show b+       , GenValid b+       , Show c+       , Eq c+       , CanFail f+       )+    => (a -> b -> c)+    -> (a -> b -> f c)+    -> Property+equivalentWhenSecondSucceedsOnValids2 f g =+    equivalentWhenSecondSucceedsOnGens2 f g genValid shrinkValid++equivalentWhenSecondSucceedsOnArbitrary2 ::+       ( Show a+       , Arbitrary a+       , Show b+       , Arbitrary b+       , Show c+       , Eq c+       , CanFail f+       )+    => (a -> b -> c)+    -> (a -> b -> f c)+    -> Property+equivalentWhenSecondSucceedsOnArbitrary2 f g =+    equivalentWhenSecondSucceedsOnGens2 f g arbitrary shrink++equivalentWhenSecondSucceeds2 ::+       ( Show a+       , GenUnchecked a+       , Show b+       , GenUnchecked b+       , Show c+       , Eq c+       , CanFail f+       )+    => (a -> b -> c)+    -> (a -> b -> f c)+    -> Property+equivalentWhenSecondSucceeds2 f g =+    equivalentWhenSecondSucceedsOnGens2 f g genUnchecked shrinkUnchecked++equivalentWhenSucceedOnGen ::+       (Show a, Show b, Eq b, CanFail f)+    => (a -> f b)+    -> (a -> f b)+    -> Gen a+    -> (a -> [a])+    -> Property+equivalentWhenSucceedOnGen f g gen s =+    forAllShrink gen s $ \a ->+        case do fa <- resultIfSucceeded $ f a+                ga <- resultIfSucceeded $ g a+                return (fa, ga) of+            Nothing -> return () -- fine+            Just (fa, ga) -> fa `shouldBe` ga++equivalentWhenSucceedOnValid ::+       (Show a, GenValid a, Show b, Eq b, CanFail f)+    => (a -> f b)+    -> (a -> f b)+    -> Property+equivalentWhenSucceedOnValid f g =+    equivalentWhenSucceedOnGen f g genValid shrinkValid++equivalentWhenSucceed ::+       (Show a, GenUnchecked a, Show b, Eq b, CanFail f)+    => (a -> f b)+    -> (a -> f b)+    -> Property+equivalentWhenSucceed f g =+    equivalentWhenSucceedOnGen f g genUnchecked shrinkUnchecked++equivalentWhenSucceedOnArbitrary ::+       (Show a, Arbitrary a, Show b, Eq b, CanFail f)+    => (a -> f b)+    -> (a -> f b)+    -> Property+equivalentWhenSucceedOnArbitrary f g =+    equivalentWhenSucceedOnGen f g arbitrary shrink++equivalentWhenSucceedOnGens2 ::+       (Show a, Show b, Show c, Eq c, CanFail f)+    => (a -> b -> f c)+    -> (a -> b -> f c)+    -> Gen (a, b)+    -> ((a, b) -> [(a, b)])+    -> Property+equivalentWhenSucceedOnGens2 f g gen s =+    forAllShrink gen s $ \(a, b) ->+        case do fab <- resultIfSucceeded $ f a b+                gab <- resultIfSucceeded $ g a b+                return (fab, gab) of+            Nothing -> return () -- fine+            Just (fab, gab) -> fab `shouldBe` gab++equivalentWhenSucceedOnValids2 ::+       ( Show a+       , GenValid a+       , Show 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 shrinkValid++equivalentWhenSucceedOnArbitrary2 ::+       ( Show a+       , Arbitrary a+       , Show 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 shrink++equivalentWhenSucceed2 ::+       ( Show a+       , GenUnchecked a+       , Show 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 shrinkUnchecked++equivalentOnGens3 ::+       (Show a, Show b, Show c, Show d, Eq d)+    => (a -> b -> c -> d)+    -> (a -> b -> c -> d)+    -> Gen (a, b, c)+    -> ((a, b, c) -> [(a, b, c)])+    -> Property+equivalentOnGens3 f g gen s =+    forAllShrink gen s $ \(a, b, c) -> f a b c `shouldBe` g a b c++equivalentOnValids3 ::+       ( Show a+       , GenValid a+       , Show b+       , GenValid b+       , Show c+       , GenValid c+       , Show d+       , Eq d+       )+    => (a -> b -> c -> d)+    -> (a -> b -> c -> d)+    -> Property+equivalentOnValids3 f g = equivalentOnGens3 f g genValid shrinkValid++equivalent3 ::+       ( Show a+       , GenUnchecked a+       , Show b+       , GenUnchecked b+       , Show c+       , GenUnchecked c+       , Show d+       , Eq d+       )+    => (a -> b -> c -> d)+    -> (a -> b -> c -> d)+    -> Property+equivalent3 f g = equivalentOnGens3 f g genUnchecked shrinkUnchecked++equivalentOnArbitrary3 ::+       ( Show a+       , Arbitrary a+       , Show b+       , Arbitrary b+       , Show c+       , Arbitrary c+       , Show d+       , Eq d+       )+    => (a -> b -> c -> d)+    -> (a -> b -> c -> d)+    -> Property+equivalentOnArbitrary3 f g = equivalentOnGens3 f g arbitrary shrink
+ src/Test/Syd/Validity/Functions/Idempotence.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Standard tests involving validity+module Test.Syd.Validity.Functions.Idempotence+    ( idempotentOnGen+    , idempotentOnValid+    , idempotent+    , idempotentOnArbitrary+    ) where++import Data.GenValidity++import Test.Syd+import Test.QuickCheck++idempotentOnGen :: (Show a, Eq a) => (a -> a) -> Gen a -> (a -> [a]) -> Property+idempotentOnGen f gen s = forAllShrink gen s $ \a -> f (f a) `shouldBe` f a++idempotentOnValid :: (Show a, Eq a, GenValid a) => (a -> a) -> Property+idempotentOnValid func = idempotentOnGen func genValid shrinkValid++idempotent :: (Show a, Eq a, GenUnchecked a) => (a -> a) -> Property+idempotent func = idempotentOnGen func genUnchecked shrinkUnchecked++-- |+--+-- 'id' is idempotent for any type:+--+-- prop> idempotentOnArbitrary (id :: Int -> Int)+--+-- 'const', given any input, is idempotent for any type as well:+--+-- prop> \int -> idempotentOnArbitrary (const int :: Int -> Int)+idempotentOnArbitrary :: (Show a, Eq a, Arbitrary a) => (a -> a) -> Property+idempotentOnArbitrary func = idempotentOnGen func arbitrary shrink
+ src/Test/Syd/Validity/Functions/Inverse.hs view
@@ -0,0 +1,161 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Standard tests involving inverse functions+module Test.Syd.Validity.Functions.Inverse+    ( inverseFunctionsOnGen+    , inverseFunctionsOnValid+    , inverseFunctions+    , inverseFunctionsOnArbitrary+    , inverseFunctionsIfFirstSucceedsOnGen+    , inverseFunctionsIfFirstSucceedsOnValid+    , inverseFunctionsIfFirstSucceeds+    , inverseFunctionsIfFirstSucceedsOnArbitrary+    , inverseFunctionsIfSecondSucceedsOnGen+    , inverseFunctionsIfSecondSucceedsOnValid+    , inverseFunctionsIfSecondSucceeds+    , inverseFunctionsIfSecondSucceedsOnArbitrary+    , inverseFunctionsIfSucceedOnGen+    , inverseFunctionsIfSucceedOnValid+    , inverseFunctionsIfSucceed+    , inverseFunctionsIfSucceedOnArbitrary+    ) where++import Data.GenValidity++import Test.Syd+import Test.QuickCheck++import Test.Syd.Validity.Types++inverseFunctionsOnGen ::+       (Show a, Eq a) => (a -> b) -> (b -> a) -> Gen a -> (a -> [a]) -> Property+inverseFunctionsOnGen f g gen s =+    forAllShrink gen s $ \a -> g (f a) `shouldBe` a++inverseFunctionsOnValid ::+       (Show a, Eq a, GenValid a) => (a -> b) -> (b -> a) -> Property+inverseFunctionsOnValid f g = inverseFunctionsOnGen f g genValid shrinkValid++inverseFunctions ::+       (Show a, Eq a, GenUnchecked a) => (a -> b) -> (b -> a) -> Property+inverseFunctions f g = inverseFunctionsOnGen f g genUnchecked shrinkUnchecked++-- |+-- '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 shrink++inverseFunctionsIfFirstSucceedsOnGen ::+       (Show a, Eq a, CanFail f)+    => (a -> f b)+    -> (b -> a)+    -> Gen a+    -> (a -> [a])+    -> Property+inverseFunctionsIfFirstSucceedsOnGen f g gen s =+    forAllShrink gen s $ \a ->+        case resultIfSucceeded (f a) of+            Nothing -> return () -- fine+            Just b -> g b `shouldBe` a++inverseFunctionsIfFirstSucceedsOnValid ::+       (Show a, Eq a, GenValid a, CanFail f)+    => (a -> f b)+    -> (b -> a)+    -> Property+inverseFunctionsIfFirstSucceedsOnValid f g =+    inverseFunctionsIfFirstSucceedsOnGen f g genValid shrinkValid++inverseFunctionsIfFirstSucceeds ::+       (Show a, Eq a, GenUnchecked a, CanFail f)+    => (a -> f b)+    -> (b -> a)+    -> Property+inverseFunctionsIfFirstSucceeds f g =+    inverseFunctionsIfFirstSucceedsOnGen f g genUnchecked shrinkUnchecked++inverseFunctionsIfFirstSucceedsOnArbitrary ::+       (Show a, Eq a, Arbitrary a, CanFail f)+    => (a -> f b)+    -> (b -> a)+    -> Property+inverseFunctionsIfFirstSucceedsOnArbitrary f g =+    inverseFunctionsIfFirstSucceedsOnGen f g arbitrary shrink++inverseFunctionsIfSecondSucceedsOnGen ::+       (Show a, Eq a, CanFail f)+    => (a -> b)+    -> (b -> f a)+    -> Gen a+    -> (a -> [a])+    -> Property+inverseFunctionsIfSecondSucceedsOnGen f g gen s =+    forAllShrink gen s $ \a ->+        case resultIfSucceeded (g (f a)) of+            Nothing -> return () -- fine+            Just r -> r `shouldBe` a++inverseFunctionsIfSecondSucceedsOnValid ::+       (Show a, Eq a, GenValid a, CanFail f)+    => (a -> b)+    -> (b -> f a)+    -> Property+inverseFunctionsIfSecondSucceedsOnValid f g =+    inverseFunctionsIfSecondSucceedsOnGen f g genValid shrinkValid++inverseFunctionsIfSecondSucceeds ::+       (Show a, Eq a, GenUnchecked a, CanFail f)+    => (a -> b)+    -> (b -> f a)+    -> Property+inverseFunctionsIfSecondSucceeds f g =+    inverseFunctionsIfSecondSucceedsOnGen f g genUnchecked shrinkUnchecked++inverseFunctionsIfSecondSucceedsOnArbitrary ::+       (Show a, Eq a, Arbitrary a, CanFail f)+    => (a -> b)+    -> (b -> f a)+    -> Property+inverseFunctionsIfSecondSucceedsOnArbitrary f g =+    inverseFunctionsIfSecondSucceedsOnGen f g arbitrary shrink++inverseFunctionsIfSucceedOnGen ::+       (Show a, Eq a, CanFail f, CanFail g)+    => (a -> f b)+    -> (b -> g a)+    -> Gen a+    -> (a -> [a])+    -> Property+inverseFunctionsIfSucceedOnGen f g gen s =+    forAllShrink gen s $ \a ->+        case do fa <- resultIfSucceeded $ f a+                resultIfSucceeded $ g fa of+            Nothing -> return () -- fine+            Just r -> r `shouldBe` a++inverseFunctionsIfSucceedOnValid ::+       (Show a, Eq a, GenValid a, CanFail f, CanFail g)+    => (a -> f b)+    -> (b -> g a)+    -> Property+inverseFunctionsIfSucceedOnValid f g =+    inverseFunctionsIfSucceedOnGen f g genValid shrinkValid++inverseFunctionsIfSucceed ::+       (Show a, Eq a, GenUnchecked a, CanFail f, CanFail g)+    => (a -> f b)+    -> (b -> g a)+    -> Property+inverseFunctionsIfSucceed f g =+    inverseFunctionsIfSucceedOnGen f g genUnchecked shrinkUnchecked++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 shrink
+ src/Test/Syd/Validity/Functions/Validity.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Standard tests involving validity+module Test.Syd.Validity.Functions.Validity+    ( producesValidsOnGen+    , producesValidsOnValids+    , producesValid+    , producesValidsOnArbitrary+    , producesValidsOnGens2+    , producesValidsOnValids2+    , producesValid2+    , producesValidsOnArbitrary2+    , producesValidsOnGens3+    , producesValidsOnValids3+    , producesValid3+    , producesValidsOnArbitrary3+    ) where++import Data.GenValidity++import Test.QuickCheck++import Test.Syd.Validity.Property.Utils++-- | The function produces valid output when the input is generated as+-- specified by the given generator.+producesValidsOnGen ::+       forall a b. (Show a, Show b, Validity b)+    => (a -> b)+    -> Gen a+    -> (a -> [a])+    -> Property+producesValidsOnGen func gen s = forAllShrink gen s $ shouldBeValid . func++-- | The function produces valid output when the input is generated by+-- @genValid@+producesValidsOnValids ::+       (Show a, Show b, GenValid a, Validity b) => (a -> b) -> Property+producesValidsOnValids f = producesValidsOnGen f genValid shrinkValid++-- | The function produces valid output when the input is generated by+-- @genUnchecked@+producesValid ::+       (Show a, Show b, GenUnchecked a, Validity b) => (a -> b) -> Property+producesValid f = producesValidsOnGen f genUnchecked shrinkUnchecked++-- | 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 f = producesValidsOnGen f arbitrary shrink++producesValidsOnGens2 ::+       (Show a, Show b, Show c, Validity c)+    => (a -> b -> c)+    -> Gen (a, b)+    -> ((a, b) -> [(a, b)])+    -> Property+producesValidsOnGens2 func gen s =+    forAllShrink gen s $ \(a, b) -> shouldBeValid $ func a b++producesValidsOnValids2 ::+       (Show a, Show b, Show c, GenValid a, GenValid b, Validity c)+    => (a -> b -> c)+    -> Property+producesValidsOnValids2 func = producesValidsOnGens2 func genValid shrinkValid++producesValid2 ::+       (Show a, Show b, Show c, GenUnchecked a, GenUnchecked b, Validity c)+    => (a -> b -> c)+    -> Property+producesValid2 func = producesValidsOnGens2 func genUnchecked shrinkUnchecked++producesValidsOnArbitrary2 ::+       (Show a, Show b, Show c, Arbitrary a, Arbitrary b, Validity c)+    => (a -> b -> c)+    -> Property+producesValidsOnArbitrary2 func = producesValidsOnGens2 func arbitrary shrink++producesValidsOnGens3 ::+       (Show a, Show b, Show c, Show d, Validity d)+    => (a -> b -> c -> d)+    -> Gen (a, b, c)+    -> ((a, b, c) -> [(a, b, c)])+    -> Property+producesValidsOnGens3 func gen s =+    forAllShrink gen s $ \(a, b, c) -> shouldBeValid $ func a b c++producesValidsOnValids3 ::+       ( 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 shrinkValid++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 shrinkUnchecked++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 shrink
+ src/Test/Syd/Validity/Functor.hs view
@@ -0,0 +1,173 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++-- | Functor properties+--+-- You will need @TypeApplications@ to use these.+module Test.Syd.Validity.Functor+    ( functorSpecOnValid+    , functorSpec+    , functorSpecOnArbitrary+    , functorSpecOnGens+    ) where++import Data.Data++import Data.GenValidity+import Data.Kind++import Test.Syd+import Test.QuickCheck++import Test.Syd.Validity.Functions+import Test.Syd.Validity.Utils++{-# ANN module "HLint: ignore Functor law" #-}++fmapTypeStr ::+       forall (f :: Type -> Type). (Typeable f)+    => String+fmapTypeStr =+    unwords+        [ "fmap"+        , "::"+        , "(a"+        , "->"+        , "b)"+        , "->"+        , nameOf @f+        , "a"+        , "->"+        , nameOf @f+        , "b"+        ]++flTypeStr ::+       forall (f :: Type -> Type). (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 :: Type -> Type).+       (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 :: Type -> Type).+       (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 :: Type -> Type).+       (Eq (f Int), Show (f Int), Functor f, Typeable f, Arbitrary (f Int))+    => Spec+functorSpecOnArbitrary = functorSpecWithInts @f arbitrary++functorSpecWithInts ::+       forall (f :: Type -> Type). (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 :: Type -> Type) (a :: Type) (b :: Type) (c :: Type).+       ( 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 shrinkNothing+            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+                            shrinkNothing+        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 shrinkNothing
+ src/Test/Syd/Validity/GenRelativeValidity.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Tests for GenRelativeValidity instances+--+-- You will need @TypeApplications@ to use these.+module Test.Syd.Validity.GenRelativeValidity+    ( genRelativeValiditySpec+    , genRelativeValidSpec+    , genRelativeInvalidSpec+    , genRelativeValidGeneratesValid+    , genRelativeInvalidGeneratesInvalid+    ) where++import Data.Data++import Data.GenRelativeValidity+import Data.GenValidity++import Test.Syd+import Test.QuickCheck++import Test.Syd.Validity.Property.Utils+import Test.Syd.Validity.Utils++-- | A @Spec@ that specifies that @genValidFor@ and @genInvalidFor@ work as+-- intended.+--+-- In general it is a good idea to add this spec to your test suite if you+-- write a custom implementation of @genValidFor@ or @genInvalidFor@.+--+-- Example usage:+--+-- > relativeGenValiditySpec @MyDataFor @MyOtherData+genRelativeValiditySpec ::+       forall a b.+       ( Typeable a+       , Show a+       , Show b+       , GenUnchecked b+       , GenValid b+       , GenRelativeValid a b+       , GenRelativeInvalid a b+       )+    => Spec+genRelativeValiditySpec = do+    genRelativeValidSpec @a @b+    genRelativeInvalidSpec @a @b++genRelativeValidSpec ::+       forall a b.+       ( Typeable a+       , Show a+       , Show b+       , GenValid b+       , GenRelativeValid a b+       )+    => Spec+genRelativeValidSpec =+    parallel $ do+        let nameOne = nameOf @a+        let nameTwo = nameOf @a+        describe ("GenRelativeValidity " ++ nameOne ++ " " ++ nameTwo) $+            describe ("genValidFor   :: " ++ nameTwo ++ " -> Gen " ++ nameOne) $+            it+                ("only generates valid \'" +++                 nameOne ++ "\'s for the " ++ nameTwo) $+            genRelativeValidGeneratesValid @a @b++genRelativeInvalidSpec ::+       forall a b.+       ( Typeable a+       , Show a+       , Show b+       , GenUnchecked b+       , GenRelativeInvalid a b+       )+    => Spec+genRelativeInvalidSpec =+    parallel $ do+        let nameOne = nameOf @a+        let nameTwo = nameOf @a+        describe ("GenRelativeInvalid " ++ nameOne ++ " " ++ nameTwo) $+            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@+genRelativeValidGeneratesValid ::+       forall a b.+       (Show a, Show b, GenValid b, GenRelativeValid a b)+    => Property+genRelativeValidGeneratesValid =+    forAllValid $ \(b :: b) ->+        forAll (genValidFor b) $ \(a :: a) -> a `shouldSatisfy` (`isValidFor` b)++-- | @genInvalidFor b@ only generates values that do not satisfy @isValidFor b@+genRelativeInvalidGeneratesInvalid ::+       forall a b.+       ( Show a+       , Show b+       , GenUnchecked b+       , GenRelativeInvalid a b+       )+    => Property+genRelativeInvalidGeneratesInvalid =+    forAllUnchecked $ \(b :: b) ->+        forAll (genInvalidFor b) $ \(a :: a) ->+            a `shouldNotSatisfy` (`isValidFor` b)
+ src/Test/Syd/Validity/GenValidity.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Tests for GenValidity instances+--+-- You will need @TypeApplications@ to use these.+module Test.Syd.Validity.GenValidity+    ( genValiditySpec+    , genValidSpec+    , genInvalidSpec+    , genValidGeneratesValid+    , genGeneratesValid+    , genInvalidGeneratesInvalid+    , genGeneratesInvalid+    ) where++import Data.Data++import Data.GenValidity++import Test.Syd+import Test.QuickCheck++import Test.Syd.Validity.GenValidity.Property+import Test.Syd.Validity.Utils++-- | 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@.+--+-- __It is not a good idea to use this function if invalid values are broken in such a way that 'Show' or even 'isValid' is broken.__+-- In that case you probably want 'genValidSpec'.+--+-- Example usage:+--+-- > genValiditySpec @Int+genValiditySpec ::+       forall a. (Typeable a, Show a, GenValid a, GenInvalid a)+    => Spec+genValiditySpec = do+    genValidSpec @a+    genInvalidSpec @a++-- | A @Spec@ that specifies that @genValid@ only generates valid data.+--+-- In general it is a good idea to add this spec to your test suite if you+-- write a custom implementation of @genValid@.+--+-- Example usage:+--+-- > genValidSpec @Int+genValidSpec ::+       forall a. (Typeable a, Show a, GenValid a)+    => Spec+genValidSpec =+    parallel $ do+        let name = nameOf @a+        describe ("GenValid " ++ name) $+            describe ("genValid   :: Gen " ++ name) $+            it ("only generates valid \'" ++ name ++ "\'s") $+                genValidGeneratesValid @a++-- | A @Spec@ that specifies that @genInvalid@ only generates invalid data.+--+-- Note that it is not a good idea to use this function if invalid values are broken in such a way that 'Show' or even 'isValid' is broken.+--+-- Example usage:+--+-- > genInvalidSpec @Rational+genInvalidSpec ::+       forall a. (Typeable a, Show a, GenInvalid a)+    => Spec+genInvalidSpec =+    parallel $ do+        let name = nameOf @a+        describe ("GenInvalid " ++ name) $+            describe ("genInvalid :: Gen " ++ name) $+            it ("only generates invalid \'" ++ name ++ "\'s") $+                genInvalidGeneratesInvalid @a++-- | @genValid@ only generates valid data+--+-- 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++-- | @genValid@ only generates invalid data+--+-- prop> genInvalidGeneratesInvalid @Rational+-- prop> genInvalidGeneratesInvalid @Rational+-- prop> genInvalidGeneratesInvalid @(Maybe Rational)+-- prop> genInvalidGeneratesInvalid @[Rational]+genInvalidGeneratesInvalid ::+       forall a. (Show a, GenInvalid a)+    => Property+genInvalidGeneratesInvalid = genGeneratesInvalid @a genInvalid
+ src/Test/Syd/Validity/GenValidity/Property.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Tests for GenValidity instances+module Test.Syd.Validity.GenValidity.Property+    ( genGeneratesValid+    , genGeneratesInvalid+    ) where++import Data.GenValidity++import Test.QuickCheck++import Test.Syd.Validity.Property.Utils++-- | The given generator generates only valid data points+genGeneratesValid ::+       forall a. (Show a, Validity a)+    => Gen a+    -> Property+genGeneratesValid gen = forAll gen shouldBeValid++-- | The given generator generates only invalid data points+genGeneratesInvalid ::+       forall a. (Show a, Validity a)+    => Gen a+    -> Property+genGeneratesInvalid gen = forAll gen shouldBeInvalid
+ src/Test/Syd/Validity/Monad.hs view
@@ -0,0 +1,253 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++-- | Monad properties+--+-- You will need @TypeApplications@ to use these.+module Test.Syd.Validity.Monad+    ( monadSpecOnValid+    , monadSpec+    , monadSpecOnArbitrary+    , monadSpecOnGens+    ) where++import Data.Data++import Control.Monad (ap)+import Data.Kind (Type)+import Data.GenValidity+import Test.QuickCheck.Gen (unGen)+import Test.QuickCheck.Random (mkQCGen)++import Test.Syd+import Test.QuickCheck++import Test.Syd.Validity.Functions+import Test.Syd.Validity.Utils++{-# ANN module "HLint: ignore Use fmap" #-}++{-# ANN module "HLint: ignore Use <$>" #-}++{-# ANN module "HLint: ignore Use >=>" #-}++{-# ANN module "HLint: ignore Use id" #-}++{-# ANN module "HLint: ignore Monad law, left identity" #-}++{-# ANN module "HLint: ignore Monad law, right identity" #-}++{-# ANN module "HLint: ignore Avoid lambda" #-}++{-# ANN module "HLint: ignore Reduce duplication" #-}++returnTypeStr ::+       forall (m :: Type -> Type). (Typeable m)+    => String+returnTypeStr = unwords ["return", "::", "a", "->", nameOf @m, "a"]++bindTypeStr ::+       forall (m :: Type -> Type). (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:+--+-- > monadSpecOnValid @[]+monadSpecOnValid ::+       forall (f :: Type -> Type).+       (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:+--+-- > monadSpec @[]+monadSpec ::+       forall (f :: Type -> Type).+       (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 :: Type -> Type).+       (Eq (f Int), Show (f Int), Monad f, Typeable f, Arbitrary (f Int))+    => Spec+monadSpecOnArbitrary = monadSpecWithInts @f arbitrary++monadSpecWithInts ::+       forall (f :: Type -> Type). (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 s <- genListLength+            pure $ \b -> unGen gen (mkQCGen b) s)+        "perturbations using the int"+        (do s <- genListLength+            pure $ \b -> unGen gen (mkQCGen $ 2 * b) s)+        "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 :: Type -> Type) (a :: Type) (b :: Type) (c :: Type).+       ( Show 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))+                    shrinkNothing+            it+                (unwords+                     [ "satisfy the second Monad law: 'm >>= return = m' for"+                     , genDescr @(f a) genname+                     ]) $+                equivalentOnGen (\m -> m >>= return) (\m -> m) gen shrinkNothing+        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))+                shrinkNothing+        describe (unwords ["relation with Applicative", nameOf @f]) $ do+            it+                (unwords+                     ["satisfies 'pure = return' for", genDescr @(f a) genname]) $+                equivalentOnGen (pure @f) (return @f) gena shrinkNothing+            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)+                    shrinkNothing+            it+                (unwords+                     [ "satisfies '(>>) = (*>)' for"+                     , genDescr @(f a) genname+                     , "and"+                     , genDescr @(f b) genbname+                     ]) $+                equivalentOnGens2 (>>) (*>) ((,) <$> gen <*> genb) shrinkNothing+        describe (unwords ["relation with Functor", nameOf @f]) $+            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)+                shrinkNothing
+ src/Test/Syd/Validity/Monoid.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++-- | Monoid properties+--+-- You will need @TypeApplications@ to use these.+module Test.Syd.Validity.Monoid+    ( monoidSpecOnValid+    , monoidSpec+    , monoidSpecOnArbitrary+    , monoidSpecOnGen+    ) where++import Data.Data++import Data.GenValidity++import Test.Syd+import Test.QuickCheck++import Test.Syd.Validity.Functions+import Test.Syd.Validity.Operations+import Test.Syd.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" shrinkValid++-- | 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" shrinkUnchecked++-- | 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" shrink++-- | 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+    -> (a -> [a])+    -> Spec+monoidSpecOnGen gen genname s =+    parallel $ do+        let name = nameOf @a+            memptystr = memptyTypeStr @a+            mappendstr = mappendTypeStr @a+            mconcatstr = mconcatTypeStr @a+            gen3 = (,,) <$> gen <*> gen <*> gen+            s3 (a, b, c) = (,,) <$> s a <*> s b <*> s c+            genl = genListOf gen+            sl = shrinkList s+        describe ("Monoid " ++ name) $ do+            let mem = mempty @a+                mapp = mappend @a+                mcon = mconcat @a+            describe memptystr $+                it+                    (unwords+                         [ "is the identity for"+                         , mappendstr+                         , "for"+                         , genDescr @a genname+                         ]) $+                identityOnGen mapp mem gen s+            describe mappendstr $+                it+                    (unwords+                         [ "is an associative operation for"+                         , genDescr @(a, a, a) genname+                         ]) $+                associativeOnGens mapp gen3 s3+            describe mconcatstr $+                it+                    (unwords+                         [ "is equivalent to its default implementation for"+                         , genDescr @[a] genname+                         ]) $+                equivalentOnGen mcon (foldr mapp mem) genl sl
+ src/Test/Syd/Validity/Operations.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Properties of operations+module Test.Syd.Validity.Operations+    ( leftIdentityOnElemWithEquality+    , leftIdentityOnGenWithEquality+    , leftIdentityOnGen+    , leftIdentityOnValid+    , leftIdentity+    , leftIdentityOnArbitrary+    , rightIdentityOnElemWithEquality+    , rightIdentityOnGenWithEquality+    , rightIdentityOnGen+    , rightIdentityOnValid+    , rightIdentity+    , rightIdentityOnArbitrary+    , identityOnGen+    , identityOnValid+    , identity+    , identityOnArbitrary+    , associativeOnGens+    , associativeOnValids+    , associative+    , associativeOnArbitrary+    , commutativeOnGens+    , commutativeOnValids+    , commutative+    , commutativeOnArbitrary+    ) where++import Test.Syd.Validity.Operations.Associativity+import Test.Syd.Validity.Operations.Commutativity+import Test.Syd.Validity.Operations.Identity
+ src/Test/Syd/Validity/Operations/Associativity.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Syd.Validity.Operations.Associativity+    ( associativeOnGens+    , associativeOnValids+    , associative+    , associativeOnArbitrary+    ) where++import Data.GenValidity++import Test.Syd+import Test.QuickCheck++-- |+--+-- \[+--     Associative(\star)+--     \quad\equiv\quad+--     \forall a, b, c:+--     (a \star b) \star c = a \star (b \star c)+-- \]+associativeOnGens ::+       (Show a, Eq a)+    => (a -> a -> a)+    -> Gen (a, a, a)+    -> ((a, a, a) -> [(a, a, a)])+    -> Property+associativeOnGens op gen s =+    forAllShrink gen s $ \(a, b, c) ->+        ((a `op` b) `op` c) `shouldBe` (a `op` (b `op` c))++associativeOnValids :: (Show a, Eq a, GenValid a) => (a -> a -> a) -> Property+associativeOnValids op = associativeOnGens op genValid shrinkValid++-- |+--+-- prop> associative ((*) :: Int -> Int -> Int)+-- prop> associative ((+) :: Int -> Int -> Int)+associative :: (Show a, Eq a, GenUnchecked a) => (a -> a -> a) -> Property+associative op = associativeOnGens op genUnchecked shrinkUnchecked++-- |+--+-- prop> associativeOnArbitrary ((*) :: Int -> Int -> Int)+-- prop> associativeOnArbitrary ((+) :: Int -> Int -> Int)+associativeOnArbitrary ::+       (Show a, Eq a, Arbitrary a) => (a -> a -> a) -> Property+associativeOnArbitrary op = associativeOnGens op arbitrary shrink
+ src/Test/Syd/Validity/Operations/Commutativity.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Syd.Validity.Operations.Commutativity+    ( commutativeOnGens+    , commutativeOnValids+    , commutative+    , commutativeOnArbitrary+    ) where++import Data.GenValidity++import Test.Syd+import Test.QuickCheck++-- |+--+-- \[+--     Commutative(\star)+--     \quad\equiv\quad+--     \forall a, b:+--     a \star b = b \star a+-- \]+commutativeOnGens ::+       (Show a, Show b, Eq b)+    => (a -> a -> b)+    -> Gen (a, a)+    -> ((a, a) -> [(a, a)])+    -> Property+commutativeOnGens op gen s =+    forAllShrink gen s $ \(a, b) -> (a `op` b) `shouldBe` (b `op` a)++-- |+--+-- prop> commutativeOnValids ((+) :: Rational -> Rational -> Rational)+-- prop> commutativeOnValids ((*) :: Rational -> Rational -> Rational)+commutativeOnValids ::+          (Show a, Show b, Eq b, GenValid a)+       => (a -> a -> b) -> Property+commutativeOnValids op = commutativeOnGens op genValid shrinkValid++-- |+--+-- prop> commutative ((+) :: Int -> Int -> Int)+-- prop> commutative ((*) :: Int -> Int -> Int)+commutative ::+          (Show a, Show b, Eq b, GenUnchecked a)+       => (a -> a -> b) -> Property+commutative op = commutativeOnGens op genUnchecked shrinkUnchecked++-- |+--+-- prop> commutativeOnArbitrary ((+) :: Int -> Int -> Int)+-- prop> commutativeOnArbitrary ((*) :: Int -> Int -> Int)+-- commutativeOnArbitrary ::+--        (Show a, Eq a, Arbitrary a) => (a -> a -> a) -> Property+commutativeOnArbitrary ::+          (Show a, Show b, Eq b, Arbitrary a)+       => (a -> a -> b) -> Property+commutativeOnArbitrary op = commutativeOnGens op arbitrary shrink
+ src/Test/Syd/Validity/Operations/Identity.hs view
@@ -0,0 +1,170 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Syd.Validity.Operations.Identity+    ( leftIdentityOnElemWithEquality+    , leftIdentityOnGenWithEquality+    , leftIdentityOnGen+    , leftIdentityOnValid+    , leftIdentity+    , leftIdentityOnArbitrary+    , rightIdentityOnElemWithEquality+    , rightIdentityOnGenWithEquality+    , rightIdentityOnGen+    , rightIdentityOnValid+    , rightIdentity+    , rightIdentityOnArbitrary+    , identityOnGen+    , identityOnValid+    , identity+    , identityOnArbitrary+    ) where++import Data.GenValidity++import Test.QuickCheck++-- |+--+-- \[+--   LeftIdentity(\star, \doteq, b)+--   \quad\equiv\quad+--   \forall a: (b \star a) \doteq a+-- \]+leftIdentityOnElemWithEquality ::+       (b -> a -> a) -- ^ A binary operation+    -> (a -> a -> Bool) -- ^ An equality+    -> 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+    -> (a -> a -> Bool) -- ^ An equality+    -> b -- ^ A candidate left-identity+    -> Gen a+    -> (a -> [a])+    -> Property+leftIdentityOnGenWithEquality op eq b gen s =+    forAllShrink gen s $ leftIdentityOnElemWithEquality op eq b++leftIdentityOnGen ::+       (Show a, Eq a)+    => (b -> a -> a) -- ^ A binary operation+    -> b -- ^ A candidate left-identity+    -> Gen a+    -> (a -> [a])+    -> Property+leftIdentityOnGen op = leftIdentityOnGenWithEquality op (==)++-- |+--+-- prop> leftIdentityOnValid (flip ((^) :: Rational -> Int -> Rational)) 1+leftIdentityOnValid ::+       (Show a, Eq a, GenValid a) => (b -> a -> a) -> b -> Property+leftIdentityOnValid op b = leftIdentityOnGen op b genValid shrinkValid++-- |+--+-- prop> leftIdentity (flip ((^) :: Int -> Int -> Int)) 1+leftIdentity :: (Show a, Eq a, GenUnchecked a) => (b -> a -> a) -> b -> Property+leftIdentity op b = leftIdentityOnGen op b genUnchecked shrinkUnchecked++-- |+--+-- prop> leftIdentityOnArbitrary (flip ((^) :: Int -> Int -> Int)) 1+leftIdentityOnArbitrary ::+       (Show a, Eq a, Arbitrary a) => (b -> a -> a) -> b -> Property+leftIdentityOnArbitrary op b = leftIdentityOnGen op b arbitrary shrink++-- |+--+-- \[+--   RightIdentity(\star, \doteq, b)+--   \quad\equiv\quad+--   \forall a: (a \star b) \doteq a+-- \]+rightIdentityOnElemWithEquality ::+       (a -> b -> a) -- ^ A binary operation+    -> (a -> a -> Bool) -- ^ An equality+    -> 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 -> a -> Bool) -- ^ An equality+    -> b -- ^ A candidate right-identity+    -> Gen a+    -> (a -> [a])+    -> Property+rightIdentityOnGenWithEquality op eq b gen s =+    forAllShrink gen s $ rightIdentityOnElemWithEquality op eq b++rightIdentityOnGen ::+       (Show a, Eq a)+    => (a -> b -> a) -- ^ A binary operation+    -> b -- ^ A candidate right-identity+    -> Gen a+    -> (a -> [a])+    -> Property+rightIdentityOnGen op = rightIdentityOnGenWithEquality op (==)++-- |+--+-- prop> rightIdentityOnValid ((^) :: Rational -> Int -> Rational) 1+rightIdentityOnValid ::+       (Show a, Eq a, GenValid a) => (a -> b -> a) -> b -> Property+rightIdentityOnValid op b = rightIdentityOnGen op b genValid shrinkValid++-- |+--+-- prop> rightIdentity ((^) :: Int -> Int -> Int) 1+rightIdentity ::+       (Show a, Eq a, GenUnchecked a) => (a -> b -> a) -> b -> Property+rightIdentity op b = rightIdentityOnGen op b genUnchecked shrinkUnchecked++-- |+--+-- prop> rightIdentityOnArbitrary ((^) :: Int -> Int -> Int) 1+rightIdentityOnArbitrary ::+       (Show a, Eq a, Arbitrary a) => (a -> b -> a) -> b -> Property+rightIdentityOnArbitrary op b = rightIdentityOnGen op b arbitrary shrink++-- |+--+-- \[+--   Identity(\star, \doteq, b)+--   \quad\equiv\quad+--   LeftIdentity(\star, \doteq, b) \wedge RightIdentity(\star, \doteq, b)+-- \]+identityOnGen ::+       (Show a, Eq a) => (a -> a -> a) -> a -> Gen a -> (a -> [a]) -> Property+identityOnGen op e gen s =+    leftIdentityOnGen op e gen s .&&. rightIdentityOnGen op e gen s++-- |+--+-- prop> identityOnValid ((*) :: Rational -> Rational -> Rational) 1+-- prop> identityOnValid ((+) :: Rational -> Rational -> Rational) 0+identityOnValid :: (Show a, Eq a, GenValid a) => (a -> a -> a) -> a -> Property+identityOnValid op a = identityOnGen op a genValid shrinkValid++-- |+--+-- prop> identity ((*) :: Int -> Int -> Int) 1+-- prop> identity ((+) :: Int -> Int -> Int) 0+identity :: (Show a, Eq a, GenUnchecked a) => (a -> a -> a) -> a -> Property+identity op e = identityOnGen op e genUnchecked shrinkUnchecked++-- |+--+-- prop> identityOnArbitrary ((*) :: Int -> Int -> Int) 1+-- prop> identityOnArbitrary ((+) :: Int -> Int -> Int) 0+identityOnArbitrary ::+       (Show a, Eq a, Arbitrary a) => (a -> a -> a) -> a -> Property+identityOnArbitrary op a = identityOnGen op a arbitrary shrink
+ src/Test/Syd/Validity/Ord.hs view
@@ -0,0 +1,175 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- | Ord properties+--+-- You will need @TypeApplications@ to use these.+module Test.Syd.Validity.Ord+  ( ordSpecOnGen,+    ordSpecOnValid,+    ordSpecOnInvalid,+    ordSpec,+    ordSpecOnArbitrary,+  )+where++import Data.Data+import Data.GenValidity+import Test.QuickCheck+import Test.Syd+import Test.Syd.Validity.Functions+import Test.Syd.Validity.Relations+import Test.Syd.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, GenValid a) =>+  Spec+ordSpecOnValid = ordSpecOnGen @a genValid "valid" shrinkValid++-- | Standard test spec for properties of Ord instances for invalid values+--+-- Example usage:+--+-- > ordSpecOnInvalid @Double+ordSpecOnInvalid ::+  forall a.+  (Show a, Ord a, Typeable a, GenInvalid a) =>+  Spec+ordSpecOnInvalid = ordSpecOnGen @a genInvalid "invalid" shrinkInvalid++-- | Standard test spec for properties of Ord instances for unchecked values+--+-- Example usage:+--+-- > ordSpec @Int+ordSpec ::+  forall a.+  (Show a, Ord a, Typeable a, GenUnchecked a) =>+  Spec+ordSpec = ordSpecOnGen @a genUnchecked "unchecked" shrinkUnchecked++-- | 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 "arbitrary" shrink++-- | 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, Ord a, Typeable a) =>+  Gen a ->+  String ->+  (a -> [a]) ->+  Spec+ordSpecOnGen gen genname s =+  parallel $ do+    let name = nameOf @a+        funlestr = leTypeStr @a+        fungestr = geTypeStr @a+        funltstr = ltTypeStr @a+        fungtstr = gtTypeStr @a+        minmaxtstr = genDescr @(a -> a -> a)+        itProp s_ =+          it $+            unwords+              [ s_,+                "\"" ++ genname,+                name ++ "\"" ++ "'s"+              ]+        cmple = (<=) @a+        cmpge = (>=) @a+        cmplt = (<) @a+        cmpgt = (>) @a+        gen2 = (,) <$> gen <*> gen+        gen3 = (,,) <$> gen <*> gen <*> gen+        s2 = shrinkT2 s+    describe ("Ord " ++ name) $ do+      describe funlestr $ do+        itProp "is reflexive for" $+          reflexivityOnGen cmple gen s+        itProp "is antisymmetric for" $+          antisymmetryOnGens cmple gen2 s+        itProp "is transitive for" $+          transitivityOnGens cmple gen3 s+        itProp "is equivalent to (\\a b -> compare a b /= GT) for" $+          equivalentOnGens2 cmple (\a b -> compare a b /= GT) gen2 s2+      describe fungestr $ do+        itProp "is reflexive for" $+          reflexivityOnGen cmpge gen s+        itProp "is antisymmetric for" $+          antisymmetryOnGens cmpge gen2 s+        itProp "is transitive for" $+          transitivityOnGens cmpge gen3 s+        itProp "is equivalent to (\\a b -> compare a b /= LT) for" $+          equivalentOnGens2 cmpge (\a b -> compare a b /= LT) gen2 s2+      describe funltstr $ do+        itProp "is antireflexive for" $+          antireflexivityOnGen cmplt gen s+        itProp "is transitive for" $+          transitivityOnGens cmplt gen3 s+        itProp "is equivalent to (\\a b -> compare a b == LT) for" $+          equivalentOnGens2 cmplt (\a b -> compare a b == LT) gen2 s2+      describe fungtstr $ do+        itProp "is antireflexive for" $+          antireflexivityOnGen cmpgt gen s+        itProp "is transitive for" $+          transitivityOnGens cmpgt gen3 s+        itProp "is equivalent to (\\a b -> compare a b == GT) for" $+          equivalentOnGens2 cmpgt (\a b -> compare a b == GT) gen2 s2+      describe (minmaxtstr "min") $ do+        itProp "is equivalent to (\\a b -> if a <= b then a else b) for" $+          equivalentOnGens2 min (\a b -> if a <= b then a else b) gen2 s2+      describe (minmaxtstr "max") $ do+        itProp "is equivalent to (\\a b -> if a >= b then a else b) for" $+          equivalentOnGens2 max (\a b -> if a >= b then a else b) gen2 s2
+ src/Test/Syd/Validity/Property.hs view
@@ -0,0 +1,196 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Syd.Validity.Property+    ( module Data.GenValidity+    , forAllUnchecked+    , forAllValid+    , forAllInvalid+      -- * Tests for GenValidity instances+    , genGeneratesValid+    , genGeneratesInvalid+      -- * Standard tests involving functions+      -- ** Standard tests involving validity+    , producesValidsOnGen+    , producesValidsOnValids+    , producesValid+    , producesValidsOnArbitrary+    , producesValidsOnGens2+    , producesValidsOnValids2+    , producesValid2+    , producesValidsOnArbitrary2+    , producesValidsOnGens3+    , 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+    , validIfSucceedsOnGens3+    , validIfSucceedsOnValids3+    , validIfSucceeds3+    , validIfSucceedsOnArbitrary3+      -- ** 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+    , inverseFunctions+    , inverseFunctionsOnArbitrary+    , inverseFunctionsIfFirstSucceedsOnGen+    , inverseFunctionsIfFirstSucceedsOnValid+    , inverseFunctionsIfFirstSucceeds+    , inverseFunctionsIfFirstSucceedsOnArbitrary+    , inverseFunctionsIfSecondSucceedsOnGen+    , inverseFunctionsIfSecondSucceedsOnValid+    , inverseFunctionsIfSecondSucceeds+    , inverseFunctionsIfSecondSucceedsOnArbitrary+    , inverseFunctionsIfSucceedOnGen+    , 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+    , 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+    ) where++import Data.GenValidity++import Test.Syd.Validity.Functions+import Test.Syd.Validity.GenValidity.Property+import Test.Syd.Validity.Operations+import Test.Syd.Validity.Property.Utils+import Test.Syd.Validity.Relations+import Test.Syd.Validity.Types
+ src/Test/Syd/Validity/Property/Utils.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE CPP #-}++module Test.Syd.Validity.Property.Utils+  ( forAllUnchecked,+    forAllValid,+    forAllInvalid,+    shouldBeValid,+    shouldBeInvalid,+    (<==>),+    (===>),+  )+where++import Data.GenValidity+import Test.QuickCheck+import Test.Syd++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative (pure)+#endif++forAllUnchecked ::+  (Show a, GenUnchecked a, Testable prop) => (a -> prop) -> Property+forAllUnchecked = forAllShrink genUnchecked shrinkUnchecked++forAllValid :: (Show a, GenValid a, Testable prop) => (a -> prop) -> Property+forAllValid = forAllShrink genValid shrinkValid++forAllInvalid ::+  (Show a, GenInvalid a, Testable prop) => (a -> prop) -> Property+forAllInvalid = forAllShrink genInvalid shrinkInvalid++(===>) :: Bool -> Bool -> Bool+(===>) a b = not a || b++(<==>) :: Bool -> Bool -> Bool+(<==>) a b = a ===> b && b ===> a++shouldBeValid :: (Show a, Validity a) => a -> Expectation+shouldBeValid a =+  case prettyValidate a of+    Right _ -> pure ()+    Left err ->+      expectationFailure $+        unlines+          [ "'validate' reported this value to be invalid: ",+            show a,+            "pretty version:",+            ppShow a,+            "with explanation:",+            err,+            ""+          ]++shouldBeInvalid :: (Show a, Validity a) => a -> Expectation+shouldBeInvalid a =+  case prettyValidate a of+    Right _ ->+      expectationFailure $+        unlines+          [ "'validate' reported this value to be valid: ",+            show a,+            "pretty version:",+            ppShow a,+            "where we expected it to be invalid"+          ]+    Left _ -> pure ()
+ src/Test/Syd/Validity/Relations.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Properties of relations+module Test.Syd.Validity.Relations+    ( reflexiveOnElem+    , reflexivityOnGen+    , reflexivityOnValid+    , reflexivity+    , reflexivityOnArbitrary+    , transitiveOnElems+    , transitivityOnGens+    , transitivityOnValid+    , transitivity+    , transitivityOnArbitrary+    , antisymmetricOnElemsWithEquality+    , antisymmetryOnGensWithEquality+    , antisymmetryOnGens+    , antisymmetryOnValid+    , antisymmetry+    , antisymmetryOnArbitrary+    , antireflexiveOnElem+    , antireflexivityOnGen+    , antireflexivityOnValid+    , antireflexivity+    , antireflexivityOnArbitrary+    , symmetricOnElems+    , symmetryOnGens+    , symmetryOnValid+    , symmetry+    , symmetryOnArbitrary+    ) where++import Test.Syd.Validity.Relations.Antireflexivity+import Test.Syd.Validity.Relations.Antisymmetry+import Test.Syd.Validity.Relations.Reflexivity+import Test.Syd.Validity.Relations.Symmetry+import Test.Syd.Validity.Relations.Transitivity
+ src/Test/Syd/Validity/Relations/Antireflexivity.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Syd.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 -> (a -> [a]) -> Property+antireflexivityOnGen func gen s = forAllShrink gen s $ antireflexiveOnElem func++-- |+--+-- prop> antireflexivityOnValid ((<) :: Rational -> Rational -> Bool)+-- prop> antireflexivityOnValid ((/=) :: Rational -> Rational -> Bool)+-- prop> antireflexivityOnValid ((>) :: Rational -> Rational -> Bool)+antireflexivityOnValid :: (Show a, GenValid a) => (a -> a -> Bool) -> Property+antireflexivityOnValid func = antireflexivityOnGen func genValid shrinkValid++-- |+--+-- prop> antireflexivity ((<) :: Int -> Int -> Bool)+-- prop> antireflexivity ((/=) :: Int -> Int -> Bool)+-- prop> antireflexivity ((>) :: Int -> Int -> Bool)+antireflexivity :: (Show a, GenUnchecked a) => (a -> a -> Bool) -> Property+antireflexivity func = antireflexivityOnGen func genUnchecked shrinkUnchecked++-- |+--+-- prop> antireflexivityOnArbitrary ((<) :: Int -> Int -> Bool)+-- prop> antireflexivityOnArbitrary ((/=) :: Int -> Int -> Bool)+-- prop> antireflexivityOnArbitrary ((>) :: Int -> Int -> Bool)+antireflexivityOnArbitrary ::+       (Show a, Arbitrary a) => (a -> a -> Bool) -> Property+antireflexivityOnArbitrary func = antireflexivityOnGen func arbitrary shrink
+ src/Test/Syd/Validity/Relations/Antisymmetry.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Syd.Validity.Relations.Antisymmetry+    ( antisymmetricOnElemsWithEquality+    , antisymmetryOnGensWithEquality+    , antisymmetryOnGens+    , antisymmetryOnValid+    , antisymmetry+    , antisymmetryOnArbitrary+    ) where++import Data.GenValidity++import Test.QuickCheck++import Test.Syd.Validity.Property.Utils++-- |+--+-- \[+--   Antisymmetric(\prec, \doteq)+--   \quad\equiv\quad+--   \forall a, b: ((a \prec b) \wedge (b \prec a)) \Rightarrow (a \doteq b)+-- \]+antisymmetricOnElemsWithEquality ::+       (a -> a -> Bool) -- ^ A relation+    -> (a -> a -> Bool) -- ^ An equivalence relation+    -> 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)+    -> (a -> [a])+    -> Property+antisymmetryOnGensWithEquality func gen eq s =+    forAllShrink gen (shrinkT2 s) $+    uncurry $ antisymmetricOnElemsWithEquality func eq++antisymmetryOnGens ::+       (Show a, Eq a)+    => (a -> a -> Bool)+    -> Gen (a, a)+    -> (a -> [a])+    -> Property+antisymmetryOnGens func gen = antisymmetryOnGensWithEquality func gen (==)++-- |+--+-- prop> antisymmetryOnValid ((>) :: Double -> Double -> Bool)+-- prop> antisymmetryOnValid ((>=) :: Double -> Double -> Bool)+-- prop> antisymmetryOnValid ((<=) :: Double -> Double -> Bool)+-- prop> antisymmetryOnValid ((<) :: Double -> Double -> Bool)+-- prop> antisymmetryOnValid (Data.List.isPrefixOf :: [Double] -> [Double] -> Bool)+-- prop> antisymmetryOnValid (Data.List.isSuffixOf :: [Double] -> [Double] -> Bool)+-- prop> antisymmetryOnValid (Data.List.isInfixOf :: [Double] -> [Double] -> Bool)+antisymmetryOnValid ::+       (Show a, Eq a, GenValid a) => (a -> a -> Bool) -> Property+antisymmetryOnValid func = antisymmetryOnGens func genValid shrinkValid++-- |+--+-- prop> antisymmetry ((>) :: Int -> Int -> Bool)+-- prop> antisymmetry ((>=) :: Int -> Int -> Bool)+-- prop> antisymmetry ((<=) :: Int -> Int -> Bool)+-- prop> antisymmetry ((<) :: Int -> Int -> Bool)+-- prop> antisymmetry (Data.List.isPrefixOf :: [Int] -> [Int] -> Bool)+-- prop> antisymmetry (Data.List.isSuffixOf :: [Int] -> [Int] -> Bool)+-- prop> antisymmetry (Data.List.isInfixOf :: [Int] -> [Int] -> Bool)+-- prop> antisymmetry ((\x y -> even x && odd y) :: Int -> Int -> Bool)+antisymmetry :: (Show a, Eq a, GenUnchecked a) => (a -> a -> Bool) -> Property+antisymmetry func = antisymmetryOnGens func genUnchecked shrinkUnchecked++-- |+--+-- prop> antisymmetryOnArbitrary ((>) :: Int -> Int -> Bool)+-- prop> antisymmetryOnArbitrary ((>=) :: Int -> Int -> Bool)+-- prop> antisymmetryOnArbitrary ((<=) :: Int -> Int -> Bool)+-- prop> antisymmetryOnArbitrary ((<) :: Int -> Int -> Bool)+-- prop> antisymmetryOnArbitrary (Data.List.isPrefixOf :: [Int] -> [Int] -> Bool)+-- prop> antisymmetryOnArbitrary (Data.List.isSuffixOf :: [Int] -> [Int] -> Bool)+-- prop> antisymmetryOnArbitrary (Data.List.isInfixOf :: [Int] -> [Int] -> Bool)+-- prop> antisymmetryOnArbitrary ((\x y -> even x && odd y) :: Int -> Int -> Bool)+antisymmetryOnArbitrary ::+       (Show a, Eq a, Arbitrary a) => (a -> a -> Bool) -> Property+antisymmetryOnArbitrary func = antisymmetryOnGens func arbitrary shrink
+ src/Test/Syd/Validity/Relations/Reflexivity.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Syd.Validity.Relations.Reflexivity+    ( reflexiveOnElem+    , reflexivityOnGen+    , reflexivityOnValid+    , reflexivity+    , reflexivityOnArbitrary+    ) where++import Data.GenValidity++import Test.QuickCheck++-- |+--+-- \[+--   Reflexive(\prec)+--   \quad\equiv\quad+--   \forall a: (a \prec a)+-- \]+reflexiveOnElem ::+       (a -> a -> Bool) -- ^ A relation+    -> a -- ^ An element+    -> Bool+reflexiveOnElem func a = func a a++reflexivityOnGen ::+       Show a => (a -> a -> Bool) -> Gen a -> (a -> [a]) -> Property+reflexivityOnGen func gen s = forAllShrink gen s $ reflexiveOnElem func++-- |+--+-- prop> reflexivityOnValid ((<=) :: Rational -> Rational -> Bool)+-- prop> reflexivityOnValid ((==) :: Rational -> Rational -> Bool)+-- prop> reflexivityOnValid ((>=) :: Rational -> Rational -> Bool)+-- prop> reflexivityOnValid (Data.List.isPrefixOf :: [Rational] -> [Rational] -> Bool)+-- prop> reflexivityOnValid (Data.List.isSuffixOf :: [Rational] -> [Rational] -> Bool)+-- prop> reflexivityOnValid (Data.List.isInfixOf :: [Rational] -> [Rational] -> Bool)+reflexivityOnValid :: (Show a, GenValid a) => (a -> a -> Bool) -> Property+reflexivityOnValid func = reflexivityOnGen func genValid shrinkValid++-- |+--+-- prop> reflexivity ((<=) :: Int -> Int -> Bool)+-- prop> reflexivity ((==) :: Int -> Int -> Bool)+-- prop> reflexivity ((>=) :: Int -> Int -> Bool)+-- prop> reflexivity (Data.List.isPrefixOf :: [Int] -> [Int] -> Bool)+-- prop> reflexivity (Data.List.isSuffixOf :: [Int] -> [Int] -> Bool)+-- prop> reflexivity (Data.List.isInfixOf :: [Int] -> [Int] -> Bool)+reflexivity :: (Show a, GenUnchecked a) => (a -> a -> Bool) -> Property+reflexivity func = reflexivityOnGen func genUnchecked shrinkUnchecked++-- |+--+-- prop> reflexivityOnArbitrary ((<=) :: Int -> Int -> Bool)+-- prop> reflexivityOnArbitrary ((==) :: Int -> Int -> Bool)+-- prop> reflexivityOnArbitrary ((>=) :: Int -> Int -> Bool)+-- prop> reflexivityOnArbitrary (Data.List.isPrefixOf :: [Int] -> [Int] -> Bool)+-- prop> reflexivityOnArbitrary (Data.List.isSuffixOf :: [Int] -> [Int] -> Bool)+-- prop> reflexivityOnArbitrary (Data.List.isInfixOf :: [Int] -> [Int] -> Bool)+reflexivityOnArbitrary :: (Show a, Arbitrary a) => (a -> a -> Bool) -> Property+reflexivityOnArbitrary func = reflexivityOnGen func arbitrary shrink
+ src/Test/Syd/Validity/Relations/Symmetry.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Syd.Validity.Relations.Symmetry+    ( symmetricOnElems+    , symmetryOnGens+    , symmetryOnValid+    , symmetry+    , symmetryOnArbitrary+    ) where++import Data.GenValidity++import Test.QuickCheck++import Test.Syd.Validity.Property.Utils++-- |+--+-- \[+--   Symmetric(\prec)+--   \quad\equiv\quad+--   \forall a, b: (a \prec b) \Leftrightarrow (b \prec a)+-- \]+symmetricOnElems ::+       (a -> a -> Bool) -- ^ A relation+    -> a+    -> a -- ^ Two elements+    -> Bool+symmetricOnElems func a b = func a b <==> func b a++symmetryOnGens ::+       Show a => (a -> a -> Bool) -> Gen (a, a) -> (a -> [a]) -> Property+symmetryOnGens func gen s =+    forAllShrink gen (shrinkT2 s) $ uncurry $ symmetricOnElems func++-- |+--+-- prop> symmetryOnValid ((==) :: Double -> Double -> Bool)+-- prop> symmetryOnValid ((/=) :: Double -> Double -> Bool)+symmetryOnValid :: (Show a, GenValid a) => (a -> a -> Bool) -> Property+symmetryOnValid func = symmetryOnGens func genValid shrinkValid++-- |+--+-- prop> symmetry ((==) :: Int -> Int -> Bool)+-- prop> symmetry ((/=) :: Int -> Int -> Bool)+symmetry :: (Show a, GenUnchecked a) => (a -> a -> Bool) -> Property+symmetry func = symmetryOnGens func genUnchecked shrinkUnchecked++-- |+--+-- prop> symmetryOnArbitrary ((==) :: Int -> Int -> Bool)+-- prop> symmetryOnArbitrary ((/=) :: Int -> Int -> Bool)+symmetryOnArbitrary :: (Show a, Arbitrary a) => (a -> a -> Bool) -> Property+symmetryOnArbitrary func = symmetryOnGens func arbitrary shrink
+ src/Test/Syd/Validity/Relations/Transitivity.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Syd.Validity.Relations.Transitivity+    ( transitiveOnElems+    , transitivityOnGens+    , transitivityOnValid+    , transitivity+    , transitivityOnArbitrary+    ) where++import Data.GenValidity++import Test.QuickCheck++import Test.Syd.Validity.Property.Utils++-- |+--+-- \[+--   Transitive(\prec)+--   \quad\equiv\quad+--   \forall a, b, c: ((a \prec b) \wedge (b \prec c)) \Rightarrow (a \prec c)+-- \]+transitiveOnElems ::+       (a -> a -> Bool) -- ^ A relation+    -> 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) -> (a -> [a]) -> Property+transitivityOnGens func gen s =+    forAllShrink gen (shrinkT3 s) $ \(a, b, c) -> transitiveOnElems func a b c++-- |+--+-- prop> transitivityOnValid ((>) :: Double -> Double -> Bool)+-- prop> transitivityOnValid ((>=) :: Double -> Double -> Bool)+-- prop> transitivityOnValid ((==) :: Double -> Double -> Bool)+-- prop> transitivityOnValid ((<=) :: Double -> Double -> Bool)+-- prop> transitivityOnValid ((<) :: Double -> Double -> Bool)+-- prop> transitivityOnValid (Data.List.isPrefixOf :: [Double] -> [Double] -> Bool)+-- prop> transitivityOnValid (Data.List.isSuffixOf :: [Double] -> [Double] -> Bool)+-- prop> transitivityOnValid (Data.List.isInfixOf :: [Double] -> [Double] -> Bool)+transitivityOnValid :: (Show a, GenValid a) => (a -> a -> Bool) -> Property+transitivityOnValid func = transitivityOnGens func genValid shrinkValid++-- |+--+-- prop> transitivity ((>) :: Int -> Int -> Bool)+-- prop> transitivity ((>=) :: Int -> Int -> Bool)+-- prop> transitivity ((==) :: Int -> Int -> Bool)+-- prop> transitivity ((<=) :: Int -> Int -> Bool)+-- prop> transitivity ((<) :: Int -> Int -> Bool)+-- prop> transitivity (Data.List.isPrefixOf :: [Int] -> [Int] -> Bool)+-- prop> transitivity (Data.List.isSuffixOf :: [Int] -> [Int] -> Bool)+-- prop> transitivity (Data.List.isInfixOf :: [Int] -> [Int] -> Bool)+transitivity :: (Show a, GenUnchecked a) => (a -> a -> Bool) -> Property+transitivity func = transitivityOnGens func genUnchecked shrinkUnchecked++-- |+--+-- prop> transitivityOnArbitrary ((>) :: Int -> Int -> Bool)+-- prop> transitivityOnArbitrary ((>=) :: Int -> Int -> Bool)+-- prop> transitivityOnArbitrary ((==) :: Int -> Int -> Bool)+-- prop> transitivityOnArbitrary ((<=) :: Int -> Int -> Bool)+-- prop> transitivityOnArbitrary ((<) :: Int -> Int -> Bool)+-- prop> transitivityOnArbitrary (Data.List.isPrefixOf :: [Int] -> [Int] -> Bool)+-- prop> transitivityOnArbitrary (Data.List.isSuffixOf :: [Int] -> [Int] -> Bool)+-- prop> transitivityOnArbitrary (Data.List.isInfixOf :: [Int] -> [Int] -> Bool)+transitivityOnArbitrary :: (Show a, Arbitrary a) => (a -> a -> Bool) -> Property+transitivityOnArbitrary func = transitivityOnGens func arbitrary shrink
+ src/Test/Syd/Validity/RelativeValidity.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Tests for RelativeValidity instances+--+-- You will need @TypeApplications@ to use these.+module Test.Syd.Validity.RelativeValidity+    ( relativeValiditySpec+    , relativeValidityImpliesValidA+    , relativeValidityImpliesValidB+    ) where++import Data.Data++import Data.GenRelativeValidity+import Data.GenValidity++import Test.Syd+import Test.QuickCheck++import Test.Syd.Validity.Property.Utils+import Test.Syd.Validity.Utils++-- | A @Spec@ that specifies that @isValidFor@ implies @isValid@+--+-- In general it is a good idea to add this spec to your test suite if+-- the @a@ and @b@ in @RelativeValidity a b@ also have a @Validity@ instance.+--+-- Example usage:+--+-- > relativeValiditySpec @MyDataFor @MyOtherData+relativeValiditySpec ::+       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 ::+       forall a b.+       ( Show a+       , Show b+       , Validity a+       , GenUnchecked a+       , GenUnchecked b+       , RelativeValidity a b+       )+    => Property+relativeValidityImpliesValidA =+    forAllUnchecked $ \(a :: a) ->+        forAllUnchecked $ \(b :: b) -> (a `isValidFor` b) ===> isValid a++-- | @isValidFor a b@ implies @isValid b@ for all @a@+relativeValidityImpliesValidB ::+       forall a b.+       ( Show a+       , Show b+       , Validity b+       , GenUnchecked a+       , GenUnchecked b+       , RelativeValidity a b+       )+    => Property+relativeValidityImpliesValidB =+    forAllUnchecked $ \(a :: a) ->+        forAllUnchecked $ \(b :: b) -> (a `isValidFor` b) ===> isValid b
+ src/Test/Syd/Validity/Show.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- | 'Show' and 'Read' properties+module Test.Syd.Validity.Show+    ( showReadSpecOnValid+    , showReadSpec+    , showReadSpecOnArbitrary+    , showReadSpecOnGen+    , showReadRoundTripOnValid+    , showReadRoundTrip+    , showReadRoundTripOnArbitrary+    , showReadRoundTripOnGen+    ) where++import Data.GenValidity++import Data.Data++import Text.Read++import Test.Syd+import Test.QuickCheck++import Test.Syd.Validity.Utils++-- | Standard test spec for properties of Show and Read instances for valid values+--+-- Example usage:+--+-- > showReadSpecOnValid @Double+showReadSpecOnValid ::+       forall a. (Show a, Eq a, Read a, Typeable a, GenValid a)+    => Spec+showReadSpecOnValid = showReadSpecOnGen @a genValid "valid" shrinkValid++-- | Standard test spec for properties of Show and Read instances for unchecked values+--+-- Example usage:+--+-- > showReadSpec @Int+showReadSpec ::+       forall a. (Show a, Eq a, Read a, Typeable a, GenUnchecked a)+    => Spec+showReadSpec = showReadSpecOnGen @a genUnchecked "unchecked" shrinkUnchecked+++-- | Standard test spec for properties of Show and Read instances for arbitrary values+--+-- Example usage:+--+-- > showReadSpecOnArbitrary @Double+showReadSpecOnArbitrary ::+       forall a. (Show a, Eq a, Read a, Typeable a, Arbitrary a)+    => Spec+showReadSpecOnArbitrary = showReadSpecOnGen @a arbitrary "arbitrary" shrink++-- | Standard test spec for properties of Show and Read instances for values generated by a custom generator+--+-- Example usage:+--+-- > showReadSpecOnGen ((* 2) <$> genValid @Int) "even" (const [])+showReadSpecOnGen ::+       forall a. (Show a, Eq a, Read a, Typeable a)+    => Gen a+    -> String+    -> (a -> [a])+    -> Spec+showReadSpecOnGen gen n s =+    describe (unwords ["Show", nameOf @a, "and Read", nameOf @a]) $+    it (unwords ["are implemented such that read . show == id for", n, "values"]) $+    showReadRoundTripOnGen gen s++-- |+--+-- prop> showReadRoundTripOnValid @Rational+showReadRoundTripOnValid ::+       forall a. (Show a, Eq a, Read a, GenValid a)+    => Property+showReadRoundTripOnValid =+    showReadRoundTripOnGen (genValid :: Gen a) shrinkValid++-- |+--+-- prop> showReadRoundTrip @Int+showReadRoundTrip ::+       forall a. (Show a, Eq a, Read a, GenUnchecked a)+    => Property+showReadRoundTrip =+    showReadRoundTripOnGen (genUnchecked :: Gen a) shrinkUnchecked++-- |+--+-- prop> showReadRoundTripOnArbitrary @Double+showReadRoundTripOnArbitrary ::+       forall a. (Show a, Eq a, Read a, Arbitrary a)+    => Property+showReadRoundTripOnArbitrary =+    showReadRoundTripOnGen (arbitrary :: Gen a) shrink++-- |+--+-- prop> showReadRoundTripOnGen (abs <$> genUnchecked :: Gen Int) (const [])+showReadRoundTripOnGen ::+       (Show a, Eq a, Read a) => Gen a -> (a -> [a]) -> Property+showReadRoundTripOnGen gen s =+    forAllShrink gen s $ \v -> readMaybe (show v) `shouldBe` Just v
+ src/Test/Syd/Validity/Shrinking.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Tests for Shrinking functions+--+-- You will need @TypeApplications@ to use these.+module Test.Syd.Validity.Shrinking+    ( shrinkValiditySpec+    , shrinkValidSpec+    , shrinkValidSpecWithLimit+    , shrinkInvalidSpec+    , shrinkValidPreservesValidOnGenValid+    , shrinkValidPreservesValidOnGenValidWithLimit+    , shrinkInvalidPreservesInvalidOnGenInvalid+    , shrinkPreservesValidOnGenValid+    , shrinkPreservesInvalidOnGenInvalid+    , shrinkValidPreservesValid+    , shrinkInvalidPreservesInvalid+    , shrinkingStaysValid+    , shrinkingStaysInvalid+    , shrinkingPreserves+    , shrinkUncheckedDoesNotShrinkToItself+    , shrinkUncheckedDoesNotShrinkToItselfWithLimit+    , shrinkValidDoesNotShrinkToItself+    , shrinkValidDoesNotShrinkToItselfWithLimit+    , shrinkInvalidDoesNotShrinkToItself+    , shrinkInvalidDoesNotShrinkToItselfWithLimit+    ) where++import Data.Data++import Data.GenValidity++import Control.Monad++import Test.Syd+import Test.QuickCheck++import Test.Syd.Validity.Shrinking.Property+import Test.Syd.Validity.Utils++shrinkValiditySpec ::+       forall a. (Show a, Eq a, Typeable a, GenValid a, GenInvalid a)+    => Spec+shrinkValiditySpec = do+    shrinkValidSpec @a+    shrinkInvalidSpec @a++shrinkValidSpec ::+       forall a. (Show a, Eq a, Typeable a, GenValid a)+    => Spec+shrinkValidSpec =+    describe ("shrinkValid :: " ++ nameOf @(a -> [a])) $ do+        it "preserves validity" $+            forAll (genValid @a) $ \a -> forM_ (shrinkValid a) shouldBeValid+        it "never shrinks to itself for valid values" $+            shrinkValidDoesNotShrinkToItself @a++shrinkValidSpecWithLimit ::+       forall a. (Show a, Eq a, Typeable a, GenValid a)+    => Int+    -> Spec+shrinkValidSpecWithLimit l =+    describe ("shrinkValid :: " ++ nameOf @(a -> [a])) $ do+        it (unwords ["preserves validity for the first", show l, "elements"]) $+            forAll (genValid @a) $ \a ->+                forM_ (take l $ shrinkValid a) shouldBeValid+        it+            (unwords+                 [ "never shrinks to itself for valid values for the first"+                 , show l+                 , "elements"+                 ]) $+            shrinkValidDoesNotShrinkToItselfWithLimit @a l++shrinkInvalidSpec ::+       forall a. (Show a, Typeable a, GenInvalid a)+    => Spec+shrinkInvalidSpec =+    describe ("shrinkInvalid :: " ++ nameOf @(a -> [a])) $ do+        it "preserves invalidity" $+            forAll (genInvalid @a) $ \a ->+                forM_ (shrinkInvalid a) shouldBeInvalid++shrinkValidPreservesValidOnGenValid ::+       forall a. (Show a, GenValid a)+    => Property+shrinkValidPreservesValidOnGenValid =+    shrinkingStaysValid @a genValid shrinkValid++shrinkValidPreservesValidOnGenValidWithLimit ::+       forall a. (Show a, GenValid a)+    => Int+    -> Property+shrinkValidPreservesValidOnGenValidWithLimit =+    shrinkingStaysValidWithLimit @a genValid shrinkValid++shrinkInvalidPreservesInvalidOnGenInvalid ::+       forall a. (Show a, GenInvalid a)+    => Property+shrinkInvalidPreservesInvalidOnGenInvalid =+    shrinkingStaysInvalid @a genInvalid shrinkInvalid++shrinkUncheckedDoesNotShrinkToItself ::+       forall a. (Show a, Eq a, GenUnchecked a)+    => Property+shrinkUncheckedDoesNotShrinkToItself =+    shrinkDoesNotShrinkToItself @a shrinkUnchecked++shrinkValidDoesNotShrinkToItself ::+       forall a. (Show a, Eq a, GenValid a)+    => Property+shrinkValidDoesNotShrinkToItself =+    shrinkDoesNotShrinkToItselfOnValid @a shrinkValid++shrinkInvalidDoesNotShrinkToItself ::+       forall a. (Show a, Eq a, GenInvalid a)+    => Property+shrinkInvalidDoesNotShrinkToItself =+    shrinkDoesNotShrinkToItselfOnInvalid @a shrinkInvalid++shrinkInvalidDoesNotShrinkToItselfWithLimit ::+       forall a. (Show a, Eq a, GenInvalid a)+    => Int+    -> Property+shrinkInvalidDoesNotShrinkToItselfWithLimit =+    shrinkDoesNotShrinkToItselfOnInvalidWithLimit @a shrinkInvalid++shrinkValidDoesNotShrinkToItselfWithLimit ::+       forall a. (Show a, Eq a, GenValid a)+    => Int+    -> Property+shrinkValidDoesNotShrinkToItselfWithLimit =+    shrinkDoesNotShrinkToItselfOnValidWithLimit @a shrinkValid++shrinkUncheckedDoesNotShrinkToItselfWithLimit ::+       forall a. (Show a, Eq a, GenUnchecked a)+    => Int+    -> Property+shrinkUncheckedDoesNotShrinkToItselfWithLimit =+    shrinkDoesNotShrinkToItselfWithLimit @a shrinkUnchecked
+ src/Test/Syd/Validity/Shrinking/Property.hs view
@@ -0,0 +1,201 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Tests for shrinking functions+module Test.Syd.Validity.Shrinking.Property+    ( shrinkPreservesValidOnGenValid+    , shrinkPreservesInvalidOnGenInvalid+    , shrinkValidPreservesValid+    , shrinkInvalidPreservesInvalid+    , shrinkingStaysValid+    , shrinkingStaysValidWithLimit+    , shrinkingStaysInvalid+    , shrinkingPreserves+    , shrinkingPreservesWithLimit+    , shrinkDoesNotShrinkToItself+    , shrinkDoesNotShrinkToItselfWithLimit+    , shrinkDoesNotShrinkToItselfOnValid+    , shrinkDoesNotShrinkToItselfOnValidWithLimit+    , shrinkDoesNotShrinkToItselfOnInvalid+    , shrinkDoesNotShrinkToItselfOnInvalidWithLimit+    , doesNotShrinkToItself+    , doesNotShrinkToItselfWithLimit+    ) where++import Data.GenValidity++import Test.QuickCheck++-- |+--+-- prop> shrinkPreservesValidOnGenValid ((:[]) :: Int -> [Int])+shrinkPreservesValidOnGenValid ::+       forall a. (Show a, GenValid a)+    => (a -> [a])+    -> Property+shrinkPreservesValidOnGenValid = shrinkingStaysValid genValid++-- |+--+-- prop> shrinkPreservesInvalidOnGenInvalid ((:[]) :: Rational -> [Rational])+shrinkPreservesInvalidOnGenInvalid ::+       forall a. (Show a, GenInvalid a)+    => (a -> [a])+    -> Property+shrinkPreservesInvalidOnGenInvalid = shrinkingStaysValid genInvalid++-- |+--+-- prop> shrinkValidPreservesValid (pure 5 :: Gen Rational)+shrinkValidPreservesValid ::+       forall a. (Show a, GenValid a)+    => Gen a+    -> Property+shrinkValidPreservesValid gen = shrinkingStaysValid gen shrinkValid++-- |+--+shrinkInvalidPreservesInvalid ::+       forall a. (Show a, GenInvalid a)+    => Gen a+    -> Property+shrinkInvalidPreservesInvalid gen = shrinkingStaysValid gen shrinkInvalid++-- |+--+-- prop> shrinkingStaysValid (pure 5 :: Gen Double) (\d -> [d - 1, d - 2])+shrinkingStaysValid ::+       forall a. (Show a, Validity a)+    => Gen a+    -> (a -> [a])+    -> Property+shrinkingStaysValid gen s = shrinkingPreserves gen s isValid++-- |+--+-- prop> shrinkingStaysValidWithLimit (pure 5 :: Gen Double) (\d -> [d - 1, read "NaN"]) 1+shrinkingStaysValidWithLimit ::+       forall a. (Show a, Validity a)+    => Gen a+    -> (a -> [a])+    -> Int+    -> Property+shrinkingStaysValidWithLimit gen s l =+    shrinkingPreservesWithLimit gen s l isValid++-- |+--+-- prop> shrinkingStaysInvalid (pure (1/0) :: Gen Double) (:[])+shrinkingStaysInvalid ::+       forall a. (Show a, Validity a)+    => Gen a+    -> (a -> [a])+    -> Property+shrinkingStaysInvalid gen s = shrinkingPreserves gen s isInvalid++-- |+--+-- prop> shrinkingPreserves (pure 5 :: Gen Int) (:[]) (== 5)+shrinkingPreserves ::+       forall a. Show a+    => Gen a+    -> (a -> [a])+    -> (a -> Bool)+    -> Property+shrinkingPreserves gen s p = forAll gen $ \d -> not (p d) || all p (s d)++-- |+--+-- prop> shrinkingPreservesWithLimit (pure 4) (:[]) 100 (== 4)+shrinkingPreservesWithLimit ::+       forall a. Show a+    => Gen a+    -> (a -> [a])+    -> Int+    -> (a -> Bool)+    -> Property+shrinkingPreservesWithLimit gen s l p =+    forAll gen $ \d -> not (p d) || all p (take l $ s d)++-- |+--+-- prop> shrinkDoesNotShrinkToItself (shrinkUnchecked :: Double -> [Double])+shrinkDoesNotShrinkToItself ::+       forall a. (Show a, Eq a, GenUnchecked a)+    => (a -> [a])+    -> Property+shrinkDoesNotShrinkToItself = doesNotShrinkToItself genUnchecked++-- |+--+-- prop> shrinkDoesNotShrinkToItselfWithLimit (shrinkUnchecked :: Double -> [Double]) 100+shrinkDoesNotShrinkToItselfWithLimit ::+       forall a. (Show a, Eq a, GenUnchecked a)+    => (a -> [a])+    -> Int+    -> Property+shrinkDoesNotShrinkToItselfWithLimit =+    doesNotShrinkToItselfWithLimit genUnchecked++-- |+--+-- prop> shrinkDoesNotShrinkToItselfOnValid (shrinkValid ::  Rational -> [Rational])+shrinkDoesNotShrinkToItselfOnValid ::+       forall a. (Show a, Eq a, GenValid a)+    => (a -> [a])+    -> Property+shrinkDoesNotShrinkToItselfOnValid = doesNotShrinkToItself genValid++-- |+--+-- prop> shrinkDoesNotShrinkToItselfOnValidWithLimit (shrinkValid :: Rational -> [Rational]) 100+shrinkDoesNotShrinkToItselfOnValidWithLimit ::+       forall a. (Show a, Eq a, GenValid a)+    => (a -> [a])+    -> Int+    -> Property+shrinkDoesNotShrinkToItselfOnValidWithLimit =+    doesNotShrinkToItselfWithLimit genValid++-- |+--+-- prop> shrinkDoesNotShrinkToItselfOnInvalid (shrinkInvalid :: Rational -> [Rational])+shrinkDoesNotShrinkToItselfOnInvalid ::+       forall a. (Show a, Eq a, GenInvalid a)+    => (a -> [a])+    -> Property+shrinkDoesNotShrinkToItselfOnInvalid = doesNotShrinkToItself genInvalid++-- |+--+-- prop> shrinkDoesNotShrinkToItselfOnInvalidWithLimit (shrinkInvalid :: Rational -> [Rational]) 100+shrinkDoesNotShrinkToItselfOnInvalidWithLimit ::+       forall a. (Show a, Eq a, GenInvalid a)+    => (a -> [a])+    -> Int+    -> Property+shrinkDoesNotShrinkToItselfOnInvalidWithLimit =+    doesNotShrinkToItselfWithLimit genInvalid++-- |+--+-- prop> doesNotShrinkToItself (pure 5 :: Gen Double) shrinkUnchecked+doesNotShrinkToItself ::+       forall a. (Show a, Eq a)+    => Gen a+    -> (a -> [a])+    -> Property+doesNotShrinkToItself gen s = forAll gen $ \a -> all (/= a) $ s a++-- |+--+-- prop> doesNotShrinkToItselfWithLimit (pure 5 :: Gen Double) shrinkUnchecked 100+doesNotShrinkToItselfWithLimit ::+       forall a. (Show a, Eq a)+    => Gen a+    -> (a -> [a])+    -> Int+    -> Property+doesNotShrinkToItselfWithLimit gen s l =+    forAll gen $ \a -> all (/= a) $ take l $ s a
+ src/Test/Syd/Validity/Types.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Syd.Validity.Types+    ( CanFail(..)+    ) where++-- | A class of types that are the result of functions that can fail+class CanFail f where+    hasFailed :: f a -> Bool+    resultIfSucceeded :: f a -> Maybe a++instance CanFail Maybe where+    hasFailed Nothing = True+    hasFailed _ = False+    resultIfSucceeded Nothing = Nothing+    resultIfSucceeded (Just r) = Just r++instance CanFail (Either e) where+    hasFailed (Left _) = True+    hasFailed _ = False+    resultIfSucceeded (Left _) = Nothing+    resultIfSucceeded (Right r) = Just r
+ src/Test/Syd/Validity/Utils.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- | Utilities for defining your own validity 'Spec's+--+-- You will need @TypeApplications@ to use these.+module Test.Syd.Validity.Utils+  ( nameOf,+    genDescr,+    binRelStr,+    shouldBeValid,+    shouldBeInvalid,+    Anon (..),+  )+where++import Data.Data+import Test.Syd.Validity.Property.Utils++nameOf ::+  forall a.+  Typeable a =>+  String+nameOf =+  let s = show $ typeRep (Proxy @a)+   in if ' ' `elem` s+        then "(" ++ s ++ ")"+        else s++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++newtype Anon a+  = Anon a++instance Show (Anon a) where+  show _ = "Anonymous"++instance Functor Anon where+  fmap f (Anon a) = Anon (f a)
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF sydtest-discover #-}
+ test/Test/Syd/Validity/ApplicativeSpec.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE TypeApplications #-}++module Test.Syd.Validity.ApplicativeSpec where++import Test.Syd++import Data.GenValidity+import Test.Syd.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"
+ test/Test/Syd/Validity/ArbitrarySpec.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE TypeApplications #-}++module Test.Syd.Validity.ArbitrarySpec where++import Test.Syd++import Test.Syd.Validity.Arbitrary++spec :: Spec+spec = arbitrarySpec @Int
+ test/Test/Syd/Validity/EqSpec.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE TypeApplications #-}++-- | Standard 'Spec's for 'Eq' instances.+--+-- You will need @TypeApplications@ to use these.+module Test.Syd.Validity.EqSpec where++import Data.GenValidity+import Test.Syd+import Test.Syd.Validity.Eq++spec :: Spec+spec = do+  eqSpecOnValid @Rational+  eqSpec @Int+  -- eqSpec @Double DOES NOT HOLD because of NaN+  eqSpecOnArbitrary @Int+  eqSpecOnGen ((* 2) <$> genValid @Int) "even" (const [])
+ test/Test/Syd/Validity/FunctorSpec.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE TypeApplications #-}++module Test.Syd.Validity.FunctorSpec where++import Data.GenValidity+import Test.Syd+import Test.Syd.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"
+ test/Test/Syd/Validity/GenRelativeValiditySpec.hs view
@@ -0,0 +1,7 @@+module Test.Syd.Validity.GenRelativeValiditySpec where++import Test.Syd++-- import Test.Syd.Validity.GenRelativeValidity+spec :: Spec+spec = pure () -- TODO add examples once we have some instances
+ test/Test/Syd/Validity/GenValiditySpec.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE TypeApplications #-}++module Test.Syd.Validity.GenValiditySpec where++import Test.Syd++import Test.Syd.Validity.GenValidity++spec :: Spec+spec = do+    genValiditySpec @Rational+    genValidSpec @Rational+    genInvalidSpec @Rational
+ test/Test/Syd/Validity/MonadSpec.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE TypeApplications #-}++module Test.Syd.Validity.MonadSpec where++import Test.Syd++import Data.GenValidity+import Test.Syd.Validity.Monad++{-# ANN module "HLint: ignore Use :" #-}++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"
+ test/Test/Syd/Validity/MonoidSpec.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE TypeApplications #-}++module Test.Syd.Validity.MonoidSpec where++import Test.Syd++import Test.Syd.Validity.Monoid++spec :: Spec+spec = do+    monoidSpecOnValid @[Rational]+    monoidSpec @[Int]+    monoidSpecOnArbitrary @[Int]+    monoidSpecOnGen (pure "a") "singleton list of 'a'" (const [])
+ test/Test/Syd/Validity/Operations/CommutativitySpec.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE TypeApplications #-}++module Test.Syd.Validity.Operations.CommutativitySpec+    ( spec+    ) where++import Test.Syd+import Test.QuickCheck+import Data.GenValidity (GenUnchecked)++import Test.Syd.Validity.Operations.Commutativity (commutative)++spec :: Spec+spec = do+  describe "commutative" $ do+    specify "+ is commutative" $ commutative @Int (+)+    specify "* is commutative" $ commutative @Int (*)+    specify "dot product is commutative" $ commutative dotProduct++    specify "- is not commutative" $ notCommmutative @Int (-)+    specify "cross product is not commutative" $ notCommmutative crossProduct++notCommmutative :: (Show a, Show b, Eq b, GenUnchecked a) => (a -> a -> b) -> Property+notCommmutative op = expectFailure (commutative op)++type Point = (Int, Int)++dotProduct :: Point -> Point -> Int+dotProduct (x1, y1) (x2, y2) = x1 * x2 + y1 * y2++crossProduct :: Point -> Point -> Int+crossProduct (x1, y1) (x2, y2) = x1 * y2 - x2 * y1
+ test/Test/Syd/Validity/OrdSpec.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE TypeApplications #-}++module Test.Syd.Validity.OrdSpec where++import Data.GenValidity+import Test.Syd+import Test.Syd.Validity.Ord++spec :: Spec+spec = do+  ordSpecOnValid @Rational+  ordSpec @Int+  ordSpecOnArbitrary @Int+  ordSpecOnGen ((* 2) <$> genValid @Int) "even" (const [])
+ test/Test/Syd/Validity/RelativeValiditySpec.hs view
@@ -0,0 +1,7 @@+module Test.Syd.Validity.RelativeValiditySpec where++import Test.Syd++-- import Test.Syd.Validity.RelativeValidity+spec :: Spec+spec = pure ()
+ test/Test/Syd/Validity/ShowSpec.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE TypeApplications #-}++-- | Standard 'Spec's for 'Show' and 'Read' instances.+--+-- You will need @TypeApplications@ to use these.+module Test.Syd.Validity.ShowSpec where++import Data.GenValidity+import Test.Syd+import Test.Syd.Validity.Show++spec :: Spec+spec = do+  showReadSpecOnValid @Rational+  showReadSpec @Int+  showReadSpecOnArbitrary @Rational+  showReadSpecOnGen ((* 2) <$> genValid @Int) "even" (const [])
+ test/Test/Syd/Validity/ShrinkingSpec.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE TypeApplications #-}++module Test.Syd.Validity.ShrinkingSpec where++import Data.Int+import Data.Ratio+import Test.Syd+import Test.Syd.Validity.Shrinking++spec :: Spec+spec = do+  shrinkValiditySpec @(Ratio Int8)+  shrinkValidSpec @Int+  shrinkInvalidSpec @(Ratio Int8)+  describe "shrinkUncheckedPreservesValidOnGenValid" $ do+    it "Ordering" $ shrinkValidPreservesValidOnGenValid @Ordering+    it "[Ordering]" $ shrinkValidPreservesValidOnGenValid @[Ordering]+  describe "shrinkValidPreservesValidOnGenValid" $ do+    it "Ordering" $ shrinkValidPreservesValidOnGenValid @Ordering+    it "[Ordering]" $ shrinkValidPreservesValidOnGenValid @[Ordering]+  describe "shrinkInvalidPreservesInvalidOnGenInvalid" $ do+    it "Ratio Int8" $ shrinkInvalidPreservesInvalidOnGenInvalid @(Ratio Int8)+  describe "shrinkUncheckedDoesNotShrinkToItself" $ do+    it "Int" $ shrinkUncheckedDoesNotShrinkToItself @Int+    it "[Int]" $ shrinkUncheckedDoesNotShrinkToItself @[Int]+  describe "shrinkValidDoesNotShrinkToItself" $ do+    it "Ordering" $ shrinkValidDoesNotShrinkToItself @Ordering+    it "[Ordering]" $ shrinkValidDoesNotShrinkToItself @[Ordering]