checkers 0.4.7 → 0.4.8

raw patch · 7 files changed

+165/−21 lines, 7 filesdep +semigroupoidsdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: semigroupoids

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• checkers.cabal +2/−2
• src/Test/QuickCheck/Checkers.hs +4/−5
• src/Test/QuickCheck/Classes.hs +150/−2
• src/Test/QuickCheck/Instances/Array.hs +0/−1
• src/Test/QuickCheck/Instances/Maybe.hs +0/−1
• src/Test/QuickCheck/Instances/Num.hs +0/−1
• src/Test/QuickCheck/Utils.hs +9/−9

@@ -1,5 +1,5 @@ Name:                checkers-Version:             0.4.7+Version:             0.4.8 Cabal-Version:       >= 1.6 Synopsis:            Check properties on standard classes and data structures. Category:            Testing@@ -27,7 +27,7 @@ Library   hs-Source-Dirs:      src   Extensions:-  Build-Depends:       base < 5, random, QuickCheck>=2.3, array >= 0.1+  Build-Depends:       base < 5, random, QuickCheck>=2.3, array >= 0.1, semigroupoids >= 5 && < 6   Exposed-Modules:                        Test.QuickCheck.Utils                        Test.QuickCheck.Checkers

@@ -44,7 +44,6 @@   ) where  -- import Data.Function (on)-import Data.Monoid import Data.Function (on) import Control.Applicative import Control.Arrow ((***),first)@@ -369,11 +368,11 @@  meq  :: (Model a b, EqProp b) => a -> b -> Property meq1 :: (Model a b, Model a1 b1, EqProp b) =>-	(a1 -> a) -> (b1 -> b) -> a1 -> Property+        (a1 -> a) -> (b1 -> b) -> a1 -> Property meq2 :: (Model a b, Model a1 b1, Model a2 b2, EqProp b) =>-	(a1 -> a2 -> a) -> (b1 -> b2 -> b) -> a1 -> a2 -> Property+        (a1 -> a2 -> a) -> (b1 -> b2 -> b) -> a1 -> a2 -> Property meq3 :: (Model a b, Model a1 b1, Model a2 b2, Model a3 b3, EqProp b) =>-	(a1 -> a2 -> a3 -> a)+        (a1 -> a2 -> a3 -> a)      -> (b1 -> b2 -> b3 -> b)      -> a1 -> a2 -> a3 -> Property meq4 :: ( Model a b, Model a1 b1, Model a2 b2@@ -383,7 +382,7 @@      -> a1 -> a2 -> a3 -> a4 -> Property meq5 :: ( Model a b, Model a1 b1, Model a2 b2, Model a3 b3         , Model a4 b4, Model a5 b5, EqProp b) =>-	(a1 -> a2 -> a3 -> a4 -> a5 -> a)+        (a1 -> a2 -> a3 -> a4 -> a5 -> a)      -> (b1 -> b2 -> b3 -> b4 -> b5 -> b)      -> a1 -> a2 -> a3 -> a4 -> a5 -> Property 

@@ -19,15 +19,21 @@   ( ordRel, ord, ordMorphism, semanticOrd   , monoid, monoidMorphism, semanticMonoid   , functor, functorMorphism, semanticFunctor, functorMonoid+  , apply, applyMorphism, semanticApply   , applicative, applicativeMorphism, semanticApplicative+  , bind, bindMorphism, semanticBind, bindApply   , monad, monadMorphism, semanticMonad, monadFunctor   , monadApplicative, arrow, arrowChoice, traversable-  , monadPlus, monadOr, alternative+  , monadPlus, monadOr, alt, alternative   )   where -import Data.Monoid import Data.Foldable (foldMap)+import Data.Functor.Apply (Apply ((<.>)))+import Data.Functor.Alt (Alt ((<!>)))+import Data.Functor.Bind (Bind ((>>-)), apDefault)+import qualified Data.Functor.Bind as B (Bind (join))+import Data.Monoid (Monoid (mappend, mempty)) import Data.Traversable (Traversable (..), fmapDefault, foldMapDefault) import Control.Applicative import Control.Monad (MonadPlus (..), ap, join)@@ -207,6 +213,64 @@ semanticFunctor = const (functorMorphism (model1 :: forall b. f b -> g b))  +-- | Properties to check that the 'Apply' @m@ satisfies the apply+-- properties+apply :: forall m a b c.+         ( Apply m+         , Arbitrary a, CoArbitrary a, Arbitrary b, CoArbitrary b+         , Arbitrary c, Arbitrary (m a)+         , Arbitrary (m (b -> c)), Show (m (b -> c))+         , Arbitrary (m (a -> b)), Show (m (a -> b))+         , Show a, Show (m a)+         , EqProp (m a), EqProp (m b), EqProp (m c)+         ) =>+         m (a,b,c) -> TestBatch+apply = const ( "apply"+              , [ ("associativity", property associativityP)+                , ("left"       , property leftP)+                , ("right"      , property rightP)+                ]+              )+ where+   associativityP :: m (b -> c) -> m (a -> b) -> m a -> Property+   rightP         :: (b -> c) -> m (a -> b) -> m a -> Property+   leftP          :: (a -> b) -> m (b -> c) -> m a -> Property++   associativityP u v w = ((.) <$> u <.> v <.> w) =-= (u <.> (v <.> w))+   leftP f x y          = (x <.> (f <$> y)) =-= ((. f) <$> x <.> y)+   rightP f x y         = (f <$> (x <.> y)) =-= ((f .) <$> x <.> y)+++-- | 'Apply' morphism properties+applyMorphism :: forall f g.+                 ( Apply f, Apply g+                 , Show (f NumT), Arbitrary (f NumT)+                 , EqProp (g NumT), EqProp (g T)+                 , Show (f (NumT -> T))+                 , Arbitrary (f (NumT -> T))+                 ) =>+                 (forall a. f a -> g a) -> TestBatch+applyMorphism q =+  ( "apply morphism"+  , [ ("apply", property applyP)] )+ where+   applyP :: f (NumT->T) -> f NumT -> Property+   applyP mf mx = q (mf <.> mx) =-= (q mf <.> q mx)+++-- | The semantic function ('model1') for @f@ is an 'applyMorphism'.+semanticApply :: forall f g.+                 ( Model1 f g+                 , Apply f, Apply g+                 , Arbitrary (f NumT), Arbitrary (f (NumT -> T))+                 , EqProp (g NumT), EqProp (g T)+                 , Show (f NumT), Show (f (NumT -> T))+                 ) =>+                 f () -> TestBatch+semanticApply =+  const (applyMorphism (model1 :: forall b. f b -> g b))++ -- | Properties to check that the 'Applicative' @m@ satisfies the applicative -- properties applicative :: forall m a b c.@@ -273,6 +337,82 @@   const (applicativeMorphism (model1 :: forall b. f b -> g b))  +-- | Properties to check that the 'bind' @m@ satisfies the bind properties+bind :: forall m a b c.+        ( Bind m+        , Show a, Arbitrary a, CoArbitrary a, Arbitrary b, CoArbitrary b+        , Arbitrary (m a), EqProp (m a), Show (m a)+        , Arbitrary (m b), EqProp (m b)+        , Arbitrary (m c), EqProp (m c)+        , Arbitrary (m (m (m a))), Show (m (m (m a)))+        ) =>+        m (a,b,c) -> TestBatch+bind = const ( "bind laws"+              , [ ("join associativity", property joinAssocP)+                , ("bind associativity", property bindAssocP)+                ]+              )+ where+   bindAssocP :: m a -> (a -> m b) -> (b -> m c) -> Property+   joinAssocP :: m (m (m a)) -> Property++   bindAssocP m f g = ((m >>- f) >>- g) =-= (m >>- (\x -> f x >>- g))+   joinAssocP mmma = B.join (B.join mmma) =-= B.join (fmap B.join mmma)++bindApply :: forall m a b.+             ( Apply m, Bind m+             , EqProp (m a), EqProp (m b)+             , Show a, Arbitrary a+             , Show (m a), Arbitrary (m a)+             , Show (m (a -> b)), Arbitrary (m (a -> b))) =>+             m (a, b) -> TestBatch+bindApply = const ( "bind apply"+                  , [ ("ap", property apP) ]+                  )+ where+   apP :: m (a -> b) -> m a -> Property+   apP f x = (f <.> x) =-= (f `apDefault` x)++-- | 'bind' morphism properties+bindMorphism :: forall f g.+                ( Bind f, Bind g, Functor g+                , Show (f NumT)+                , Show (f (NumT -> T))+                , Show (f (f (NumT -> T)))+                , Arbitrary (f NumT), Arbitrary (f T)+                , Arbitrary (f (NumT -> T))+                , Arbitrary (f (f (NumT -> T)))+                , EqProp (g NumT), EqProp (g T)+                , EqProp (g (NumT -> T))+                ) =>+                (forall a. f a -> g a) -> TestBatch+bindMorphism q =+  ( "bind morphism"+  , [ ("bind", property bindP), ("join", property joinP) ] )+ where+   bindP :: f NumT -> (NumT -> f T) -> Property+   joinP :: f (f (NumT->T)) -> Property++   bindP u k = q (u >>- k)  =-= (q u >>- q . k)+   joinP uu  = q (B.join uu)  =-= B.join (fmap q (q uu))++-- | The semantic function ('model1') for @f@ is a 'bindMorphism'.+semanticBind :: forall f g.+  ( Model1 f g+  , Bind f, Bind g+  , EqProp (g T) , EqProp (g NumT)+  , EqProp (g (NumT -> T))+  , Arbitrary (f T) , Arbitrary (f NumT)+  , Arbitrary (f (f (NumT -> T)))+  , Arbitrary (f (NumT -> T))+  , Show (f (f (NumT -> T)))+  , Show (f (NumT -> T)) , Show (f NumT)+  , Functor g+  ) =>+  f () -> TestBatch+semanticBind = const (bindMorphism (model1 :: forall b. f b -> g b))++ -- | Properties to check that the 'Monad' @m@ satisfies the monad properties monad :: forall m a b c.          ( Monad m@@ -429,6 +569,14 @@     leftZeroP k = (mzero >>= k) =-= mzero    leftCatchP a b = return a `mplus` b =-= return a++-- | Check Alt Semigroup law+alt :: forall f a. ( Alt f, Arbitrary a, Arbitrary (f a)+                   , EqProp (f a), Show (f a)) =>+       f a -> TestBatch+alt = const ( "Alt laws"+            , [ ("associativity", isAssoc ((<!>) :: Binop (f a))) ] )+  -- | Check Alternative Monoid laws alternative :: forall f a. ( Alternative f, Arbitrary a, Arbitrary (f a)

@@ -2,7 +2,6 @@ module Test.QuickCheck.Instances.Array where  import Test.QuickCheck-import Control.Applicative import Data.Array  instance (Ix a, Integral a, Arbitrary b) => Arbitrary (Array a b) where

@@ -1,7 +1,6 @@ module Test.QuickCheck.Instances.Maybe (maybeGen) where  import Test.QuickCheck-import Control.Applicative  maybeGen :: Gen a -> Gen (Maybe a) maybeGen x = oneof [pure Nothing

@@ -6,7 +6,6 @@  import Test.QuickCheck import Control.Monad.Extensions-import Control.Applicative  nonNegative :: (Num a, Arbitrary a) => Gen a nonNegative = abs <$> arbitrary

@@ -27,22 +27,22 @@ import Test.QuickCheck  isAssociativeBy :: (Show a,Testable prop)-		=> (a -> a -> prop) -> Gen a -> (a -> a -> a) -> Property+                => (a -> a -> prop) -> Gen a -> (a -> a -> a) -> Property isAssociativeBy (=~=) src (#) =-     	forAll src $ \ a ->-     	forAll src $ \ b ->-     	forAll src $ \ c ->-	((a # b) # c) =~= (a # (b # c))+        forAll src $ \ a ->+        forAll src $ \ b ->+        forAll src $ \ c ->+        ((a # b) # c) =~= (a # (b # c))  isAssociative :: (Arbitrary a,Show a,Eq a) => (a -> a -> a) -> Property isAssociative = isAssociativeBy (==) arbitrary  isCommutableBy :: (Show a,Testable prop)-	       => (b -> b -> prop) -> Gen a -> (a -> a -> b) -> Property+               => (b -> b -> prop) -> Gen a -> (a -> a -> b) -> Property isCommutableBy (=~=) src (#) =-	forAll src $ \ a ->-	forAll src $ \ b ->-	(a # b) =~= (b # a)+        forAll src $ \ a ->+        forAll src $ \ b ->+        (a # b) =~= (b # a)  isCommutable :: (Arbitrary a,Show a,Eq b) => (a -> a -> b) -> Property isCommutable = isCommutableBy (==) arbitrary