genvalidity-hspec 0.7.0.4 → 1.0.0.0

raw patch · 28 files changed

+1364/−1778 lines, 28 filesdep ~genvaliditydep ~hspec-coresetup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: genvalidity, hspec-core

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−1
• LICENSE +1/−1
• Setup.hs +0/−3
• genvalidity-hspec.cabal +8/−10
• src/Test/Validity.hs +239/−260
• src/Test/Validity/Applicative.hs +212/−213
• src/Test/Validity/Arbitrary.hs +15/−15
• src/Test/Validity/Eq.hs +86/−99
• src/Test/Validity/Functor.hs +110/−117
• src/Test/Validity/GenRelativeValidity.hs +0/−122
• src/Test/Validity/GenValidity.hs +20/−70
• src/Test/Validity/Monad.hs +174/−174
• src/Test/Validity/Monoid.hs +73/−65
• src/Test/Validity/Ord.hs +92/−107
• src/Test/Validity/RelativeValidity.hs +0/−87
• src/Test/Validity/Show.hs +36/−56
• src/Test/Validity/Shrinking.hs +57/−111
• src/Test/Validity/Utils.hs +57/−78
• test/Test/Validity/ApplicativeSpec.hs +36/−39
• test/Test/Validity/ArbitrarySpec.hs +0/−1
• test/Test/Validity/EqSpec.hs +20/−20
• test/Test/Validity/FunctorSpec.hs +41/−40
• test/Test/Validity/GenValiditySpec.hs +2/−4
• test/Test/Validity/MonadSpec.hs +40/−43
• test/Test/Validity/MonoidSpec.hs +4/−5
• test/Test/Validity/OrdSpec.hs +6/−7
• test/Test/Validity/ShowSpec.hs +18/−18
• test/Test/Validity/ShrinkingSpec.hs +6/−12

@@ -1,6 +1,16 @@ # Changelog -## [Unreleased]+### Changed++* Compatibility with `validity >= 0.12.0.0`+* 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.+* Everything related to `RelativeValidity`.+  ## [0.7.0.3] - 2020-02-10 

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

@@ -1,3 +0,0 @@-import Distribution.Simple--main = defaultMain

@@ -1,13 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack------ hash: f5acdda3f053861f0ebdb215817b65bc55fa4b9999a323a9875e7728b8b8f8f1  name:           genvalidity-hspec-version:        0.7.0.4+version:        1.0.0.0 synopsis:       Standard spec's for GenValidity instances description:    Note: There are companion packages for this library:                 .@@ -23,11 +21,12 @@ bug-reports:    https://github.com/NorfairKing/validity/issues author:         Tom Sydney Kerckhove maintainer:     syd@cs-syd.eu-copyright:      Copyright: (c) 2016-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@@ -41,12 +40,10 @@       Test.Validity.Arbitrary       Test.Validity.Eq       Test.Validity.Functor-      Test.Validity.GenRelativeValidity       Test.Validity.GenValidity       Test.Validity.Monad       Test.Validity.Monoid       Test.Validity.Ord-      Test.Validity.RelativeValidity       Test.Validity.Show       Test.Validity.Shrinking       Test.Validity.Utils@@ -54,13 +51,14 @@       Paths_genvalidity_hspec   hs-source-dirs:       src+  ghc-options: -Wall -fwarn-redundant-constraints   build-depends:       QuickCheck     , base >=4.9 && <5-    , genvalidity >=0.8+    , genvalidity >=1.0     , genvalidity-property >=0.5     , hspec-    , hspec-core+    , hspec-core >=2.5.0     , transformers     , validity >=0.5   default-language: Haskell2010@@ -91,5 +89,5 @@     , genvalidity     , genvalidity-hspec     , hspec-    , hspec-core+    , hspec-core >=2.5.0   default-language: Haskell2010

@@ -7,283 +7,262 @@ -- The most interesting functions in this module for most uses are: -- -- * 'genValidSpec'--- * 'eqSpecOnValid'--- * 'ordSpecOnValid'+-- * 'eqSpec'+-- * 'ordSpec' -- * 'producesValidsOnValids' -- * 'forAllValid' -- * 'shouldBeValid' module Test.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.Validity.Applicative import Test.Validity.Arbitrary import Test.Validity.Eq import Test.Validity.Functions import Test.Validity.Functor-import Test.Validity.GenRelativeValidity import Test.Validity.GenValidity import Test.Validity.Monad import Test.Validity.Monoid import Test.Validity.Operations import Test.Validity.Ord import Test.Validity.Property-import Test.Validity.RelativeValidity import Test.Validity.Show import Test.Validity.Shrinking import Test.Validity.Utils

