packages feed

genvalidity-sydtest 0.0.0.0 → 1.0.0.0

raw patch · 50 files changed

+2089/−2968 lines, 50 filesdep ~genvaliditysetup-changed

Dependency ranges changed: genvalidity

Files

+ CHANGELOG.md view
@@ -0,0 +1,11 @@+# Changelog++## [1.0.0.0] - 2021-11-20++* Compatibility with `genvalidity >= 1.0.0.0`+* Renamed every combinator that ends in `OnValid` (or similar) to not have that suffix anymore.++### Removed++* Every combinator that relates to unchecked or invalid values.+
LICENSE view
@@ -1,6 +1,6 @@ The MIT License (MIT) -Copyright (c) 2016-2020 Tom Sydney Kerckhove+Copyright (c) 2016-2021 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
− Setup.hs 
@@ -1,3 +0,0 @@-import Distribution.Simple--main = defaultMain
genvalidity-sydtest.cabal view
@@ -5,17 +5,20 @@ -- see: https://github.com/sol/hpack  name:           genvalidity-sydtest-version:        0.0.0.0+version:        1.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+copyright:      Copyright: (c) 2016-2021 Tom Sydney Kerckhove license:        MIT license-file:   LICENSE build-type:     Simple+extra-source-files:+    LICENSE+    CHANGELOG.md  source-repository head   type: git@@ -34,7 +37,6 @@       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@@ -52,7 +54,6 @@       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@@ -66,7 +67,7 @@   build-depends:       QuickCheck     , base >=4.7 && <5-    , genvalidity >=0.7+    , genvalidity >=1.0     , pretty-show     , sydtest     , validity >=0.9
src/Test/Syd/Validity.hs view
@@ -7,283 +7,262 @@ -- The most interesting functions in this module for most uses are: -- -- * 'genValidSpec'--- * 'eqSpecOnValid'--- * 'ordSpecOnValid'--- * 'producesValidsOnValids'+-- * 'eqSpec'+-- * 'ordSpec'+-- * 'producesValid' -- * '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+  ( -- * Writing properties -import Data.GenValidity+    -- ** Cheap generation with shrinking+    forAllValid, +    -- ** Cheap assertions+    shouldBeValid,+    shouldBeInvalid,++    -- * Tests for GenValidity instances+    genValidSpec,+    genValidGeneratesValid,+    genGeneratesValid,+    shrinkValidSpec,+    shrinkValidSpecWithLimit,+    shrinkValidPreservesValidOnGenValid,+    shrinkPreservesValidOnGenValid,+    shrinkValidPreservesValid,+    shrinkingStaysValid,+    shrinkingPreserves,++    -- * Tests for Arbitrary instances involving Validity+    arbitrarySpec,+    arbitraryGeneratesOnlyValid,++    -- * Standard tests involving functions++    -- ** Standard tests involving validity+    producesValidsOnGen,+    producesValid,+    producesValidsOnArbitrary,+    producesValidsOnGens2,+    producesValid2,+    producesValidsOnArbitrary2,+    producesValidsOnGens3,+    producesValid3,+    producesValidsOnArbitrary3,++    -- ** Standard tests involving functions that can fail+    CanFail (..),+    succeedsOnGen,+    succeeds,+    succeedsOnArbitrary,+    succeedsOnGens2,+    succeeds2,+    succeedsOnArbitrary2,+    failsOnGen,+    failsOnGens2,+    validIfSucceedsOnGen,+    validIfSucceedsOnArbitrary,+    validIfSucceeds,+    validIfSucceedsOnGens2,+    validIfSucceeds2,+    validIfSucceedsOnArbitrary2,+    validIfSucceedsOnGens3,+    validIfSucceeds3,+    validIfSucceedsOnArbitrary3,++    -- ** Standard tests involving equivalence of functions++    -- *** Simple functions++    -- **** One argument+    equivalentOnGen,+    equivalent,+    equivalentOnArbitrary,++    -- **** Two arguments+    equivalentOnGens2,+    equivalent2,+    equivalentOnArbitrary2,++    -- **** Three arguments+    equivalentOnGens3,+    equivalent3,+    equivalentOnArbitrary3,++    -- *** First function can fail++    -- **** One argument+    equivalentWhenFirstSucceedsOnGen,+    equivalentWhenFirstSucceeds,+    equivalentWhenFirstSucceedsOnArbitrary,++    -- **** Two arguments+    equivalentWhenFirstSucceedsOnGens2,+    equivalentWhenFirstSucceeds2,+    equivalentWhenFirstSucceedsOnArbitrary2,++    -- *** Second function can fail++    -- **** One argument+    equivalentWhenSecondSucceedsOnGen,+    equivalentWhenSecondSucceeds,+    equivalentWhenSecondSucceedsOnArbitrary,++    -- **** Two arguments+    equivalentWhenSecondSucceedsOnGens2,+    equivalentWhenSecondSucceeds2,+    equivalentWhenSecondSucceedsOnArbitrary2,++    -- *** Both functions can fail++    -- **** One argument+    equivalentWhenSucceedOnGen,+    equivalentWhenSucceed,+    equivalentWhenSucceedOnArbitrary,++    -- **** Two arguments+    equivalentWhenSucceedOnGens2,+    equivalentWhenSucceed2,+    equivalentWhenSucceedOnArbitrary2,++    -- ** Standard tests involving inverse functions+    inverseFunctionsOnGen,+    inverseFunctions,+    inverseFunctionsOnArbitrary,+    inverseFunctionsIfFirstSucceedsOnGen,+    inverseFunctionsIfFirstSucceeds,+    inverseFunctionsIfFirstSucceedsOnArbitrary,+    inverseFunctionsIfSecondSucceedsOnGen,+    inverseFunctionsIfSecondSucceeds,+    inverseFunctionsIfSecondSucceedsOnArbitrary,+    inverseFunctionsIfSucceedOnGen,+    inverseFunctionsIfSucceed,+    inverseFunctionsIfSucceedOnArbitrary,++    -- ** Properties involving idempotence+    idempotentOnGen,+    idempotent,+    idempotentOnArbitrary,++    -- * Properties of relations++    -- ** Reflexivity+    reflexiveOnElem,+    reflexivityOnGen,+    reflexivity,+    reflexivityOnArbitrary,++    -- ** Transitivity+    transitiveOnElems,+    transitivityOnGens,+    transitivity,+    transitivityOnArbitrary,++    -- ** Antisymmetry+    antisymmetricOnElemsWithEquality,+    antisymmetryOnGensWithEquality,+    antisymmetryOnGens,+    antisymmetry,+    antisymmetryOnArbitrary,++    -- ** Antireflexivity+    antireflexiveOnElem,+    antireflexivityOnGen,+    antireflexivity,+    antireflexivityOnArbitrary,++    -- ** Symmetry+    symmetricOnElems,+    symmetryOnGens,+    symmetry,+    symmetryOnArbitrary,++    -- * Properties of operations++    -- ** Identity element++    -- *** Left Identity+    leftIdentityOnElemWithEquality,+    leftIdentityOnGenWithEquality,+    leftIdentityOnGen,+    leftIdentity,+    leftIdentityOnArbitrary,++    -- *** Right Identity+    rightIdentityOnElemWithEquality,+    rightIdentityOnGenWithEquality,+    rightIdentityOnGen,+    rightIdentity,+    rightIdentityOnArbitrary,++    -- *** Identity+    identityOnGen,+    identity,+    identityOnArbitrary,++    -- ** Associativity+    associativeOnGens,+    associative,+    associativeOnArbitrary,++    -- ** Commutativity+    commutativeOnGens,+    commutative,+    commutativeOnArbitrary,++    -- * Show and Read properties+    showReadSpec,+    showReadSpecOnArbitrary,+    showReadSpecOnGen,++    -- * Eq properties+    eqSpec,+    eqSpecOnArbitrary,+    eqSpecOnGen,++    -- * Ord properties+    ordSpecOnGen,+    ordSpec,+    ordSpecOnArbitrary,++    -- * Monoid properties+    monoidSpec,+    monoidSpecOnArbitrary,+    monoidSpecOnGen,++    -- * Functor properties+    functorSpec,+    functorSpecOnArbitrary,+    functorSpecOnGens,++    -- * Applicative properties+    applicativeSpec,+    applicativeSpecOnArbitrary,+    applicativeSpecOnGens,++    -- * Monad properties+    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
@@ -1,116 +1,106 @@-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE KindSignatures #-}-{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}  -- | Applicative properties -- -- You will need @TypeApplications@ to use these. module Test.Syd.Validity.Applicative-    ( applicativeSpecOnValid-    , applicativeSpec-    , applicativeSpecOnArbitrary-    , applicativeSpecOnGens-    ) where+  ( applicativeSpec,+    applicativeSpecOnArbitrary,+    applicativeSpecOnGens,+  )+where  import Data.Data- import Data.GenValidity import Data.Kind--import Test.Syd import Test.QuickCheck-+import Test.Syd import Test.Syd.Validity.Functions import Test.Syd.Validity.Utils  {-# ANN module "HLint: ignore Avoid lambda" #-}  pureTypeStr ::-       forall (f :: Type -> Type). (Typeable f)-    => String+  forall (f :: Type -> Type).+  (Typeable f) =>+  String pureTypeStr = unwords ["pure", "::", "a", "->", nameOf @f, "a"]  seqTypeStr ::-       forall (f :: Type -> Type). (Typeable f)-    => String+  forall (f :: Type -> Type).+  (Typeable f) =>+  String seqTypeStr =-    unwords-        [ "(<*>)"-        , "::"-        , nameOf @f-        , "(a"-        , "->"-        , "b)"-        , "->"-        , nameOf @f-        , "a"-        , "->"-        , nameOf @f-        , "b"-        ]+  unwords+    [ "(<*>)",+      "::",+      nameOf @f,+      "(a",+      "->",+      "b)",+      "->",+      nameOf @f,+      "a",+      "->",+      nameOf @f,+      "b"+    ]  seqrTypeStr ::-       forall (f :: Type -> Type). (Typeable f)-    => String+  forall (f :: Type -> Type).+  (Typeable f) =>+  String seqrTypeStr =-    unwords-        [ "(*>)"-        , "::"-        , nameOf @f-        , "a"-        , "->"-        , nameOf @f-        , "b"-        , "->"-        , nameOf @f-        , "b"-        ]+  unwords+    [ "(*>)",+      "::",+      nameOf @f,+      "a",+      "->",+      nameOf @f,+      "b",+      "->",+      nameOf @f,+      "b"+    ]  seqlTypeStr ::-       forall (f :: Type -> Type). (Typeable f)-    => String+  forall (f :: Type -> Type).+  (Typeable f) =>+  String seqlTypeStr =-    unwords-        [ "(<*)"-        , "::"-        , nameOf @f-        , "a"-        , "->"-        , nameOf @f-        , "b"-        , "->"-        , nameOf @f-        , "a"-        ]+  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+  forall (f :: Type -> Type).+  ( Eq (f Int),+    Show (f Int),+    Applicative f,+    Typeable f,+    GenValid (f Int)+  ) =>+  Spec+applicativeSpec = applicativeSpecWithInts @f genValid  -- | Standard test spec for properties of Applicative instances for values generated with Arbitrary instances --@@ -118,32 +108,32 @@ -- -- > applicativeSpecOnArbitrary @[] applicativeSpecOnArbitrary ::-       forall (f :: Type -> Type).-       (Eq (f Int), Show (f Int), Applicative f, Typeable f, Arbitrary (f Int))-    => Spec+  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+  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"])+  applicativeSpecOnGens+    @f+    @Int+    genValid+    "int"+    gen+    (unwords [nameOf @f, "of ints"])+    gen+    (unwords [nameOf @f, "of ints"])+    ((+) <$> genValid)+    "increments"+    (pure <$> ((+) <$> genValid))+    (unwords [nameOf @f, "of increments"])+    (pure <$> ((*) <$> genValid))+    (unwords [nameOf @f, "of scalings"])  -- | Standard test spec for properties of Applicative instances for values generated by given generators (and names for those generator). --@@ -167,118 +157,127 @@ -- >     (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+  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 $+  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+      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
@@ -1,23 +1,21 @@+{-# LANGUAGE AllowAmbiguousTypes #-} {-# 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+  ( arbitrarySpec,+    arbitraryGeneratesOnlyValid,+  )+where  import Data.Data- import Data.GenValidity--import Test.Syd import Test.QuickCheck-+import Test.Syd import Test.Syd.Validity.GenValidity import Test.Syd.Validity.Utils @@ -28,18 +26,20 @@ -- -- > arbitrarySpec @Int arbitrarySpec ::-       forall a. (Typeable a, Show a, Validity a, Arbitrary a)-    => Spec+  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+  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+  forall a.+  (Show a, Validity a, Arbitrary a) =>+  Property arbitraryGeneratesOnlyValid = genGeneratesValid @a arbitrary
src/Test/Syd/Validity/Eq.hs view
@@ -1,69 +1,48 @@+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}  -- | Eq properties -- -- You will need @TypeApplications@ to use these. module Test.Syd.Validity.Eq-    ( eqSpecOnValid-    , eqSpecOnInvalid-    , eqSpec-    , eqSpecOnArbitrary-    , eqSpecOnGen-    ) where+  ( eqSpec,+    eqSpecOnArbitrary,+    eqSpecOnGen,+  )+where  import Data.Data- import Data.GenValidity--import Test.Syd import Test.QuickCheck-+import Test.Syd import Test.Syd.Validity.Functions import Test.Syd.Validity.Relations import Test.Syd.Validity.Utils  eqTypeStr ::-       forall a. Typeable a-    => String+  forall a.+  Typeable a =>+  String eqTypeStr = binRelStr @a "=="  neqTypeStr ::-       forall a. Typeable a-    => String+  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+  forall a.+  (Show a, Eq a, Typeable a, GenValid a) =>+  Spec+eqSpec = eqSpecOnGen @a genValid "valid" shrinkValid  -- | Standard test spec for properties of Eq instances for arbitrary values --@@ -71,8 +50,9 @@ -- -- > eqSpecOnArbitrary @Int eqSpecOnArbitrary ::-       forall a. (Show a, Eq a, Typeable a, Arbitrary a)-    => Spec+  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).@@ -81,63 +61,70 @@ -- -- > eqSpecOnGen ((* 2) <$> genValid @Int) "even" eqSpecOnGen ::-       forall a. (Show a, Eq a, Typeable a)-    => Gen a-    -> String-    -> (a -> [a])-    -> Spec+  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+  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
@@ -3,99 +3,13 @@  -- | 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+  ( module Test.Syd.Validity.Functions.CanFail,+    module Test.Syd.Validity.Functions.Equivalence,+    module Test.Syd.Validity.Functions.Idempotence,+    module Test.Syd.Validity.Functions.Inverse,+    module Test.Syd.Validity.Functions.Validity,+  )+where  import Test.Syd.Validity.Functions.CanFail import Test.Syd.Validity.Functions.Equivalence
src/Test/Syd/Validity/Functions/CanFail.hs view
@@ -3,35 +3,28 @@  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 import Test.Syd.Validity.Property.Utils import Test.Syd.Validity.Types @@ -41,12 +34,8 @@ 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+succeeds :: (Show a, Show (f b), GenValid a, CanFail f) => (a -> f b) -> Property+succeeds f = succeedsOnGen f genValid shrinkValid  -- | The function succeeds if the input is generated by @arbitrary@ succeedsOnArbitrary ::@@ -58,10 +47,6 @@   (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 ::@@ -74,20 +59,14 @@  -- | 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+-- that is generated by @genValid@.+validIfSucceeds :: (Show a, Show b, GenValid a, Validity b, CanFail f) => (a -> f b) -> Property+validIfSucceeds f = validIfSucceedsOnGen f genValid shrinkValid  succeedsOnGens2 ::   (Show a, Show b, Show (f c), CanFail f) =>@@ -98,17 +77,11 @@ 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) =>+  (Show a, Show b, Show (f c), GenValid a, GenValid b, CanFail f) =>   (a -> b -> f c) ->   Property-succeeds2 func = succeedsOnGens2 func genUnchecked shrinkUnchecked+succeeds2 func = succeedsOnGens2 func genValid shrinkValid  succeedsOnArbitrary2 ::   (Show a, Show b, Show (f c), Arbitrary a, Arbitrary b, CanFail f) =>@@ -127,22 +100,6 @@ 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) ->@@ -155,17 +112,11 @@       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) =>+  (Show a, Show b, Show c, GenValid a, GenValid b, Validity c, CanFail f) =>   (a -> b -> f c) ->   Property-validIfSucceeds2 func = validIfSucceedsOnGens2 func genUnchecked shrinkUnchecked+validIfSucceeds2 func = validIfSucceedsOnGens2 func genValid shrinkValid  validIfSucceedsOnArbitrary2 ::   (Show a, Show b, Show c, Arbitrary a, Arbitrary b, Validity c, CanFail f) =>@@ -185,26 +136,20 @@       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,+    GenValid a,+    GenValid b,+    GenValid c,     Validity d,     CanFail f   ) =>   (a -> b -> c -> f d) ->   Property-validIfSucceeds3 func = validIfSucceedsOnGens3 func genUnchecked shrinkUnchecked+validIfSucceeds3 func = validIfSucceedsOnGens3 func genValid shrinkValid  validIfSucceedsOnArbitrary3 ::   (Show a, Show b, Show c, Show d, Arbitrary a, Arbitrary b, Arbitrary c, Validity d, CanFail f) =>
src/Test/Syd/Validity/Functions/Equivalence.hs view
@@ -2,458 +2,352 @@ {-# 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+  ( equivalentOnGen,+    equivalent,+    equivalentOnArbitrary,+    equivalentOnGens2,+    equivalent2,+    equivalentOnArbitrary2,+    equivalentWhenFirstSucceedsOnGen,+    equivalentWhenFirstSucceeds,+    equivalentWhenFirstSucceedsOnArbitrary,+    equivalentWhenFirstSucceedsOnGens2,+    equivalentWhenFirstSucceeds2,+    equivalentWhenFirstSucceedsOnArbitrary2,+    equivalentWhenSecondSucceedsOnGen,+    equivalentWhenSecondSucceeds,+    equivalentWhenSecondSucceedsOnArbitrary,+    equivalentWhenSecondSucceedsOnGens2,+    equivalentWhenSecondSucceeds2,+    equivalentWhenSecondSucceedsOnArbitrary2,+    equivalentWhenSucceedOnGen,+    equivalentWhenSucceed,+    equivalentWhenSucceedOnArbitrary,+    equivalentWhenSucceedOnGens2,+    equivalentWhenSucceed2,+    equivalentWhenSucceedOnArbitrary2,+    equivalentOnGens3,+    equivalent3,+    equivalentOnArbitrary3,+  )+where  import Data.GenValidity--import Test.Syd import Test.QuickCheck-+import Test.Syd import Test.Syd.Validity.Types  equivalentOnGen ::-       (Show a, Show b, Eq b)-    => (a -> b)-    -> (a -> b)-    -> Gen a-    -> (a -> [a])-    -> Property+  (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+  (Show a, GenValid a, Show b, Eq b) =>+  (a -> b) ->+  (a -> b) ->+  Property+equivalent f g = equivalentOnGen f g genValid shrinkValid  -- | -- -- prop> equivalentOnArbitrary ((* 2) . (+ 1)) ((+ 2) . (* 2) :: Int -> Int) equivalentOnArbitrary ::-       (Show a, Arbitrary a, Show b, Eq b)-    => (a -> b)-    -> (a -> b)-    -> Property+  (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+  (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+  forAllShrink gen s $ \(a, b) -> f a b `shouldBe` g a b  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+  (Show a, GenValid a, Show b, GenValid b, Show c, Eq c) =>+  (a -> b -> c) ->+  (a -> b -> c) ->+  Property+equivalent2 f g = equivalentOnGens2 f g genValid shrinkValid  -- | -- -- 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+  (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+  (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+  forAllShrink gen s $ \a ->+    case resultIfSucceeded (f a) of+      Nothing -> return () -- fine+      Just r -> r `shouldBe` g a  equivalentWhenFirstSucceedsOnArbitrary ::-       (Show a, Arbitrary a, Show b, Eq b, CanFail f)-    => (a -> f b)-    -> (a -> b)-    -> Property+  (Show a, Arbitrary a, Show b, Eq b, CanFail f) =>+  (a -> f b) ->+  (a -> b) ->+  Property equivalentWhenFirstSucceedsOnArbitrary f g =-    equivalentWhenFirstSucceedsOnGen f g arbitrary shrink+  equivalentWhenFirstSucceedsOnGen f g arbitrary shrink  equivalentWhenFirstSucceeds ::-       (Show a, GenUnchecked a, Show b, Eq b, CanFail f)-    => (a -> f b)-    -> (a -> b)-    -> Property+  (Show a, GenValid a, Show b, Eq b, CanFail f) =>+  (a -> f b) ->+  (a -> b) ->+  Property equivalentWhenFirstSucceeds f g =-    equivalentWhenFirstSucceedsOnGen f g genUnchecked shrinkUnchecked+  equivalentWhenFirstSucceedsOnGen f g genValid shrinkValid  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+  (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+  forAllShrink gen s $ \(a, b) ->+    case resultIfSucceeded (f a b) of+      Nothing -> return () -- fine+      Just rs -> rs `shouldBe` g a b  equivalentWhenFirstSucceedsOnArbitrary2 ::-       ( Show a-       , Arbitrary a-       , Show b-       , Arbitrary b-       , Show c-       , Eq c-       , CanFail f-       )-    => (a -> b -> f c)-    -> (a -> b -> c)-    -> Property+  ( 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+  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+  ( Show a,+    GenValid a,+    Show b,+    GenValid b,+    Show c,+    Eq c,+    CanFail f+  ) =>+  (a -> b -> f c) ->+  (a -> b -> c) ->+  Property equivalentWhenFirstSucceeds2 f g =-    equivalentWhenFirstSucceedsOnGens2 f g genUnchecked shrinkUnchecked+  equivalentWhenFirstSucceedsOnGens2 f g genValid shrinkValid  equivalentWhenSecondSucceedsOnGen ::-       (Show a, Show b, Eq b, CanFail f)-    => (a -> b)-    -> (a -> f b)-    -> Gen a-    -> (a -> [a])-    -> Property+  (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+  forAllShrink gen s $ \a ->+    case resultIfSucceeded (g a) of+      Nothing -> return () -- fine+      Just r -> r `shouldBe` f a  equivalentWhenSecondSucceedsOnArbitrary ::-       (Show a, Arbitrary a, Show b, Eq b, CanFail f)-    => (a -> b)-    -> (a -> f b)-    -> Property+  (Show a, Arbitrary a, Show b, Eq b, CanFail f) =>+  (a -> b) ->+  (a -> f b) ->+  Property equivalentWhenSecondSucceedsOnArbitrary f g =-    equivalentWhenSecondSucceedsOnGen f g arbitrary shrink+  equivalentWhenSecondSucceedsOnGen f g arbitrary shrink  equivalentWhenSecondSucceeds ::-       (Show a, GenUnchecked a, Show b, Eq b, CanFail f)-    => (a -> b)-    -> (a -> f b)-    -> Property+  (Show a, GenValid a, Show b, Eq b, CanFail f) =>+  (a -> b) ->+  (a -> f b) ->+  Property equivalentWhenSecondSucceeds f g =-    equivalentWhenSecondSucceedsOnGen f g genUnchecked shrinkUnchecked+  equivalentWhenSecondSucceedsOnGen f g genValid shrinkValid  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+  (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+  forAllShrink gen s $ \(a, b) ->+    case resultIfSucceeded (g a b) of+      Nothing -> return () -- fine+      Just rs -> rs `shouldBe` f a b  equivalentWhenSecondSucceedsOnArbitrary2 ::-       ( Show a-       , Arbitrary a-       , Show b-       , Arbitrary b-       , Show c-       , Eq c-       , CanFail f-       )-    => (a -> b -> c)-    -> (a -> b -> f c)-    -> Property+  ( 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+  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+  ( Show a,+    GenValid a,+    Show b,+    GenValid b,+    Show c,+    Eq c,+    CanFail f+  ) =>+  (a -> b -> c) ->+  (a -> b -> f c) ->+  Property equivalentWhenSecondSucceeds2 f g =-    equivalentWhenSecondSucceedsOnGens2 f g genUnchecked shrinkUnchecked+  equivalentWhenSecondSucceedsOnGens2 f g genValid shrinkValid  equivalentWhenSucceedOnGen ::-       (Show a, Show b, Eq b, CanFail f)-    => (a -> f b)-    -> (a -> f b)-    -> Gen a-    -> (a -> [a])-    -> Property+  (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+  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  equivalentWhenSucceed ::-       (Show a, GenUnchecked a, Show b, Eq b, CanFail f)-    => (a -> f b)-    -> (a -> f b)-    -> Property+  (Show a, GenValid a, Show b, Eq b, CanFail f) =>+  (a -> f b) ->+  (a -> f b) ->+  Property equivalentWhenSucceed f g =-    equivalentWhenSucceedOnGen f g genUnchecked shrinkUnchecked+  equivalentWhenSucceedOnGen f g genValid shrinkValid  equivalentWhenSucceedOnArbitrary ::-       (Show a, Arbitrary a, Show b, Eq b, CanFail f)-    => (a -> f b)-    -> (a -> f b)-    -> Property+  (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+  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+  (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+  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  equivalentWhenSucceedOnArbitrary2 ::-       ( Show a-       , Arbitrary a-       , Show b-       , Arbitrary b-       , Show c-       , Eq c-       , CanFail f-       )-    => (a -> b -> f c)-    -> (a -> b -> f c)-    -> Property+  ( 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+  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+  ( Show a,+    GenValid a,+    Show b,+    GenValid b,+    Show c,+    Eq c,+    CanFail f+  ) =>+  (a -> b -> f c) ->+  (a -> b -> f c) ->+  Property equivalentWhenSucceed2 f g =-    equivalentWhenSucceedOnGens2 f g genUnchecked shrinkUnchecked+  equivalentWhenSucceedOnGens2 f g genValid shrinkValid  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+  (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+  forAllShrink gen s $ \(a, b, c) -> f a b c `shouldBe` g a b c  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+  ( 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+equivalent3 f g = equivalentOnGens3 f g genValid shrinkValid  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+  ( 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
@@ -3,25 +3,21 @@  -- | Standard tests involving validity module Test.Syd.Validity.Functions.Idempotence-    ( idempotentOnGen-    , idempotentOnValid-    , idempotent-    , idempotentOnArbitrary-    ) where+  ( idempotentOnGen,+    idempotent,+    idempotentOnArbitrary,+  )+where  import Data.GenValidity--import Test.Syd import Test.QuickCheck+import Test.Syd  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+idempotent :: (Show a, Eq a, GenValid a) => (a -> a) -> Property+idempotent func = idempotentOnGen func genValid shrinkValid  -- | --
src/Test/Syd/Validity/Functions/Inverse.hs view
@@ -3,159 +3,127 @@  -- | 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+  ( inverseFunctionsOnGen,+    inverseFunctions,+    inverseFunctionsOnArbitrary,+    inverseFunctionsIfFirstSucceedsOnGen,+    inverseFunctionsIfFirstSucceeds,+    inverseFunctionsIfFirstSucceedsOnArbitrary,+    inverseFunctionsIfSecondSucceedsOnGen,+    inverseFunctionsIfSecondSucceeds,+    inverseFunctionsIfSecondSucceedsOnArbitrary,+    inverseFunctionsIfSucceedOnGen,+    inverseFunctionsIfSucceed,+    inverseFunctionsIfSucceedOnArbitrary,+  )+where  import Data.GenValidity--import Test.Syd import Test.QuickCheck-+import Test.Syd import Test.Syd.Validity.Types  inverseFunctionsOnGen ::-       (Show a, Eq a) => (a -> b) -> (b -> a) -> Gen a -> (a -> [a]) -> Property+  (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+  forAllShrink gen s $ \a -> g (f a) `shouldBe` a  inverseFunctions ::-       (Show a, Eq a, GenUnchecked a) => (a -> b) -> (b -> a) -> Property-inverseFunctions f g = inverseFunctionsOnGen f g genUnchecked shrinkUnchecked+  (Show a, Eq a, GenValid a) => (a -> b) -> (b -> a) -> Property+inverseFunctions f g = inverseFunctionsOnGen f g genValid shrinkValid  -- | -- '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+  (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+  (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+  forAllShrink gen s $ \a ->+    case resultIfSucceeded (f a) of+      Nothing -> return () -- fine+      Just b -> g b `shouldBe` a  inverseFunctionsIfFirstSucceeds ::-       (Show a, Eq a, GenUnchecked a, CanFail f)-    => (a -> f b)-    -> (b -> a)-    -> Property+  (Show a, Eq a, GenValid a, CanFail f) =>+  (a -> f b) ->+  (b -> a) ->+  Property inverseFunctionsIfFirstSucceeds f g =-    inverseFunctionsIfFirstSucceedsOnGen f g genUnchecked shrinkUnchecked+  inverseFunctionsIfFirstSucceedsOnGen f g genValid shrinkValid  inverseFunctionsIfFirstSucceedsOnArbitrary ::-       (Show a, Eq a, Arbitrary a, CanFail f)-    => (a -> f b)-    -> (b -> a)-    -> Property+  (Show a, Eq a, Arbitrary a, CanFail f) =>+  (a -> f b) ->+  (b -> a) ->+  Property inverseFunctionsIfFirstSucceedsOnArbitrary f g =-    inverseFunctionsIfFirstSucceedsOnGen f g arbitrary shrink+  inverseFunctionsIfFirstSucceedsOnGen f g arbitrary shrink  inverseFunctionsIfSecondSucceedsOnGen ::-       (Show a, Eq a, CanFail f)-    => (a -> b)-    -> (b -> f a)-    -> Gen a-    -> (a -> [a])-    -> Property+  (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+  forAllShrink gen s $ \a ->+    case resultIfSucceeded (g (f a)) of+      Nothing -> return () -- fine+      Just r -> r `shouldBe` a  inverseFunctionsIfSecondSucceeds ::-       (Show a, Eq a, GenUnchecked a, CanFail f)-    => (a -> b)-    -> (b -> f a)-    -> Property+  (Show a, Eq a, GenValid a, CanFail f) =>+  (a -> b) ->+  (b -> f a) ->+  Property inverseFunctionsIfSecondSucceeds f g =-    inverseFunctionsIfSecondSucceedsOnGen f g genUnchecked shrinkUnchecked+  inverseFunctionsIfSecondSucceedsOnGen f g genValid shrinkValid  inverseFunctionsIfSecondSucceedsOnArbitrary ::-       (Show a, Eq a, Arbitrary a, CanFail f)-    => (a -> b)-    -> (b -> f a)-    -> Property+  (Show a, Eq a, Arbitrary a, CanFail f) =>+  (a -> b) ->+  (b -> f a) ->+  Property inverseFunctionsIfSecondSucceedsOnArbitrary f g =-    inverseFunctionsIfSecondSucceedsOnGen f g arbitrary shrink+  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+  (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+  forAllShrink gen s $ \a ->+    case do+      fa <- resultIfSucceeded $ f a+      resultIfSucceeded $ g fa of+      Nothing -> return () -- fine+      Just r -> r `shouldBe` a  inverseFunctionsIfSucceed ::-       (Show a, Eq a, GenUnchecked a, CanFail f, CanFail g)-    => (a -> f b)-    -> (b -> g a)-    -> Property+  (Show a, Eq a, GenValid a, CanFail f, CanFail g) =>+  (a -> f b) ->+  (b -> g a) ->+  Property inverseFunctionsIfSucceed f g =-    inverseFunctionsIfSucceedOnGen f g genUnchecked shrinkUnchecked+  inverseFunctionsIfSucceedOnGen f g genValid shrinkValid  inverseFunctionsIfSucceedOnArbitrary ::-       (Show a, Eq a, Arbitrary a, CanFail f, CanFail g)-    => (a -> f b)-    -> (b -> g a)-    -> Property+  (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+  inverseFunctionsIfSucceedOnGen f g arbitrary shrink
src/Test/Syd/Validity/Functions/Validity.hs view
@@ -3,128 +3,99 @@  -- | Standard tests involving validity module Test.Syd.Validity.Functions.Validity-    ( producesValidsOnGen-    , producesValidsOnValids-    , producesValid-    , producesValidsOnArbitrary-    , producesValidsOnGens2-    , producesValidsOnValids2-    , producesValid2-    , producesValidsOnArbitrary2-    , producesValidsOnGens3-    , producesValidsOnValids3-    , producesValid3-    , producesValidsOnArbitrary3-    ) where+  ( producesValidsOnGen,+    producesValid,+    producesValidsOnArbitrary,+    producesValidsOnGens2,+    producesValid2,+    producesValidsOnArbitrary2,+    producesValidsOnGens3,+    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+  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+  (Show a, Show b, GenValid a, Validity b) => (a -> b) -> Property+producesValid f = producesValidsOnGen f genValid shrinkValid  -- | The function produces valid output when the input is generated by -- @arbitrary@ producesValidsOnArbitrary ::-       (Show a, Show b, Arbitrary a, Validity b) => (a -> b) -> Property+  (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+  (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+  forAllShrink gen s $ \(a, b) -> shouldBeValid $ func a b  producesValid2 ::-       (Show a, Show b, Show c, GenUnchecked a, GenUnchecked b, Validity c)-    => (a -> b -> c)-    -> Property-producesValid2 func = producesValidsOnGens2 func genUnchecked shrinkUnchecked+  (Show a, Show b, Show c, GenValid a, GenValid b, Validity c) =>+  (a -> b -> c) ->+  Property+producesValid2 func = producesValidsOnGens2 func genValid shrinkValid  producesValidsOnArbitrary2 ::-       (Show a, Show b, Show c, Arbitrary a, Arbitrary b, Validity c)-    => (a -> b -> c)-    -> Property+  (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+  (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+  forAllShrink gen s $ \(a, b, c) -> shouldBeValid $ func a b c  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+  ( Show a,+    Show b,+    Show c,+    Show d,+    GenValid a,+    GenValid b,+    GenValid c,+    Validity d+  ) =>+  (a -> b -> c -> d) ->+  Property+producesValid3 func = producesValidsOnGens3 func genValid shrinkValid  producesValidsOnArbitrary3 ::-       ( Show a-       , Show b-       , Show c-       , Show d-       , Arbitrary a-       , Arbitrary b-       , Arbitrary c-       , Validity d-       )-    => (a -> b -> c -> d)-    -> Property+  ( 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
@@ -1,77 +1,65 @@-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE KindSignatures #-}-{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}  -- | Functor properties -- -- You will need @TypeApplications@ to use these. module Test.Syd.Validity.Functor-    ( functorSpecOnValid-    , functorSpec-    , functorSpecOnArbitrary-    , functorSpecOnGens-    ) where+  ( functorSpec,+    functorSpecOnArbitrary,+    functorSpecOnGens,+  )+where  import Data.Data- import Data.GenValidity import Data.Kind--import Test.Syd import Test.QuickCheck-+import Test.Syd import Test.Syd.Validity.Functions import Test.Syd.Validity.Utils  {-# ANN module "HLint: ignore Functor law" #-}  fmapTypeStr ::-       forall (f :: Type -> Type). (Typeable f)-    => String+  forall (f :: Type -> Type).+  (Typeable f) =>+  String fmapTypeStr =-    unwords-        [ "fmap"-        , "::"-        , "(a"-        , "->"-        , "b)"-        , "->"-        , nameOf @f-        , "a"-        , "->"-        , nameOf @f-        , "b"-        ]+  unwords+    [ "fmap",+      "::",+      "(a",+      "->",+      "b)",+      "->",+      nameOf @f,+      "a",+      "->",+      nameOf @f,+      "b"+    ]  flTypeStr ::-       forall (f :: Type -> Type). (Typeable f)-    => String+  forall (f :: Type -> Type).+  (Typeable f) =>+  String flTypeStr =-    unwords ["(<$)", "::", "a", "->", nameOf @f, "b", "->", nameOf @f, "a"]+  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+  forall (f :: Type -> Type).+  (Eq (f Int), Show (f Int), Functor f, Typeable f, GenValid (f Int)) =>+  Spec+functorSpec = functorSpecWithInts @f genValid  -- | Standard test spec for properties of Functor instances for values generated with Arbitrary instances --@@ -79,27 +67,28 @@ -- -- > functorSpecOnArbitrary @[] functorSpecOnArbitrary ::-       forall (f :: Type -> Type).-       (Eq (f Int), Show (f Int), Functor f, Typeable f, Arbitrary (f Int))-    => Spec+  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+  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"+  functorSpecOnGens+    @f+    @Int+    genValid+    "int"+    gen+    (unwords [nameOf @f, "of ints"])+    ((+) <$> genValid)+    "increments"+    ((*) <$> genValid)+    "scalings"  -- | Standard test spec for properties of Functor instances for values generated by given generators (and names for those generator). --@@ -113,61 +102,64 @@ -- >     ((+) <$> 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+  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 $+  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+      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 
@@ -1,113 +0,0 @@-{-# 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
@@ -1,49 +1,26 @@-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}  -- | Tests for GenValidity instances -- -- You will need @TypeApplications@ to use these. module Test.Syd.Validity.GenValidity-    ( genValiditySpec-    , genValidSpec-    , genInvalidSpec-    , genValidGeneratesValid-    , genGeneratesValid-    , genInvalidGeneratesInvalid-    , genGeneratesInvalid-    ) where+  ( genValidSpec,+    genValidGeneratesValid,+    genGeneratesValid,+    genGeneratesInvalid,+  )+where  import Data.Data- import Data.GenValidity--import Test.Syd import Test.QuickCheck-+import Test.Syd 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@@ -53,33 +30,16 @@ -- -- > genValidSpec @Int genValidSpec ::-       forall a. (Typeable a, Show a, GenValid a)-    => Spec+  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+  parallel $ do+    let name = nameOf @a+    describe ("GenValid " ++ name) $+      describe ("genValid   :: Gen " ++ name) $+        it ("only generates valid \'" ++ name ++ "\'s") $+          genValidGeneratesValid @a  -- | @genValid@ only generates valid data --@@ -94,17 +54,7 @@ -- prop> genValidGeneratesValid @(Maybe Int) -- prop> genValidGeneratesValid @[Int] genValidGeneratesValid ::-       forall a. (Show a, GenValid a)-    => Property+  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
@@ -1,29 +1,30 @@-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-}  -- | Tests for GenValidity instances module Test.Syd.Validity.GenValidity.Property-    ( genGeneratesValid-    , genGeneratesInvalid-    ) where+  ( 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+  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+  forall a.+  (Show a, Validity a) =>+  Gen a ->+  Property genGeneratesInvalid gen = forAll gen shouldBeInvalid
src/Test/Syd/Validity/Monad.hs view
@@ -1,30 +1,27 @@-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE KindSignatures #-}-{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}  -- | Monad properties -- -- You will need @TypeApplications@ to use these. module Test.Syd.Validity.Monad-    ( monadSpecOnValid-    , monadSpec-    , monadSpecOnArbitrary-    , monadSpecOnGens-    ) where--import Data.Data+  ( monadSpec,+    monadSpecOnArbitrary,+    monadSpecOnGens,+  )+where  import Control.Monad (ap)-import Data.Kind (Type)+import Data.Data import Data.GenValidity+import Data.Kind (Type)+import Test.QuickCheck 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 @@ -45,50 +42,41 @@ {-# ANN module "HLint: ignore Reduce duplication" #-}  returnTypeStr ::-       forall (m :: Type -> Type). (Typeable m)-    => String+  forall (m :: Type -> Type).+  (Typeable m) =>+  String returnTypeStr = unwords ["return", "::", "a", "->", nameOf @m, "a"]  bindTypeStr ::-       forall (m :: Type -> Type). (Typeable m)-    => String+  forall (m :: Type -> Type).+  (Typeable m) =>+  String bindTypeStr =-    unwords-        [ "(>>=)"-        , "::"-        , nameOf @m-        , "a"-        , "->"-        , "(b"-        , "->"-        , nameOf @m-        , "a)"-        , "->"-        , nameOf @m-        , "b"-        ]+  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+  forall (f :: Type -> Type).+  (Eq (f Int), Show (f Int), Monad f, Typeable f, GenValid (f Int)) =>+  Spec+monadSpec = monadSpecWithInts @f genValid  -- | Standard test spec for properties of Monad instances for values generated with Arbitrary instances --@@ -96,35 +84,40 @@ -- -- > monadSpecOnArbitrary @[] monadSpecOnArbitrary ::-       forall (f :: Type -> Type).-       (Eq (f Int), Show (f Int), Monad f, Typeable f, Arbitrary (f Int))-    => Spec+  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+  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"])+  monadSpecOnGens+    @f+    @Int+    genValid+    "int"+    gen+    (unwords [nameOf @f, "of ints"])+    gen+    (unwords [nameOf @f, "of ints"])+    ((+) <$> genValid)+    "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 <$> ((+) <$> genValid))+    (unwords [nameOf @f, "of additions"])  -- | Standard test spec for properties of Monad instances for values generated by given generators (and names for those generator). --@@ -148,106 +141,113 @@ -- >     (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+  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 $+  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+      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
@@ -1,44 +1,44 @@+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}  -- | Monoid properties -- -- You will need @TypeApplications@ to use these. module Test.Syd.Validity.Monoid-    ( monoidSpecOnValid-    , monoidSpec-    , monoidSpecOnArbitrary-    , monoidSpecOnGen-    ) where+  ( monoidSpec,+    monoidSpecOnArbitrary,+    monoidSpecOnGen,+  )+where  import Data.Data- import Data.GenValidity--import Test.Syd import Test.QuickCheck-+import Test.Syd import Test.Syd.Validity.Functions import Test.Syd.Validity.Operations import Test.Syd.Validity.Utils  memptyTypeStr ::-       forall a. Typeable a-    => String+  forall a.+  Typeable a =>+  String memptyTypeStr = unwords ["mempty", "::", nameOf @a]  mappendTypeStr ::-       forall a. Typeable a-    => String+  forall a.+  Typeable a =>+  String mappendTypeStr = unwords ["mappend", "::", an, "->", an, "->", an]   where     an = nameOf @a  mconcatTypeStr ::-       forall a. Typeable a-    => String+  forall a.+  Typeable a =>+  String mconcatTypeStr = unwords ["mconcat", "::", "[" ++ an ++ "]", "->", an]   where     an = nameOf @a@@ -47,21 +47,12 @@ -- -- 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+  forall a.+  (Show a, Eq a, Monoid a, Typeable a, GenValid a) =>+  Spec+monoidSpec = monoidSpecOnGen @a genValid "valid" shrinkValid  -- | Standard test spec for properties of 'Monoid' instances for arbitrary values --@@ -69,8 +60,9 @@ -- -- > monoidSpecOnArbitrary @[Int] monoidSpecOnArbitrary ::-       forall a. (Show a, Eq a, Monoid a, Typeable a, Arbitrary a)-    => Spec+  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).@@ -79,45 +71,49 @@ -- -- > monoidSpecOnGen (pure "a") "singleton list of 'a'" monoidSpecOnGen ::-       forall a. (Show a, Eq a, Monoid a, Typeable a)-    => Gen a-    -> String-    -> (a -> [a])-    -> Spec+  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+  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
@@ -3,31 +3,11 @@  -- | 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+  ( module Test.Syd.Validity.Operations.Associativity,+    module Test.Syd.Validity.Operations.Commutativity,+    module Test.Syd.Validity.Operations.Identity,+  )+where  import Test.Syd.Validity.Operations.Associativity import Test.Syd.Validity.Operations.Commutativity
src/Test/Syd/Validity/Operations/Associativity.hs view
@@ -2,16 +2,15 @@ {-# LANGUAGE ScopedTypeVariables #-}  module Test.Syd.Validity.Operations.Associativity-    ( associativeOnGens-    , associativeOnValids-    , associative-    , associativeOnArbitrary-    ) where+  ( associativeOnGens,+    associative,+    associativeOnArbitrary,+  )+where  import Data.GenValidity--import Test.Syd import Test.QuickCheck+import Test.Syd  -- | --@@ -22,29 +21,26 @@ --     (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+  (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+  forAllShrink gen s $ \(a, b, c) ->+    ((a `op` b) `op` c) `shouldBe` (a `op` (b `op` c))  -- | -- -- 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+associative :: (Show a, Eq a, GenValid a) => (a -> a -> a) -> Property+associative op = associativeOnGens op genValid shrinkValid  -- | -- -- prop> associativeOnArbitrary ((*) :: Int -> Int -> Int) -- prop> associativeOnArbitrary ((+) :: Int -> Int -> Int) associativeOnArbitrary ::-       (Show a, Eq a, Arbitrary a) => (a -> a -> a) -> Property+  (Show a, Eq a, Arbitrary a) => (a -> a -> a) -> Property associativeOnArbitrary op = associativeOnGens op arbitrary shrink
src/Test/Syd/Validity/Operations/Commutativity.hs view
@@ -2,16 +2,15 @@ {-# LANGUAGE ScopedTypeVariables #-}  module Test.Syd.Validity.Operations.Commutativity-    ( commutativeOnGens-    , commutativeOnValids-    , commutative-    , commutativeOnArbitrary-    ) where+  ( commutativeOnGens,+    commutative,+    commutativeOnArbitrary,+  )+where  import Data.GenValidity--import Test.Syd import Test.QuickCheck+import Test.Syd  -- | --@@ -22,31 +21,23 @@ --     a \star b = b \star a -- \] commutativeOnGens ::-       (Show a, Show b, Eq b)-    => (a -> a -> b)-    -> Gen (a, a)-    -> ((a, a) -> [(a, a)])-    -> Property+  (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+  forAllShrink gen s $ \(a, b) -> (a `op` b) `shouldBe` (b `op` a)  -- | -- -- 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+  (Show a, Show b, Eq b, GenValid a) =>+  (a -> a -> b) ->+  Property+commutative op = commutativeOnGens op genValid shrinkValid  -- | --@@ -55,6 +46,7 @@ -- commutativeOnArbitrary :: --        (Show a, Eq a, Arbitrary a) => (a -> a -> a) -> Property commutativeOnArbitrary ::-          (Show a, Show b, Eq b, Arbitrary a)-       => (a -> a -> b) -> Property+  (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
@@ -2,26 +2,23 @@ {-# 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+  ( leftIdentityOnElemWithEquality,+    leftIdentityOnGenWithEquality,+    leftIdentityOnGen,+    leftIdentity,+    leftIdentityOnArbitrary,+    rightIdentityOnElemWithEquality,+    rightIdentityOnGenWithEquality,+    rightIdentityOnGen,+    rightIdentity,+    rightIdentityOnArbitrary,+    identityOnGen,+    identity,+    identityOnArbitrary,+  )+where  import Data.GenValidity- import Test.QuickCheck  -- |@@ -32,51 +29,53 @@ --   \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+  -- | A binary operation+  (b -> a -> a) ->+  -- | An equality+  (a -> a -> Bool) ->+  -- | A candidate left-identity+  b ->+  -- | An element+  a ->+  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+  Show a =>+  -- | A binary operation+  (b -> a -> a) ->+  -- | An equality+  (a -> a -> Bool) ->+  -- | A candidate left-identity+  b ->+  Gen a ->+  (a -> [a]) ->+  Property leftIdentityOnGenWithEquality op eq b gen s =-    forAllShrink gen s $ leftIdentityOnElemWithEquality op eq b+  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+  (Show a, Eq a) =>+  -- | A binary operation+  (b -> a -> a) ->+  -- | A candidate left-identity+  b ->+  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+leftIdentity :: (Show a, Eq a, GenValid a) => (b -> a -> a) -> b -> Property+leftIdentity op b = leftIdentityOnGen op b genValid shrinkValid  -- | -- -- prop> leftIdentityOnArbitrary (flip ((^) :: Int -> Int -> Int)) 1 leftIdentityOnArbitrary ::-       (Show a, Eq a, Arbitrary a) => (b -> a -> a) -> b -> Property+  (Show a, Eq a, Arbitrary a) => (b -> a -> a) -> b -> Property leftIdentityOnArbitrary op b = leftIdentityOnGen op b arbitrary shrink  -- |@@ -87,52 +86,54 @@ --   \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+  -- | A binary operation+  (a -> b -> a) ->+  -- | An equality+  (a -> a -> Bool) ->+  -- | A candidate right-identity+  b ->+  -- | An element+  a ->+  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+  Show a =>+  -- | A binary operation+  (a -> b -> a) ->+  -- | An equality+  (a -> a -> Bool) ->+  -- | A candidate right-identity+  b ->+  Gen a ->+  (a -> [a]) ->+  Property rightIdentityOnGenWithEquality op eq b gen s =-    forAllShrink gen s $ rightIdentityOnElemWithEquality op eq b+  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+  (Show a, Eq a) =>+  -- | A binary operation+  (a -> b -> a) ->+  -- | A candidate right-identity+  b ->+  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+  (Show a, Eq a, GenValid a) => (a -> b -> a) -> b -> Property+rightIdentity op b = rightIdentityOnGen op b genValid shrinkValid  -- | -- -- prop> rightIdentityOnArbitrary ((^) :: Int -> Int -> Int) 1 rightIdentityOnArbitrary ::-       (Show a, Eq a, Arbitrary a) => (a -> b -> a) -> b -> Property+  (Show a, Eq a, Arbitrary a) => (a -> b -> a) -> b -> Property rightIdentityOnArbitrary op b = rightIdentityOnGen op b arbitrary shrink  -- |@@ -143,28 +144,21 @@ --   LeftIdentity(\star, \doteq, b) \wedge RightIdentity(\star, \doteq, b) -- \] identityOnGen ::-       (Show a, Eq a) => (a -> a -> a) -> a -> Gen a -> (a -> [a]) -> Property+  (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+  leftIdentityOnGen op e gen s .&&. rightIdentityOnGen op e gen s  -- | -- -- 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+identity :: (Show a, Eq a, GenValid a) => (a -> a -> a) -> a -> Property+identity op e = identityOnGen op e genValid shrinkValid  -- | -- -- prop> identityOnArbitrary ((*) :: Int -> Int -> Int) 1 -- prop> identityOnArbitrary ((+) :: Int -> Int -> Int) 0 identityOnArbitrary ::-       (Show a, Eq a, Arbitrary a) => (a -> a -> a) -> a -> Property+  (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
@@ -9,8 +9,6 @@ -- You will need @TypeApplications@ to use these. module Test.Syd.Validity.Ord   ( ordSpecOnGen,-    ordSpecOnValid,-    ordSpecOnInvalid,     ordSpec,     ordSpecOnArbitrary,   )@@ -60,34 +58,12 @@ -- -- 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) =>+  (Show a, Ord a, Typeable a, GenValid a) =>   Spec-ordSpec = ordSpecOnGen @a genUnchecked "unchecked" shrinkUnchecked+ordSpec = ordSpecOnGen @a genValid "valid" shrinkValid  -- | Standard test spec for properties of Ord instances for arbitrary values --
src/Test/Syd/Validity/Property.hs view
@@ -2,192 +2,188 @@ {-# 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+  ( module Data.GenValidity,+    forAllValid, -import Data.GenValidity+    -- * Tests for GenValidity instances+    genGeneratesValid, +    -- * Standard tests involving functions++    -- ** Standard tests involving validity+    producesValidsOnGen,+    producesValid,+    producesValidsOnArbitrary,+    producesValidsOnGens2,+    producesValid2,+    producesValidsOnArbitrary2,+    producesValidsOnGens3,+    producesValid3,+    producesValidsOnArbitrary3,++    -- ** Standard tests involving functions that can fail+    CanFail (..),+    succeedsOnGen,+    succeeds,+    succeedsOnArbitrary,+    succeedsOnGens2,+    succeeds2,+    succeedsOnArbitrary2,+    failsOnGen,+    failsOnGens2,+    validIfSucceedsOnGen,+    validIfSucceedsOnArbitrary,+    validIfSucceeds,+    validIfSucceedsOnGens2,+    validIfSucceeds2,+    validIfSucceedsOnArbitrary2,+    validIfSucceedsOnGens3,+    validIfSucceeds3,+    validIfSucceedsOnArbitrary3,++    -- ** Standard tests involving equivalence of functions++    -- *** Simple functions++    -- **** One argument+    equivalentOnGen,+    equivalent,+    equivalentOnArbitrary,++    -- **** Two arguments+    equivalentOnGens2,+    equivalent2,+    equivalentOnArbitrary2,++    -- **** Three arguments+    equivalentOnGens3,+    equivalent3,+    equivalentOnArbitrary3,++    -- *** First function can fail++    -- **** One argument+    equivalentWhenFirstSucceedsOnGen,+    equivalentWhenFirstSucceeds,+    equivalentWhenFirstSucceedsOnArbitrary,++    -- **** Two arguments+    equivalentWhenFirstSucceedsOnGens2,+    equivalentWhenFirstSucceeds2,+    equivalentWhenFirstSucceedsOnArbitrary2,++    -- *** Second function can fail++    -- **** One argument+    equivalentWhenSecondSucceedsOnGen,+    equivalentWhenSecondSucceeds,+    equivalentWhenSecondSucceedsOnArbitrary,++    -- **** Two arguments+    equivalentWhenSecondSucceedsOnGens2,+    equivalentWhenSecondSucceeds2,+    equivalentWhenSecondSucceedsOnArbitrary2,++    -- *** Both functions can fail++    -- **** One argument+    equivalentWhenSucceedOnGen,+    equivalentWhenSucceed,+    equivalentWhenSucceedOnArbitrary,++    -- **** Two arguments+    equivalentWhenSucceedOnGens2,+    equivalentWhenSucceed2,+    equivalentWhenSucceedOnArbitrary2,++    -- ** Standard tests involving inverse functions+    inverseFunctionsOnGen,+    inverseFunctions,+    inverseFunctionsOnArbitrary,+    inverseFunctionsIfFirstSucceedsOnGen,+    inverseFunctionsIfFirstSucceeds,+    inverseFunctionsIfFirstSucceedsOnArbitrary,+    inverseFunctionsIfSecondSucceedsOnGen,+    inverseFunctionsIfSecondSucceeds,+    inverseFunctionsIfSecondSucceedsOnArbitrary,+    inverseFunctionsIfSucceedOnGen,+    inverseFunctionsIfSucceed,+    inverseFunctionsIfSucceedOnArbitrary,++    -- ** Properties involving idempotence+    idempotentOnGen,+    idempotent,+    idempotentOnArbitrary,++    -- * Properties of relations++    -- ** Reflexivity+    reflexiveOnElem,+    reflexivityOnGen,+    reflexivity,+    reflexivityOnArbitrary,++    -- ** Transitivity+    transitiveOnElems,+    transitivityOnGens,+    transitivity,+    transitivityOnArbitrary,++    -- ** Antisymmetry+    antisymmetricOnElemsWithEquality,+    antisymmetryOnGensWithEquality,+    antisymmetryOnGens,+    antisymmetry,+    antisymmetryOnArbitrary,++    -- ** Antireflexivity+    antireflexiveOnElem,+    antireflexivityOnGen,+    antireflexivity,+    antireflexivityOnArbitrary,++    -- ** Symmetry+    symmetricOnElems,+    symmetryOnGens,+    symmetry,+    symmetryOnArbitrary,++    -- * Properties of operations++    -- ** Identity element++    -- *** Left Identity+    leftIdentityOnElemWithEquality,+    leftIdentityOnGenWithEquality,+    leftIdentityOnGen,+    leftIdentity,+    leftIdentityOnArbitrary,++    -- *** Right Identity+    rightIdentityOnElemWithEquality,+    rightIdentityOnGenWithEquality,+    rightIdentityOnGen,+    rightIdentity,+    rightIdentityOnArbitrary,++    -- *** Identity+    identityOnGen,+    identity,+    identityOnArbitrary,++    -- ** Associativity+    associativeOnGens,+    associative,+    associativeOnArbitrary,++    -- ** Commutativity+    commutativeOnGens,+    commutative,+    commutativeOnArbitrary,+  )+where++import Data.GenValidity import Test.Syd.Validity.Functions import Test.Syd.Validity.GenValidity.Property import Test.Syd.Validity.Operations
src/Test/Syd/Validity/Property/Utils.hs view
@@ -1,9 +1,5 @@-{-# LANGUAGE CPP #-}- module Test.Syd.Validity.Property.Utils-  ( forAllUnchecked,-    forAllValid,-    forAllInvalid,+  ( forAllValid,     shouldBeValid,     shouldBeInvalid,     (<==>),@@ -15,20 +11,8 @@ 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
src/Test/Syd/Validity/Relations.hs view
@@ -3,33 +3,13 @@  -- | 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+  ( module Test.Syd.Validity.Relations.Antireflexivity,+    module Test.Syd.Validity.Relations.Antisymmetry,+    module Test.Syd.Validity.Relations.Reflexivity,+    module Test.Syd.Validity.Relations.Symmetry,+    module Test.Syd.Validity.Relations.Transitivity,+  )+where  import Test.Syd.Validity.Relations.Antireflexivity import Test.Syd.Validity.Relations.Antisymmetry
src/Test/Syd/Validity/Relations/Antireflexivity.hs view
@@ -2,15 +2,14 @@ {-# LANGUAGE ScopedTypeVariables #-}  module Test.Syd.Validity.Relations.Antireflexivity-    ( antireflexiveOnElem-    , antireflexivityOnGen-    , antireflexivityOnValid-    , antireflexivity-    , antireflexivityOnArbitrary-    ) where+  ( antireflexiveOnElem,+    antireflexivityOnGen,+    antireflexivity,+    antireflexivityOnArbitrary,+  )+where  import Data.GenValidity- import Test.QuickCheck  -- |@@ -21,30 +20,24 @@ --   \forall a: \neg (a \prec a) -- \] antireflexiveOnElem ::-       (a -> a -> Bool) -- ^ A relation-    -> a -- ^ An element-    -> Bool+  -- | A relation+  (a -> a -> Bool) ->+  -- | An element+  a ->+  Bool antireflexiveOnElem func a = not $ func a a  antireflexivityOnGen ::-       Show a => (a -> a -> Bool) -> Gen a -> (a -> [a]) -> Property+  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+antireflexivity :: (Show a, GenValid a) => (a -> a -> Bool) -> Property+antireflexivity func = antireflexivityOnGen func genValid shrinkValid  -- | --@@ -52,5 +45,5 @@ -- prop> antireflexivityOnArbitrary ((/=) :: Int -> Int -> Bool) -- prop> antireflexivityOnArbitrary ((>) :: Int -> Int -> Bool) antireflexivityOnArbitrary ::-       (Show a, Arbitrary a) => (a -> a -> Bool) -> Property+  (Show a, Arbitrary a) => (a -> a -> Bool) -> Property antireflexivityOnArbitrary func = antireflexivityOnGen func arbitrary shrink
src/Test/Syd/Validity/Relations/Antisymmetry.hs view
@@ -2,18 +2,16 @@ {-# LANGUAGE ScopedTypeVariables #-}  module Test.Syd.Validity.Relations.Antisymmetry-    ( antisymmetricOnElemsWithEquality-    , antisymmetryOnGensWithEquality-    , antisymmetryOnGens-    , antisymmetryOnValid-    , antisymmetry-    , antisymmetryOnArbitrary-    ) where+  ( antisymmetricOnElemsWithEquality,+    antisymmetryOnGensWithEquality,+    antisymmetryOnGens,+    antisymmetry,+    antisymmetryOnArbitrary,+  )+where  import Data.GenValidity- import Test.QuickCheck- import Test.Syd.Validity.Property.Utils  -- |@@ -24,48 +22,38 @@ --   \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+  -- | A relation+  (a -> a -> Bool) ->+  -- | An equivalence relation+  (a -> a -> Bool) ->+  a ->+  -- | Two elements+  a ->+  Bool antisymmetricOnElemsWithEquality func eq a b =-    (func a b && func b a) ===> (a `eq` 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+  Show a =>+  (a -> a -> Bool) ->+  Gen (a, a) ->+  (a -> a -> Bool) ->+  (a -> [a]) ->+  Property antisymmetryOnGensWithEquality func gen eq s =-    forAllShrink gen (shrinkT2 s) $+  forAllShrink gen (shrinkT2 s) $     uncurry $ antisymmetricOnElemsWithEquality func eq  antisymmetryOnGens ::-       (Show a, Eq a)-    => (a -> a -> Bool)-    -> Gen (a, a)-    -> (a -> [a])-    -> Property+  (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)@@ -74,8 +62,8 @@ -- 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+antisymmetry :: (Show a, Eq a, GenValid a) => (a -> a -> Bool) -> Property+antisymmetry func = antisymmetryOnGens func genValid shrinkValid  -- | --@@ -88,5 +76,5 @@ -- 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+  (Show a, Eq a, Arbitrary a) => (a -> a -> Bool) -> Property antisymmetryOnArbitrary func = antisymmetryOnGens func arbitrary shrink
src/Test/Syd/Validity/Relations/Reflexivity.hs view
@@ -2,15 +2,14 @@ {-# LANGUAGE ScopedTypeVariables #-}  module Test.Syd.Validity.Relations.Reflexivity-    ( reflexiveOnElem-    , reflexivityOnGen-    , reflexivityOnValid-    , reflexivity-    , reflexivityOnArbitrary-    ) where+  ( reflexiveOnElem,+    reflexivityOnGen,+    reflexivity,+    reflexivityOnArbitrary,+  )+where  import Data.GenValidity- import Test.QuickCheck  -- |@@ -21,36 +20,27 @@ --   \forall a: (a \prec a) -- \] reflexiveOnElem ::-       (a -> a -> Bool) -- ^ A relation-    -> a -- ^ An element-    -> Bool+  -- | A relation+  (a -> a -> Bool) ->+  -- | An element+  a ->+  Bool reflexiveOnElem func a = func a a  reflexivityOnGen ::-       Show a => (a -> a -> Bool) -> Gen a -> (a -> [a]) -> Property+  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+reflexivity :: (Show a, GenValid a) => (a -> a -> Bool) -> Property+reflexivity func = reflexivityOnGen func genValid shrinkValid  -- | --
src/Test/Syd/Validity/Relations/Symmetry.hs view
@@ -2,17 +2,15 @@ {-# LANGUAGE ScopedTypeVariables #-}  module Test.Syd.Validity.Relations.Symmetry-    ( symmetricOnElems-    , symmetryOnGens-    , symmetryOnValid-    , symmetry-    , symmetryOnArbitrary-    ) where+  ( symmetricOnElems,+    symmetryOnGens,+    symmetry,+    symmetryOnArbitrary,+  )+where  import Data.GenValidity- import Test.QuickCheck- import Test.Syd.Validity.Property.Utils  -- |@@ -23,30 +21,25 @@ --   \forall a, b: (a \prec b) \Leftrightarrow (b \prec a) -- \] symmetricOnElems ::-       (a -> a -> Bool) -- ^ A relation-    -> a-    -> a -- ^ Two elements-    -> Bool+  -- | A relation+  (a -> a -> Bool) ->+  a ->+  -- | Two elements+  a ->+  Bool symmetricOnElems func a b = func a b <==> func b a  symmetryOnGens ::-       Show a => (a -> a -> Bool) -> Gen (a, a) -> (a -> [a]) -> Property+  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+  forAllShrink gen (shrinkT2 s) $ uncurry $ symmetricOnElems func  -- | -- -- 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+symmetry :: (Show a, GenValid a) => (a -> a -> Bool) -> Property+symmetry func = symmetryOnGens func genValid shrinkValid  -- | --
src/Test/Syd/Validity/Relations/Transitivity.hs view
@@ -2,17 +2,15 @@ {-# LANGUAGE ScopedTypeVariables #-}  module Test.Syd.Validity.Relations.Transitivity-    ( transitiveOnElems-    , transitivityOnGens-    , transitivityOnValid-    , transitivity-    , transitivityOnArbitrary-    ) where+  ( transitiveOnElems,+    transitivityOnGens,+    transitivity,+    transitivityOnArbitrary,+  )+where  import Data.GenValidity- import Test.QuickCheck- import Test.Syd.Validity.Property.Utils  -- |@@ -23,30 +21,19 @@ --   \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+  -- | A relation+  (a -> a -> Bool) ->+  a ->+  a ->+  -- | Three elements+  a ->+  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+  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+  forAllShrink gen (shrinkT3 s) $ \(a, b, c) -> transitiveOnElems func a b c  -- | --@@ -58,8 +45,8 @@ -- 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+transitivity :: (Show a, GenValid a) => (a -> a -> Bool) -> Property+transitivity func = transitivityOnGens func genValid shrinkValid  -- | --
− src/Test/Syd/Validity/RelativeValidity.hs 
@@ -1,87 +0,0 @@-{-# 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
@@ -5,47 +5,32 @@  -- | 'Show' and 'Read' properties module Test.Syd.Validity.Show-    ( showReadSpecOnValid-    , showReadSpec-    , showReadSpecOnArbitrary-    , showReadSpecOnGen-    , showReadRoundTripOnValid-    , showReadRoundTrip-    , showReadRoundTripOnArbitrary-    , showReadRoundTripOnGen-    ) where--import Data.GenValidity+  ( showReadSpec,+    showReadSpecOnArbitrary,+    showReadSpecOnGen,+    showReadRoundTrip,+    showReadRoundTripOnArbitrary,+    showReadRoundTripOnGen,+  )+where  import Data.Data--import Text.Read--import Test.Syd+import Data.GenValidity import Test.QuickCheck-+import Test.Syd import Test.Syd.Validity.Utils+import Text.Read  -- | 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-+  forall a.+  (Show a, Eq a, Read a, Typeable a, GenValid a) =>+  Spec+showReadSpec = showReadSpecOnGen @a genValid "valid" shrinkValid  -- | Standard test spec for properties of Show and Read instances for arbitrary values --@@ -53,8 +38,9 @@ -- -- > showReadSpecOnArbitrary @Double showReadSpecOnArbitrary ::-       forall a. (Show a, Eq a, Read a, Typeable a, Arbitrary a)-    => Spec+  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@@ -63,47 +49,41 @@ -- -- > showReadSpecOnGen ((* 2) <$> genValid @Int) "even" (const []) showReadSpecOnGen ::-       forall a. (Show a, Eq a, Read a, Typeable a)-    => Gen a-    -> String-    -> (a -> [a])-    -> Spec+  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]) $+  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+      showReadRoundTripOnGen gen s  -- | -- -- prop> showReadRoundTrip @Int showReadRoundTrip ::-       forall a. (Show a, Eq a, Read a, GenUnchecked a)-    => Property+  forall a.+  (Show a, Eq a, Read a, GenValid a) =>+  Property showReadRoundTrip =-    showReadRoundTripOnGen (genUnchecked :: Gen a) shrinkUnchecked+  showReadRoundTripOnGen (genValid :: Gen a) shrinkValid  -- | -- -- prop> showReadRoundTripOnArbitrary @Double showReadRoundTripOnArbitrary ::-       forall a. (Show a, Eq a, Read a, Arbitrary a)-    => Property+  forall a.+  (Show a, Eq a, Read a, Arbitrary a) =>+  Property showReadRoundTripOnArbitrary =-    showReadRoundTripOnGen (arbitrary :: Gen a) shrink+  showReadRoundTripOnGen (arbitrary :: Gen a) shrink  -- | ----- prop> showReadRoundTripOnGen (abs <$> genUnchecked :: Gen Int) (const [])+-- prop> showReadRoundTripOnGen (abs <$> genValid :: Gen Int) (const []) showReadRoundTripOnGen ::-       (Show a, Eq a, Read a) => Gen a -> (a -> [a]) -> Property+  (Show a, Eq a, Read a) => Gen a -> (a -> [a]) -> Property showReadRoundTripOnGen gen s =-    forAllShrink gen s $ \v -> readMaybe (show v) `shouldBe` Just v+  forAllShrink gen s $ \v -> readMaybe (show v) `shouldBe` Just v
src/Test/Syd/Validity/Shrinking.hs view
@@ -1,143 +1,89 @@-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}  -- | 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+  ( shrinkValidSpec,+    shrinkValidSpecWithLimit,+    shrinkValidPreservesValidOnGenValid,+    shrinkValidPreservesValidOnGenValidWithLimit,+    shrinkPreservesValidOnGenValid,+    shrinkValidPreservesValid,+    shrinkingStaysValid,+    shrinkingPreserves,+    shrinkValidDoesNotShrinkToItself,+    shrinkValidDoesNotShrinkToItselfWithLimit,+  )+where +import Control.Monad import Data.Data- import Data.GenValidity--import Control.Monad--import Test.Syd import Test.QuickCheck-+import Test.Syd 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+  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+  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+  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+  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  shrinkValidPreservesValidOnGenValid ::-       forall a. (Show a, GenValid a)-    => Property+  forall a.+  (Show a, GenValid a) =>+  Property shrinkValidPreservesValidOnGenValid =-    shrinkingStaysValid @a genValid shrinkValid+  shrinkingStaysValid @a genValid shrinkValid  shrinkValidPreservesValidOnGenValidWithLimit ::-       forall a. (Show a, GenValid a)-    => Int-    -> Property+  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+  shrinkingStaysValidWithLimit @a genValid shrinkValid  shrinkValidDoesNotShrinkToItself ::-       forall a. (Show a, Eq a, GenValid a)-    => Property+  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+  shrinkDoesNotShrinkToItself @a shrinkValid  shrinkValidDoesNotShrinkToItselfWithLimit ::-       forall a. (Show a, Eq a, GenValid a)-    => Int-    -> Property+  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+  shrinkDoesNotShrinkToItselfOnValidWithLimit @a shrinkValid
src/Test/Syd/Validity/Shrinking/Property.hs view
@@ -1,201 +1,161 @@-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# 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+  ( shrinkPreservesValidOnGenValid,+    shrinkValidPreservesValid,+    shrinkingStaysValid,+    shrinkingStaysValidWithLimit,+    shrinkingPreserves,+    shrinkingPreservesWithLimit,+    shrinkDoesNotShrinkToItself,+    shrinkDoesNotShrinkToItselfWithLimit,+    shrinkDoesNotShrinkToItselfOnValid,+    shrinkDoesNotShrinkToItselfOnValidWithLimit,+    doesNotShrinkToItself,+    doesNotShrinkToItselfWithLimit,+  )+where  import Data.GenValidity- import Test.QuickCheck  -- | -- -- prop> shrinkPreservesValidOnGenValid ((:[]) :: Int -> [Int]) shrinkPreservesValidOnGenValid ::-       forall a. (Show a, GenValid a)-    => (a -> [a])-    -> Property+  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+  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+  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+  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+  shrinkingPreservesWithLimit gen s l isValid  -- | -- -- prop> shrinkingPreserves (pure 5 :: Gen Int) (:[]) (== 5) shrinkingPreserves ::-       forall a. Show a-    => Gen a-    -> (a -> [a])-    -> (a -> Bool)-    -> Property+  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+  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)+  forAll gen $ \d -> not (p d) || all p (take l $ s d)  -- | ----- prop> shrinkDoesNotShrinkToItself (shrinkUnchecked :: Double -> [Double])+-- prop> shrinkDoesNotShrinkToItself (shrinkValid :: Double -> [Double]) shrinkDoesNotShrinkToItself ::-       forall a. (Show a, Eq a, GenUnchecked a)-    => (a -> [a])-    -> Property-shrinkDoesNotShrinkToItself = doesNotShrinkToItself genUnchecked+  forall a.+  (Show a, Eq a, GenValid a) =>+  (a -> [a]) ->+  Property+shrinkDoesNotShrinkToItself = doesNotShrinkToItself genValid  -- | ----- prop> shrinkDoesNotShrinkToItselfWithLimit (shrinkUnchecked :: Double -> [Double]) 100+-- prop> shrinkDoesNotShrinkToItselfWithLimit (shrinkValid :: Double -> [Double]) 100 shrinkDoesNotShrinkToItselfWithLimit ::-       forall a. (Show a, Eq a, GenUnchecked a)-    => (a -> [a])-    -> Int-    -> Property+  forall a.+  (Show a, Eq a, GenValid a) =>+  (a -> [a]) ->+  Int ->+  Property shrinkDoesNotShrinkToItselfWithLimit =-    doesNotShrinkToItselfWithLimit genUnchecked+  doesNotShrinkToItselfWithLimit genValid  -- | -- -- prop> shrinkDoesNotShrinkToItselfOnValid (shrinkValid ::  Rational -> [Rational]) shrinkDoesNotShrinkToItselfOnValid ::-       forall a. (Show a, Eq a, GenValid a)-    => (a -> [a])-    -> Property+  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+  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+  doesNotShrinkToItselfWithLimit genValid  -- | ----- prop> doesNotShrinkToItself (pure 5 :: Gen Double) shrinkUnchecked+-- prop> doesNotShrinkToItself (pure 5 :: Gen Double) shrinkValid doesNotShrinkToItself ::-       forall a. (Show a, Eq a)-    => Gen a-    -> (a -> [a])-    -> Property-doesNotShrinkToItself gen s = forAll gen $ \a -> all (/= a) $ s a+  forall a.+  (Show a, Eq a) =>+  Gen a ->+  (a -> [a]) ->+  Property+doesNotShrinkToItself gen s = forAll gen $ \a -> notElem a $ s a  -- | ----- prop> doesNotShrinkToItselfWithLimit (pure 5 :: Gen Double) shrinkUnchecked 100+-- prop> doesNotShrinkToItselfWithLimit (pure 5 :: Gen Double) shrinkValid 100 doesNotShrinkToItselfWithLimit ::-       forall a. (Show a, Eq a)-    => Gen a-    -> (a -> [a])-    -> Int-    -> Property+  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+  forAll gen $ \a -> notElem a $ take l $ s a
src/Test/Syd/Validity/Types.hs view
@@ -2,22 +2,23 @@ {-# LANGUAGE ScopedTypeVariables #-}  module Test.Syd.Validity.Types-    ( CanFail(..)-    ) where+  ( 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+  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+  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+  hasFailed (Left _) = True+  hasFailed _ = False+  resultIfSucceeded (Left _) = Nothing+  resultIfSucceeded (Right r) = Just r
src/Test/Syd/Validity/Utils.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-}
test/Test/Syd/Validity/ApplicativeSpec.hs view
@@ -2,47 +2,44 @@  module Test.Syd.Validity.ApplicativeSpec where -import Test.Syd- import Data.GenValidity+import Test.Syd 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"+  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
@@ -3,7 +3,6 @@ module Test.Syd.Validity.ArbitrarySpec where  import Test.Syd- import Test.Syd.Validity.Arbitrary  spec :: Spec
test/Test/Syd/Validity/EqSpec.hs view
@@ -11,7 +11,7 @@  spec :: Spec spec = do-  eqSpecOnValid @Rational+  eqSpec @Rational   eqSpec @Int   -- eqSpec @Double DOES NOT HOLD because of NaN   eqSpecOnArbitrary @Int
test/Test/Syd/Validity/FunctorSpec.hs view
@@ -12,8 +12,6 @@   functorSpec @Maybe   functorSpec @(Either Int)   functorSpec @((,) Int)-  functorSpecOnValid @[]-  functorSpecOnValid @Maybe   functorSpecOnArbitrary @[]   functorSpecOnArbitrary @Maybe   functorSpecOnGens
test/Test/Syd/Validity/GenValiditySpec.hs view
@@ -3,11 +3,9 @@ module Test.Syd.Validity.GenValiditySpec where  import Test.Syd- import Test.Syd.Validity.GenValidity  spec :: Spec spec = do-    genValiditySpec @Rational-    genValidSpec @Rational-    genInvalidSpec @Rational+  genValidSpec @Rational+  genValidSpec @Rational
test/Test/Syd/Validity/MonadSpec.hs view
@@ -2,53 +2,50 @@  module Test.Syd.Validity.MonadSpec where -import Test.Syd- import Data.GenValidity+import Test.Syd 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"+  monadSpec @[]+  monadSpec @Maybe+  monadSpec @(Either Int)+  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
@@ -3,12 +3,11 @@ 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 [])+  monoidSpec @[Rational]+  monoidSpec @[Int]+  monoidSpecOnArbitrary @[Int]+  monoidSpecOnGen (pure "a") "singleton list of 'a'" (const [])
test/Test/Syd/Validity/Operations/CommutativitySpec.hs view
@@ -1,13 +1,13 @@ {-# LANGUAGE TypeApplications #-}  module Test.Syd.Validity.Operations.CommutativitySpec-    ( spec-    ) where+  ( spec,+  )+where -import Test.Syd+import Data.GenValidity (GenValid) import Test.QuickCheck-import Data.GenValidity (GenUnchecked)-+import Test.Syd import Test.Syd.Validity.Operations.Commutativity (commutative)  spec :: Spec@@ -20,7 +20,7 @@     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 :: (Show a, Show b, Eq b, GenValid a) => (a -> a -> b) -> Property notCommmutative op = expectFailure (commutative op)  type Point = (Int, Int)
test/Test/Syd/Validity/OrdSpec.hs view
@@ -8,7 +8,7 @@  spec :: Spec spec = do-  ordSpecOnValid @Rational+  ordSpec @Rational   ordSpec @Int   ordSpecOnArbitrary @Int   ordSpecOnGen ((* 2) <$> genValid @Int) "even" (const [])
test/Test/Syd/Validity/ShowSpec.hs view
@@ -11,7 +11,7 @@  spec :: Spec spec = do-  showReadSpecOnValid @Rational+  showReadSpec @Rational   showReadSpec @Int   showReadSpecOnArbitrary @Rational   showReadSpecOnGen ((* 2) <$> genValid @Int) "even" (const [])
test/Test/Syd/Validity/ShrinkingSpec.hs view
@@ -9,20 +9,17 @@  spec :: Spec spec = do-  shrinkValiditySpec @(Ratio Int8)+  shrinkValidSpec @(Ratio Int8)   shrinkValidSpec @Int-  shrinkInvalidSpec @(Ratio Int8)-  describe "shrinkUncheckedPreservesValidOnGenValid" $ do+  describe "shrinkValidPreservesValidOnGenValid" $ 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 "Int" $ shrinkValidDoesNotShrinkToItself @Int+    it "[Int]" $ shrinkValidDoesNotShrinkToItself @[Int]   describe "shrinkValidDoesNotShrinkToItself" $ do     it "Ordering" $ shrinkValidDoesNotShrinkToItself @Ordering     it "[Ordering]" $ shrinkValidDoesNotShrinkToItself @[Ordering]