@@ -1,115 +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.Validity.Applicative-    ( applicativeSpecOnValid-    , applicativeSpec-    , applicativeSpecOnArbitrary-    , applicativeSpecOnGens-    ) where+  ( applicativeSpec,+    applicativeSpecOnArbitrary,+    applicativeSpecOnGens,+  )+where  import Data.Data- import Data.GenValidity-+import Data.Kind import Test.Hspec import Test.QuickCheck- import Test.Validity.Functions import Test.Validity.Utils  {-# ANN module "HLint: ignore Avoid lambda" #-}  pureTypeStr ::-       forall (f :: * -> *). (Typeable f)-    => String+  forall (f :: Type -> Type).+  (Typeable f) =>+  String pureTypeStr = unwords ["pure", "::", "a", "->", nameOf @f, "a"]  seqTypeStr ::-       forall (f :: * -> *). (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 :: * -> *). (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 :: * -> *). (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 :: * -> *).-       (Eq (f Int), Show (f Int), Applicative f, Typeable f, GenValid (f Int))-    => Spec-applicativeSpecOnValid = applicativeSpecWithInts @f genValid---- | Standard test spec for properties of Applicative instances for values generated with GenUnchecked instances------ Example usage:------ > applicativeSpecOnArbitrary @[] applicativeSpec ::-       forall (f :: * -> *).-       ( Eq (f Int)-       , Show (f Int)-       , Applicative f-       , Typeable f-       , GenUnchecked (f Int)-       )-    => Spec-applicativeSpec = applicativeSpecWithInts @f genUnchecked+  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 --@@ -117,32 +108,32 @@ -- -- > applicativeSpecOnArbitrary @[] applicativeSpecOnArbitrary ::-       forall (f :: * -> *).-       (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 :: * -> *).-       (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). --@@ -166,119 +157,127 @@ -- >     (pure <$> (flip (++) <$> genValid)) -- >     "appends in a Just" applicativeSpecOnGens ::-       forall (f :: * -> *) (a :: *) (b :: *) (c :: *).-       ( Show a-       , Eq a-       , Show (f a)-       , Eq (f a)-       , Show (f b)-       , Eq (f b)-       , Show (f c)-       , Eq (f c)-       , Applicative f-       , Typeable f-       , Typeable a-       , Typeable b-       , Typeable c-       )-    => Gen a-    -> String-    -> Gen (f a)-    -> String-    -> Gen (f b)-    -> String-    -> Gen (a -> b)-    -> String-    -> Gen (f (a -> b))-    -> String-    -> Gen (f (b -> c))-    -> String-    -> Spec+  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 *> 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

@@ -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.Validity.Arbitrary-    ( arbitrarySpec-    , arbitraryGeneratesOnlyValid-    ) where+  ( arbitrarySpec,+    arbitraryGeneratesOnlyValid,+  )+where  import Data.Data- import Data.GenValidity- import Test.Hspec import Test.QuickCheck- import Test.Validity.GenValidity import Test.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

@@ -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.Validity.Eq-    ( eqSpecOnValid-    , eqSpecOnInvalid-    , eqSpec-    , eqSpecOnArbitrary-    , eqSpecOnGen-    ) where+  ( eqSpec,+    eqSpecOnArbitrary,+    eqSpecOnGen,+  )+where  import Data.Data- import Data.GenValidity- import Test.Hspec import Test.QuickCheck- import Test.Validity.Functions import Test.Validity.Relations import Test.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

@@ -1,76 +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.Validity.Functor-    ( functorSpecOnValid-    , functorSpec-    , functorSpecOnArbitrary-    , functorSpecOnGens-    ) where+  ( functorSpec,+    functorSpecOnArbitrary,+    functorSpecOnGens,+  )+where  import Data.Data- import Data.GenValidity-+import Data.Kind import Test.Hspec import Test.QuickCheck- import Test.Validity.Functions import Test.Validity.Utils  {-# ANN module "HLint: ignore Functor law" #-}  fmapTypeStr ::-       forall (f :: * -> *). (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 :: * -> *). (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 :: * -> *).-       (Eq (f Int), Show (f Int), Functor f, Typeable f, GenValid (f Int))-    => Spec-functorSpecOnValid = functorSpecWithInts @f genValid---- | Standard test spec for properties of Functor instances for values generated with GenUnchecked instances------ Example usage:------ > functorSpecOnArbitrary @[] functorSpec ::-       forall (f :: * -> *).-       (Eq (f Int), Show (f Int), Functor f, Typeable f, GenUnchecked (f Int))-    => Spec-functorSpec = functorSpecWithInts @f genUnchecked+  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 --@@ -78,27 +67,28 @@ -- -- > functorSpecOnArbitrary @[] functorSpecOnArbitrary ::-       forall (f :: * -> *).-       (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 :: * -> *). (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). --@@ -112,61 +102,64 @@ -- >     ((+) <$> genValid) "additions" -- >     ((*) <$> genValid) "multiplications" functorSpecOnGens ::-       forall (f :: * -> *) (a :: *) (b :: *) (c :: *).-       ( Show a-       , Show (f a)-       , Show (f c)-       , Eq (f a)-       , Eq (f c)-       , Functor f-       , Typeable f-       , Typeable a-       , Typeable b-       , Typeable c-       )-    => Gen a-    -> String-    -> Gen (f a)-    -> String-    -> Gen (b -> c)-    -> String-    -> Gen (a -> b)-    -> String-    -> Spec+  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

@@ -1,122 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}---- | Tests for GenRelativeValidity instances------ You will need @TypeApplications@ to use these.-module Test.Validity.GenRelativeValidity-    ( genRelativeValiditySpec-    , genRelativeValidSpec-    , genRelativeInvalidSpec-    , genRelativeValidGeneratesValid-    , genRelativeInvalidGeneratesInvalid-    ) where--import Data.Data--import Data.GenRelativeValidity-import Data.GenValidity--import Test.Hspec-import Test.QuickCheck--import Test.Validity.Property.Utils-import Test.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-       , Typeable b-       , 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-       , Typeable b-       , Show a-       , Show b-       , GenValid a-       , GenValid b-       , RelativeValidity a b-       , GenRelativeValid a b-       )-    => Spec-genRelativeValidSpec =-    parallel $ do-        let nameOne = nameOf @a-        let nameTwo = nameOf @a-        describe ("GenRelativeValidity " ++ nameOne ++ " " ++ nameTwo) $-            describe ("genValidFor   :: " ++ nameTwo ++ " -> Gen " ++ nameOne) $-            it-                ("only generates valid \'" ++-                 nameOne ++ "\'s for the " ++ nameTwo) $-            genRelativeValidGeneratesValid @a @b--genRelativeInvalidSpec ::-       forall a b.-       ( Typeable a-       , Typeable b-       , Show a-       , Show b-       , GenValid a-       , GenUnchecked b-       , GenValid b-       , RelativeValidity a 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, RelativeValidity a 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-       , RelativeValidity a b-       , GenRelativeInvalid a b-       )-    => Property-genRelativeInvalidGeneratesInvalid =-    forAllUnchecked $ \(b :: b) ->-        forAll (genInvalidFor b) $ \(a :: a) ->-            a `shouldNotSatisfy` (`isValidFor` b)

@@ -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.Validity.GenValidity-    ( genValiditySpec-    , genValidSpec-    , genInvalidSpec-    , genValidGeneratesValid-    , genGeneratesValid-    , genInvalidGeneratesInvalid-    , genGeneratesInvalid-    ) where+  ( genValidSpec,+    genValidGeneratesValid,+    genGeneratesValid,+    genGeneratesInvalid,+  )+where  import Data.Data- import Data.GenValidity- import Test.Hspec import Test.QuickCheck- import Test.Validity.GenValidity.Property import Test.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

@@ -1,29 +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.Validity.Monad-    ( monadSpecOnValid-    , monadSpec-    , monadSpecOnArbitrary-    , monadSpecOnGens-    ) where--import Data.Data+  ( monadSpec,+    monadSpecOnArbitrary,+    monadSpecOnGens,+  )+where  import Control.Monad (ap)+import Data.Data import Data.GenValidity-import Test.QuickCheck.Gen (unGen)-import Test.QuickCheck.Random (mkQCGen)-+import Data.Kind (Type) import Test.Hspec import Test.QuickCheck-+import Test.QuickCheck.Gen (unGen)+import Test.QuickCheck.Random (mkQCGen) import Test.Validity.Functions import Test.Validity.Utils @@ -44,50 +42,41 @@ {-# ANN module "HLint: ignore Reduce duplication" #-}  returnTypeStr ::-       forall (m :: * -> *). (Typeable m)-    => String+  forall (m :: Type -> Type).+  (Typeable m) =>+  String returnTypeStr = unwords ["return", "::", "a", "->", nameOf @m, "a"]  bindTypeStr ::-       forall (m :: * -> *). (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 :: * -> *).-       (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 :: * -> *).-       (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 --@@ -95,35 +84,40 @@ -- -- > monadSpecOnArbitrary @[] monadSpecOnArbitrary ::-       forall (f :: * -> *).-       (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 :: * -> *). (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). --@@ -147,107 +141,113 @@ -- >     (pure $ pure (+ 1)) -- >     "increment in list" monadSpecOnGens ::-       forall (f :: * -> *) (a :: *) (b :: *) (c :: *).-       ( Show a-       , Eq a-       , Show (f a)-       , Show (f b)-       , Show (f c)-       , Eq (f a)-       , Eq (f b)-       , Eq (f c)-       , Monad f-       , Typeable f-       , Typeable a-       , Typeable b-       , Typeable c-       )-    => Gen a-    -> String-    -> Gen (f a)-    -> String-    -> Gen (f b)-    -> String-    -> Gen (a -> b)-    -> String-    -> Gen (a -> f b)-    -> String-    -> Gen (b -> f c)-    -> String-    -> Gen (f (a -> b))-    -> String-    -> Spec+  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

@@ -1,44 +1,45 @@+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}  -- | Monoid properties -- -- You will need @TypeApplications@ to use these. module Test.Validity.Monoid-    ( monoidSpecOnValid-    , monoidSpec-    , monoidSpecOnArbitrary-    , monoidSpecOnGen-    ) where+  ( monoidSpecOnValid,+    monoidSpec,+    monoidSpecOnArbitrary,+    monoidSpecOnGen,+  )+where  import Data.Data- import Data.GenValidity- import Test.Hspec import Test.QuickCheck- import Test.Validity.Functions import Test.Validity.Operations import Test.Validity.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@@ -49,19 +50,21 @@ -- -- > monoidSpecOnValid @[Double] monoidSpecOnValid ::-       forall a. (Show a, Eq a, Monoid a, Typeable a, GenValid a)-    => Spec+  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+-- | Standard test spec for properties of 'Monoid' instances for valid 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 +72,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 +83,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

@@ -1,26 +1,22 @@+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}  -- | Ord properties -- -- You will need @TypeApplications@ to use these. module Test.Validity.Ord-    ( ordSpecOnGen-    , ordSpecOnValid-    , ordSpecOnInvalid-    , ordSpec-    , ordSpecOnArbitrary-    ) where+  ( ordSpec,+    ordSpecOnGen,+    ordSpecOnArbitrary,+  )+where  import Data.Data- import Data.GenValidity- import Test.Hspec import Test.QuickCheck- import Test.Validity.Functions import Test.Validity.Relations import Test.Validity.Utils@@ -34,54 +30,39 @@ {-# ANN module "HLint: ignore Use >" #-}  leTypeStr ::-       forall a. Typeable a-    => String+  forall a.+  Typeable a =>+  String leTypeStr = binRelStr @a "<="  geTypeStr ::-       forall a. Typeable a-    => String+  forall a.+  Typeable a =>+  String geTypeStr = binRelStr @a ">="  ltTypeStr ::-       forall a. Typeable a-    => String+  forall a.+  Typeable a =>+  String ltTypeStr = binRelStr @a "<"  gtTypeStr ::-       forall a. Typeable a-    => String+  forall a.+  Typeable a =>+  String gtTypeStr = binRelStr @a ">"  -- | Standard test spec for properties of Ord instances for valid values -- -- Example usage: ----- > ordSpecOnValid @Double-ordSpecOnValid ::-       forall a. (Show a, Ord a, Typeable a, GenValid a)-    => Spec-ordSpecOnValid = ordSpecOnGen @a genValid "valid" shrinkValid---- | Standard test spec for properties of Ord instances for invalid values------ Example usage:------ > ordSpecOnInvalid @Double-ordSpecOnInvalid ::-       forall a. (Show a, Ord a, Typeable a, GenInvalid a)-    => Spec-ordSpecOnInvalid = ordSpecOnGen @a genInvalid "invalid" shrinkInvalid---- | Standard test spec for properties of Ord instances for unchecked values------ Example usage:--- -- > ordSpec @Int ordSpec ::-       forall a. (Show a, Ord a, Typeable a, GenUnchecked a)-    => Spec-ordSpec = ordSpecOnGen @a genUnchecked "unchecked" shrinkUnchecked+  forall a.+  (Show a, Ord a, Typeable a, GenValid a) =>+  Spec+ordSpec = ordSpecOnGen @a genValid "valid" shrinkValid  -- | Standard test spec for properties of Ord instances for arbitrary values --@@ -89,8 +70,9 @@ -- -- > ordSpecOnArbitrary @Int ordSpecOnArbitrary ::-       forall a. (Show a, Ord a, Typeable a, Arbitrary a)-    => Spec+  forall a.+  (Show a, Ord a, Typeable a, Arbitrary a) =>+  Spec ordSpecOnArbitrary = ordSpecOnGen @a arbitrary "arbitrary" shrink  -- | Standard test spec for properties of Ord instances for values generated by a given generator (and name for that generator).@@ -99,67 +81,70 @@ -- -- > ordSpecOnGen ((* 2) <$> genValid @Int) "even" ordSpecOnGen ::-       forall a. (Show a, Eq a, Ord a, Typeable a)-    => Gen a-    -> String-    -> (a -> [a])-    -> Spec+  forall a.+  (Show a, Ord a, Typeable a) =>+  Gen a ->+  String ->+  (a -> [a]) ->+  Spec ordSpecOnGen gen genname s =-    parallel $ do-        let name = nameOf @a-            funlestr = leTypeStr @a-            fungestr = geTypeStr @a-            funltstr = ltTypeStr @a-            fungtstr = gtTypeStr @a-            minmaxtstr = genDescr @(a->a->a)-            itProp s_ = it $ unwords-                [ s_-                  , "\"" ++ genname-                  , name ++ "\"" ++ "'s"-                ]-            cmple = (<=) @a-            cmpge = (>=) @a-            cmplt = (<) @a-            cmpgt = (>) @a-            gen2 = (,) <$> gen <*> gen-            gen3 = (,,) <$> gen <*> gen <*> gen-            s2 = shrinkT2 s-        describe ("Ord " ++ name) $ do-            describe funlestr $ do-                itProp "is reflexive for" $-                    reflexivityOnGen cmple gen s-                itProp "is antisymmetric for" $-                    antisymmetryOnGens cmple gen2 s-                itProp "is transitive for" $-                    transitivityOnGens cmple gen3 s-                itProp "is equivalent to (\\a b -> compare a b /= GT) for" $-                    equivalentOnGens2 cmple (\a b -> compare a b /= GT) gen2 s2-            describe fungestr $ do-                itProp "is reflexive for" $-                    reflexivityOnGen cmpge gen s-                itProp "is antisymmetric for" $-                    antisymmetryOnGens cmpge gen2 s-                itProp "is transitive for" $-                    transitivityOnGens cmpge gen3 s-                itProp "is equivalent to (\\a b -> compare a b /= LT) for" $-                    equivalentOnGens2 cmpge (\a b -> compare a b /= LT) gen2 s2-            describe funltstr $ do-                itProp "is antireflexive for" $-                    antireflexivityOnGen cmplt gen s-                itProp "is transitive for" $-                    transitivityOnGens cmplt gen3 s-                itProp "is equivalent to (\\a b -> compare a b == LT) for" $-                    equivalentOnGens2 cmplt (\a b -> compare a b == LT) gen2 s2-            describe fungtstr $ do-                itProp "is antireflexive for" $-                    antireflexivityOnGen cmpgt gen s-                itProp "is transitive for" $-                    transitivityOnGens cmpgt gen3 s-                itProp "is equivalent to (\\a b -> compare a b == GT) for" $-                    equivalentOnGens2 cmpgt (\a b -> compare a b == GT) gen2 s2-            describe (minmaxtstr "min") $ do-                itProp "is equivalent to (\\a b -> if a <= b then a else b) for" $-                    equivalentOnGens2 min (\a b -> if a <= b then a else b) gen2 s2-            describe (minmaxtstr "max") $ do-                itProp "is equivalent to (\\a b -> if a >= b then a else b) for" $-                    equivalentOnGens2 max (\a b -> if a >= b then a else b) gen2 s2+  parallel $ do+    let name = nameOf @a+        funlestr = leTypeStr @a+        fungestr = geTypeStr @a+        funltstr = ltTypeStr @a+        fungtstr = gtTypeStr @a+        minmaxtstr = genDescr @(a -> a -> a)+        itProp s_ =+          it $+            unwords+              [ s_,+                "\"" ++ genname,+                name ++ "\"" ++ "'s"+              ]+        cmple = (<=) @a+        cmpge = (>=) @a+        cmplt = (<) @a+        cmpgt = (>) @a+        gen2 = (,) <$> gen <*> gen+        gen3 = (,,) <$> gen <*> gen <*> gen+        s2 = shrinkT2 s+    describe ("Ord " ++ name) $ do+      describe funlestr $ do+        itProp "is reflexive for" $+          reflexivityOnGen cmple gen s+        itProp "is antisymmetric for" $+          antisymmetryOnGens cmple gen2 s+        itProp "is transitive for" $+          transitivityOnGens cmple gen3 s+        itProp "is equivalent to (\\a b -> compare a b /= GT) for" $+          equivalentOnGens2 cmple (\a b -> compare a b /= GT) gen2 s2+      describe fungestr $ do+        itProp "is reflexive for" $+          reflexivityOnGen cmpge gen s+        itProp "is antisymmetric for" $+          antisymmetryOnGens cmpge gen2 s+        itProp "is transitive for" $+          transitivityOnGens cmpge gen3 s+        itProp "is equivalent to (\\a b -> compare a b /= LT) for" $+          equivalentOnGens2 cmpge (\a b -> compare a b /= LT) gen2 s2+      describe funltstr $ do+        itProp "is antireflexive for" $+          antireflexivityOnGen cmplt gen s+        itProp "is transitive for" $+          transitivityOnGens cmplt gen3 s+        itProp "is equivalent to (\\a b -> compare a b == LT) for" $+          equivalentOnGens2 cmplt (\a b -> compare a b == LT) gen2 s2+      describe fungtstr $ do+        itProp "is antireflexive for" $+          antireflexivityOnGen cmpgt gen s+        itProp "is transitive for" $+          transitivityOnGens cmpgt gen3 s+        itProp "is equivalent to (\\a b -> compare a b == GT) for" $+          equivalentOnGens2 cmpgt (\a b -> compare a b == GT) gen2 s2+      describe (minmaxtstr "min") $ do+        itProp "is equivalent to (\\a b -> if a <= b then a else b) for" $+          equivalentOnGens2 min (\a b -> if a <= b then a else b) gen2 s2+      describe (minmaxtstr "max") $ do+        itProp "is equivalent to (\\a b -> if a >= b then a else b) for" $+          equivalentOnGens2 max (\a b -> if a >= b then a else b) gen2 s2

@@ -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.Validity.RelativeValidity-    ( relativeValiditySpec-    , relativeValidityImpliesValidA-    , relativeValidityImpliesValidB-    ) where--import Data.Data--import Data.GenRelativeValidity-import Data.GenValidity--import Test.Hspec-import Test.QuickCheck--import Test.Validity.Property.Utils-import Test.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

@@ -5,47 +5,32 @@  -- | 'Show' and 'Read' properties module Test.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 Data.GenValidity import Test.Hspec import Test.QuickCheck- import Test.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

@@ -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.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.Hspec import Test.QuickCheck- import Test.Validity.Shrinking.Property import Test.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, GenUnchecked 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, GenUnchecked a, GenInvalid a)-    => Int-    -> Property-shrinkInvalidDoesNotShrinkToItselfWithLimit =-    shrinkDoesNotShrinkToItselfWithLimit @a shrinkInvalid+  shrinkDoesNotShrinkToItself @a shrinkValid  shrinkValidDoesNotShrinkToItselfWithLimit ::-       forall a. (Show a, Eq a, GenUnchecked a, GenValid a)-    => Int-    -> Property+  forall a.+  (Show a, Eq a, GenValid a) =>+  Int ->+  Property shrinkValidDoesNotShrinkToItselfWithLimit =-    shrinkDoesNotShrinkToItselfWithLimit @a shrinkValid--shrinkUncheckedDoesNotShrinkToItselfWithLimit ::-       forall a. (Show a, Eq a, GenUnchecked a)-    => Int-    -> Property-shrinkUncheckedDoesNotShrinkToItselfWithLimit =-    shrinkDoesNotShrinkToItselfWithLimit @a shrinkUnchecked+  shrinkDoesNotShrinkToItselfOnValidWithLimit @a shrinkValid

@@ -1,41 +1,38 @@+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE CPP #-}  -- | Utilities for defining your own validity 'Spec's -- -- You will need @TypeApplications@ to use these. module Test.Validity.Utils-    ( nameOf-    , genDescr-    , binRelStr-    , shouldFail-    , failsBecause-    , Anon(..)-    , shouldBeValid-    , shouldBeInvalid-    ) where+  ( nameOf,+    genDescr,+    binRelStr,+    shouldFail,+    failsBecause,+    Anon (..),+    shouldBeValid,+    shouldBeInvalid,+  )+where -import Control.Monad.Trans.Writer (mapWriterT) import Control.Arrow (second)-+import Control.Monad.Trans.Writer (mapWriterT) import Data.Data- import Test.Hspec import Test.Hspec.Core.Formatters import Test.Hspec.Core.Runner import Test.Hspec.Core.Spec- import Test.QuickCheck.Property- import Test.Validity.Property.Utils  nameOf ::-     forall a. Typeable a-  => String+  forall a.+  Typeable a =>+  String nameOf =   let s = show $ typeRep (Proxy @a)    in if ' ' `elem` s@@ -43,27 +40,29 @@         else s  genDescr ::-       forall a. Typeable a-    => String-    -> String+  forall a.+  Typeable a =>+  String ->+  String genDescr genname = unwords ["\"" ++ genname, "::", nameOf @a ++ "\""]  binRelStr ::-       forall a. Typeable a-    => String-    -> String+  forall a.+  Typeable a =>+  String ->+  String binRelStr op = unwords ["(" ++ op ++ ")", "::", name, "->", name, "->", "Bool"]   where     name = nameOf @a -newtype Anon a =-    Anon a+newtype Anon a+  = Anon a  instance Show (Anon a) where-    show _ = "Anonymous"+  show _ = "Anonymous"  instance Functor Anon where-    fmap f (Anon a) = Anon (f a)+  fmap f (Anon a) = Anon (f a)  -- I'm not sure why mapSpecTree was removed from hspec-core, -- but it has been copied here for convenience.@@ -80,56 +79,36 @@   where     go :: SpecTree () -> SpecTree ()     go sp =-        Leaf-            Item-                { itemRequirement = s-                , itemLocation = Nothing-#if MIN_VERSION_hspec_core(2,6,0)-                , itemIsFocused = False-#endif-#if MIN_VERSION_hspec_core(2,5,0)-                , itemIsParallelizable = Nothing-#else-                , itemIsParallelizable = False-#endif-                , itemExample =-                      \_ _ _ -> do-                          let conf =-                                  defaultConfig {configFormatter = Just silent}-                          r <- hspecWithResult conf $ fromSpecList [sp]-                          let succesful =-                                  summaryExamples r > 0 && summaryFailures r > 0-                          pure $ produceResult succesful-                }-#if MIN_VERSION_hspec_core(2,4,0)-#if MIN_VERSION_hspec_core(2,5,0)-produceResult :: Bool -> Test.Hspec.Core.Spec.Result-produceResult succesful = Result-  { resultInfo = ""-  , resultStatus =-    if succesful-        then Success-        else Failure Nothing $ Reason "Should have failed but didn't."-  }-#else-produceResult :: Bool -> Either a Test.Hspec.Core.Spec.Result-produceResult succesful =-    Right $-    if succesful-        then Success-        else Failure Nothing $ Reason "Should have failed but didn't."-#endif-#else+      Leaf+        Item+          { itemRequirement = s,+            itemLocation = Nothing,+            itemIsFocused = False,+            itemIsParallelizable = Nothing,+            itemExample =+              \_ _ _ -> do+                let conf =+                      defaultConfig {configFormatter = Just silent}+                r <- hspecWithResult conf $ fromSpecList [sp]+                let succesful =+                      summaryExamples r > 0 && summaryFailures r > 0+                pure $ produceResult succesful+          }+ produceResult :: Bool -> Test.Hspec.Core.Spec.Result produceResult succesful =-    if succesful-        then Success-        else Fail Nothing "Should have failed but didn't."-#endif+  Result+    { resultInfo = "",+      resultStatus =+        if succesful+          then Success+          else Failure Nothing $ Reason "Should have failed but didn't."+    }+ shouldFail :: Property -> Property shouldFail =-    mapResult $ \res ->-        res-            { reason = unwords ["Should have failed:", reason res]-            , expect = not $ expect res-            }+  mapResult $ \res ->+    res+      { reason = unwords ["Should have failed:", reason res],+        expect = not $ expect res+      }

@@ -2,47 +2,44 @@  module Test.Validity.ApplicativeSpec where -import Test.Hspec- import Data.GenValidity+import Test.Hspec import Test.Validity.Applicative  spec :: Spec spec = do-    applicativeSpecOnValid @[]-    applicativeSpecOnValid @Maybe-    applicativeSpec @(Either Int)-    applicativeSpec @[]-    applicativeSpec @Maybe-    applicativeSpecOnArbitrary @[]-    applicativeSpecOnArbitrary @Maybe-    applicativeSpecOnGens-        @[]-        @Int-        (pure 4)-        "four"-        (genListOf $ pure 5)-        "list of fives"-        (pure [])-        "purely empty list"-        ((+) <$> genValid)-        "increments"-        (pure <$> ((+) <$> genValid))-        "increments in a list"-        (pure <$> ((*) <$> genValid))-        "scalings in a list"-    applicativeSpecOnGens-        @Maybe-        @String-        (pure "ABC")-        "ABC"-        (Just <$> pure "ABC")-        "Just an ABC"-        (pure Nothing)-        "purely Nothing"-        ((++) <$> genValid)-        "prepends"-        (pure <$> ((++) <$> genValid))-        "prepends in a Just"-        (pure <$> (flip (++) <$> genValid))-        "appends in a Just"+  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"

@@ -3,7 +3,6 @@ module Test.Validity.ArbitrarySpec where  import Test.Hspec- import Test.Validity.Arbitrary  spec :: Spec

@@ -1,34 +1,34 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeApplications #-} --- | Standard 'Spec's for 'Eq' instances.------ You will need @TypeApplications@ to use these. module Test.Validity.EqSpec where -import Test.Hspec- import Data.GenValidity+import GHC.Generics (Generic)+import Test.Hspec import Test.Validity.Eq import Test.Validity.Utils  spec :: Spec spec = do-    eqSpecOnValid @Rational-    eqSpec @Int-    -- eqSpec @Double DOES NOT HOLD because of NaN-    eqSpecOnArbitrary @Int-    eqSpecOnGen ((* 2) <$> genValid @Int) "even" (const [])-    failsBecause "(/=) and (==) don't have opposite semantics" $-        eqSpec @EqFuncMismatch+  eqSpec @Rational+  eqSpec @Int+  -- eqSpec @Double DOES NOT HOLD because of NaN+  eqSpecOnArbitrary @Int+  eqSpecOnGen ((* 2) <$> genValid @Int) "even" (const [])+  failsBecause "(/=) and (==) don't have opposite semantics" $+    eqSpec @EqFuncMismatch -newtype EqFuncMismatch =-    EqFuncMismatch ()-    deriving (Show)+newtype EqFuncMismatch+  = EqFuncMismatch ()+  deriving (Show, Generic) +instance Validity EqFuncMismatch+ instance Eq EqFuncMismatch where-    (==) _ _ = True-    (/=) _ _ = True+  (==) _ _ = True+  (/=) _ _ = True -instance GenUnchecked EqFuncMismatch where-    genUnchecked = EqFuncMismatch <$> genUnchecked-    shrinkUnchecked _ = []+instance GenValid EqFuncMismatch where+  genValid = EqFuncMismatch <$> genValid+  shrinkValid _ = []

@@ -1,54 +1,55 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeApplications #-}  module Test.Validity.FunctorSpec where -import Test.Hspec- import Data.GenValidity+import GHC.Generics (Generic)+import Test.Hspec import Test.Validity.Functor import Test.Validity.Utils  spec :: Spec spec = do-    functorSpec @[]-    functorSpec @Maybe-    failsBecause "Fcks does not satisfy any Functor laws" $ functorSpec @Fcks-    functorSpec @(Either Int)-    functorSpec @((,) Int)-    functorSpecOnValid @[]-    functorSpecOnValid @Maybe-    functorSpecOnArbitrary @[]-    functorSpecOnArbitrary @Maybe-    functorSpecOnGens-        @[]-        @Int-        (pure 4)-        "four"-        (genListOf $ pure 5)-        "list of fives"-        ((+) <$> genValid)-        "increments"-        ((*) <$> genValid)-        "scalings"-    functorSpecOnGens-        @Maybe-        @String-        (pure "ABC")-        "ABC"-        (Just <$> pure "ABC")-        "Just an ABC"-        ((++) <$> genValid)-        "prepends"-        (flip (++) <$> genValid)-        "appends"+  functorSpec @[]+  functorSpec @Maybe+  failsBecause "Fcks does not satisfy any Functor laws" $ functorSpec @Fcks+  functorSpec @(Either Int)+  functorSpec @((,) Int)+  functorSpecOnArbitrary @[]+  functorSpecOnArbitrary @Maybe+  functorSpecOnGens+    @[]+    @Int+    (pure 4)+    "four"+    (genListOf $ pure 5)+    "list of fives"+    ((+) <$> genValid)+    "increments"+    ((*) <$> genValid)+    "scalings"+  functorSpecOnGens+    @Maybe+    @String+    (pure "ABC")+    "ABC"+    (Just <$> pure "ABC")+    "Just an ABC"+    ((++) <$> genValid)+    "prepends"+    (flip (++) <$> genValid)+    "appends" -newtype Fcks a =-    Fcks Int-    deriving (Show, Eq)+newtype Fcks a+  = Fcks Int+  deriving (Show, Eq, Generic) -instance GenUnchecked (Fcks a) where-    genUnchecked = Fcks <$> genUnchecked-    shrinkUnchecked (Fcks i) = Fcks <$> shrinkUnchecked i+instance Validity (Fcks a) +instance GenValid (Fcks a) where+  genValid = Fcks <$> genValid+  shrinkValid (Fcks i) = Fcks <$> shrinkValid i+ instance Functor Fcks where-    fmap _ (Fcks i) = Fcks $ i * 2+  fmap _ (Fcks i) = Fcks $ i * 2

@@ -3,11 +3,9 @@ module Test.Validity.GenValiditySpec where  import Test.Hspec- import Test.Validity.GenValidity  spec :: Spec spec = do-    genValiditySpec @Rational-    genValidSpec @Rational-    genInvalidSpec @Rational+  genValidSpec @Rational+  genValidSpec @Rational

@@ -2,53 +2,50 @@  module Test.Validity.MonadSpec where -import Test.Hspec- import Data.GenValidity+import Test.Hspec import Test.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"

@@ -3,12 +3,11 @@ module Test.Validity.MonoidSpec where  import Test.Hspec- import Test.Validity.Monoid  spec :: Spec spec = do-    monoidSpecOnValid @[Rational]-    monoidSpec @[Int]-    monoidSpecOnArbitrary @[Int]-    monoidSpecOnGen (pure "a") "singleton list of 'a'" (const [])+  monoidSpecOnValid @[Rational]+  monoidSpec @[Int]+  monoidSpecOnArbitrary @[Int]+  monoidSpecOnGen (pure "a") "singleton list of 'a'" (const [])

@@ -2,16 +2,15 @@  module Test.Validity.OrdSpec where -import Test.Hspec- import Data.GenValidity+import Test.Hspec import Test.Validity.Ord import Test.Validity.Utils  spec :: Spec spec = do-    ordSpecOnValid @Rational-    failsBecause "NaN >= NaN is False" $ ordSpec @Double-    ordSpec @Int-    ordSpecOnArbitrary @Int-    ordSpecOnGen ((* 2) <$> genValid @Int) "even" (const [])+  ordSpec @Rational+  failsBecause "NaN >= NaN is False" $ ordSpec @Double+  ordSpec @Int+  ordSpecOnArbitrary @Int+  ordSpecOnGen ((* 2) <$> genValid @Int) "even" (const [])

@@ -1,32 +1,32 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeApplications #-} --- | Standard 'Spec's for 'Show' and 'Read' instances.------ You will need @TypeApplications@ to use these. module Test.Validity.ShowSpec where -import Test.Hspec- import Data.GenValidity+import GHC.Generics (Generic)+import Test.Hspec import Test.Validity.Show import Test.Validity.Utils  spec :: Spec spec = do-    showReadSpecOnValid @Rational-    showReadSpec @Int-    showReadSpecOnArbitrary @Rational-    showReadSpecOnGen ((* 2) <$> genValid @Int) "even" (const [])-    failsBecause "show and read don't have the correct semantics" $-        showReadSpec @ShowFuncMismatch+  showReadSpec @Rational+  showReadSpec @Int+  showReadSpecOnArbitrary @Rational+  showReadSpecOnGen ((* 2) <$> genValid @Int) "even" (const [])+  failsBecause "show and read don't have the correct semantics" $+    showReadSpec @ShowFuncMismatch -data ShowFuncMismatch =-    ShowFuncMismatch-    deriving (Eq, Read)+data ShowFuncMismatch+  = ShowFuncMismatch+  deriving (Eq, Read, Generic) +instance Validity ShowFuncMismatch+ instance Show ShowFuncMismatch where-    show ShowFuncMismatch = "wrong"+  show ShowFuncMismatch = "wrong" -instance GenUnchecked ShowFuncMismatch where-    genUnchecked = pure ShowFuncMismatch-    shrinkUnchecked _ = []+instance GenValid ShowFuncMismatch where+  genValid = pure ShowFuncMismatch+  shrinkValid _ = []

@@ -2,30 +2,24 @@  module Test.Validity.ShrinkingSpec where -import Test.Hspec- import Data.Int import Data.Ratio-+import Test.Hspec import Test.Validity.Shrinking  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 "Ordering" $ shrinkInvalidPreservesInvalidOnGenInvalid @(Ratio Int8)-    it "[Ordering]" $ 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]