checkers 0.4.11 → 0.4.13

raw patch · 7 files changed

+128/−51 lines, 7 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• checkers.cabal +4/−2
• src/Test/QuickCheck/Classes.hs +118/−43
• src/Test/QuickCheck/Instances/Array.hs +1/−1
• src/Test/QuickCheck/Instances/Eq.hs +1/−1
• src/Test/QuickCheck/Instances/Num.hs +1/−1
• src/Test/QuickCheck/Instances/Ord.hs +2/−2
• src/Test/QuickCheck/Utils.hs +1/−1

@@ -1,5 +1,5 @@ Name:                checkers-Version:             0.4.11+Version:             0.4.13 Cabal-Version:       >= 1.6 Synopsis:            Check properties on standard classes and data structures. Category:            Testing@@ -17,7 +17,7 @@ License-File:        COPYING Stability:           experimental build-type:          Simple-tested-with:         GHC==8.6.1, GHC==8.4.3, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2+tested-with:         GHC==8.6.4, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3 homepage:            https://github.com/conal/checkers source-repository head   type:     git@@ -49,3 +49,5 @@   Other-modules:                        Control.Monad.Extensions   ghc-options:         -Wall+  if impl(ghc >= 8.0)+    ghc-options:       -Wredundant-constraints

@@ -1,5 +1,5 @@ {-# LANGUAGE ScopedTypeVariables, FlexibleContexts, KindSignatures-           , Rank2Types, TypeOperators+           , Rank2Types, TypeOperators, CPP   #-}  {-# OPTIONS_GHC -Wall #-}@@ -24,19 +24,19 @@   , applicative, applicativeMorphism, semanticApplicative   , bind, bindMorphism, semanticBind, bindApply   , monad, monadMorphism, semanticMonad, monadFunctor-  , monadApplicative, arrow, arrowChoice, traversable+  , monadApplicative, arrow, arrowChoice, foldable, foldableFunctor, traversable   , monadPlus, monadOr, alt, alternative   )   where  import Control.Applicative ((<$>))-import Data.Foldable (foldMap)+import Data.Foldable (Foldable(..)) 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.Semigroup (Semigroup ((<>)))-import Data.Monoid (Monoid (mappend, mempty))+import Data.Monoid (Monoid (mappend, mempty), Endo(..), Dual(..), Sum(..), Product(..)) import Data.Traversable (Traversable (..), fmapDefault, foldMapDefault) import Control.Applicative import Control.Monad (MonadPlus (..), ap, join)@@ -50,7 +50,7 @@  -- | Total ordering.  @gen a@ ought to generate values @b@ satisfying @a -- `rel` b@ fairly often.-ordRel :: forall a. (Ord a, Show a, Arbitrary a, EqProp a) =>+ordRel :: forall a. (Ord a, Show a, Arbitrary a) =>           BinRel a -> (a -> Gen a) -> TestBatch ordRel rel gen =   ( "ord"@@ -61,7 +61,7 @@   )  -- | Total ordering-ord :: forall a. (Ord a, Show a, Arbitrary a, EqProp a) =>+ord :: forall a. (Ord a, Show a, Arbitrary a) =>        (a -> Gen a) -> TestBatch ord = ordRel (<=) @@ -173,7 +173,7 @@ -- properties. functor :: forall m a b c.            ( Functor m-           , Arbitrary a, Arbitrary b, Arbitrary c+           , Arbitrary b, Arbitrary c            , CoArbitrary a, CoArbitrary b            , Show (m a), Arbitrary (m a), EqProp (m a), EqProp (m c)) =>            m (a,b,c) -> TestBatch@@ -231,12 +231,12 @@ -- properties apply :: forall m a b c.          ( Apply m-         , Arbitrary a, CoArbitrary a, Arbitrary b, CoArbitrary b+         , 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)+         , Show (m a)+         , EqProp (m c)          ) =>          m (a,b,c) -> TestBatch apply = const ( "apply"@@ -259,7 +259,7 @@ applyMorphism :: forall f g.                  ( Apply f, Apply g                  , Show (f NumT), Arbitrary (f NumT)-                 , EqProp (g NumT), EqProp (g T)+                 , EqProp (g T)                  , Show (f (NumT -> T))                  , Arbitrary (f (NumT -> T))                  ) =>@@ -277,7 +277,7 @@                  ( Model1 f g                  , Apply f, Apply g                  , Arbitrary (f NumT), Arbitrary (f (NumT -> T))-                 , EqProp (g NumT), EqProp (g T)+                 , EqProp (g T)                  , Show (f NumT), Show (f (NumT -> T))                  ) =>                  f () -> TestBatch@@ -354,9 +354,9 @@ -- | 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+        , CoArbitrary a, CoArbitrary b         , Arbitrary (m a), EqProp (m a), Show (m a)-        , Arbitrary (m b), EqProp (m b)+        , Arbitrary (m b)         , Arbitrary (m c), EqProp (m c)         , Arbitrary (m (m (m a))), Show (m (m (m a)))         ) =>@@ -374,9 +374,8 @@    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+             ( Bind m+             , EqProp (m b)              , Show (m a), Arbitrary (m a)              , Show (m (a -> b)), Arbitrary (m (a -> b))) =>              m (a, b) -> TestBatch@@ -389,14 +388,12 @@  -- | 'bind' morphism properties bindMorphism :: forall f g.-                ( Bind f, Bind g, Functor g+                ( Bind f, Bind 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 T)                 , EqProp (g (NumT -> T))                 ) =>                 (forall a. f a -> g a) -> TestBatch@@ -414,14 +411,12 @@ semanticBind :: forall f g.   ( Model1 f g   , Bind f, Bind g-  , EqProp (g T) , EqProp (g NumT)+  , EqProp (g T)   , 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+  , Show (f NumT)   ) =>   f () -> TestBatch semanticBind = const (bindMorphism (model1 :: forall b. f b -> g b))@@ -430,7 +425,7 @@ -- | Properties to check that the 'Monad' @m@ satisfies the monad properties monad :: forall m a b c.          ( Monad m-         , Show a, Arbitrary a, CoArbitrary a, Arbitrary b, CoArbitrary b+         , Show a, Arbitrary a, CoArbitrary a, CoArbitrary b          , Arbitrary (m a), EqProp (m a), Show (m a)          , Arbitrary (m b), EqProp (m b)          , Arbitrary (m c), EqProp (m c)@@ -453,8 +448,8 @@  -- | Law for monads that are also instances of 'Functor'. monadFunctor :: forall m a b.-                ( Functor m, Monad m-                , Arbitrary a, Arbitrary b, CoArbitrary a+                ( Monad m+                , Arbitrary b, CoArbitrary a                 , Arbitrary (m a), Show (m a), EqProp (m b)) =>                 m (a, b) -> TestBatch monadFunctor = const ( "monad functor"@@ -464,7 +459,7 @@    bindReturnP f xs = fmap f xs =-= (xs >>= return . f)  monadApplicative :: forall m a b.-                    ( Applicative m, Monad m+                    ( Monad m                     , EqProp (m a), EqProp (m b)                     , Show a, Arbitrary a                     , Show (m a), Arbitrary (m a)@@ -486,12 +481,10 @@  -- | 'Applicative' morphism properties monadMorphism :: forall f g.-                 ( Monad f, Monad g, Functor g+                 ( Monad f, Monad 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))@@ -534,10 +527,8 @@   , 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+  , Show (f NumT)   ) =>   f () -> TestBatch semanticMonad = const (monadMorphism (model1 :: forall b. f b -> g b))@@ -545,7 +536,7 @@ -- | Laws for MonadPlus instances with left distribution. monadPlus :: forall m a b.              ( MonadPlus m, Show (m a)-             , Arbitrary a, CoArbitrary a, Arbitrary (m a), Arbitrary (m b)+             , CoArbitrary a, Arbitrary (m a), Arbitrary (m b)              , EqProp (m a), EqProp (m b)) =>              m (a, b) -> TestBatch monadPlus = const ( "MonadPlus laws"@@ -585,7 +576,7 @@    leftCatchP a b = return a `mplus` b =-= return a  -- | Check Alt Semigroup law-alt :: forall f a. ( Alt f, Arbitrary a, Arbitrary (f a)+alt :: forall f a. ( Alt f, Arbitrary (f a)                    , EqProp (f a), Show (f a)) =>        f a -> TestBatch alt = const ( "Alt laws"@@ -593,7 +584,7 @@   -- | Check Alternative Monoid laws-alternative :: forall f a. ( Alternative f, Arbitrary a, Arbitrary (f a)+alternative :: forall f a. ( Alternative f, Arbitrary (f a)                            , EqProp (f a), Show (f a)) =>                f a -> TestBatch alternative = const ( "Alternative laws"@@ -607,15 +598,13 @@ arrow :: forall a b c d e.          ( Arrow a          , Show (a d e), Show (a c d), Show (a b c)-         , Show b, Show c, Show d, Show e          , Arbitrary (a d e), Arbitrary (a c d), Arbitrary (a b c)-         , Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e+         , Arbitrary c, Arbitrary d, Arbitrary e          , CoArbitrary b, CoArbitrary c, CoArbitrary d          , EqProp (a b e), EqProp (a b d)          , EqProp (a (b,d) c)          , EqProp (a (b,d) (c,d)), EqProp (a (b,e) (d,e))          , EqProp (a (b,d) (c,e))-         , EqProp b, EqProp c, EqProp d, EqProp e          ) =>          a b (c,d,e) -> TestBatch arrow = const ("arrow laws"@@ -656,7 +645,7 @@                ( ArrowChoice a                , Show (a b c)                , Arbitrary (a b c)-               , Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e+               , Arbitrary c, Arbitrary e                , CoArbitrary b, CoArbitrary d                , EqProp (a (Either b d) (Either c e))                , EqProp (a (Either b d) (Either c d))@@ -678,7 +667,7 @@  traversable :: forall f a b m.                ( Traversable f, Monoid m, Show (f a)-               , Arbitrary (f a), Arbitrary b, Arbitrary a, Arbitrary m+               , Arbitrary (f a), Arbitrary b, Arbitrary m                , CoArbitrary a                , EqProp (f b), EqProp m) =>                f (a, b, m) -> TestBatch@@ -693,3 +682,89 @@     fmapP f x = f `fmap` x =-= f `fmapDefault` x    foldMapP f x = f `foldMap` x =-= f `foldMapDefault` x++-- | Note that 'foldable' doesn't check the strictness of 'foldl'', `foldr'' and `foldMap''.+foldable :: forall t a b m n o.+            ( Foldable t+            , CoArbitrary a, CoArbitrary b+            , Arbitrary a, Arbitrary b, Arbitrary o, Arbitrary (t a), Arbitrary (t m), Arbitrary (t n), Arbitrary (t o)+            , Monoid m+            , Num n+            , Ord o+            , EqProp m, EqProp n, EqProp b, EqProp o, EqProp a+            , Show (t m), Show (t n), Show (t o), Show b, Show (t a), Show o) =>+            t (a, b, m, n, o) -> TestBatch+foldable = const ( "Foldable"+                 , [ ("foldr and foldMap", property foldrFoldMapP)+                   , ("foldl and foldMap", property foldlFoldMapP)+                   , ("fold and foldMap", property foldFoldMapP)+                   , ("length", property lengthP)+#if MIN_VERSION_base(4,13,0)+                   , ("foldMap'", property foldMap'P)+#endif+                   , ("foldr'", property foldr'P)+                   , ("foldl'", property foldl'P)+                   , ("foldr1", property foldr1P)+                   , ("foldl1", property foldl1P)+                   , ("toList", property toListP)+                   , ("null", property nullP)+                   , ("elem", property elemP)+                   , ("maximum", property maximumP)+                   , ("minimum", property minimumP)+                   , ("sum", property sumP)+                   , ("product", property productP)+                   ]+                 )+  where+    foldrFoldMapP :: (a -> b -> b) -> b -> t a -> Property+    foldrFoldMapP f z t = foldr f z t =-= appEndo (foldMap (Endo . f) t ) z+    foldlFoldMapP :: (b -> a -> b) -> b -> t a -> Property+    foldlFoldMapP f z t = foldl f z t =-= appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z+    foldFoldMapP :: t m -> Property+    foldFoldMapP t = fold t =-= foldMap id t+    lengthP :: t a -> Property+    lengthP t = length t =-= (getSum . foldMap (Sum . const  1)) t+#if MIN_VERSION_base(4,13,0)+    -- TODO: Check strictness+    foldMap'P :: (a -> m) -> t a -> Property+    foldMap'P f t = foldMap' f t =-= foldl' (\acc a -> acc <> f a) mempty t+#endif+    sumP :: t n -> Property+    sumP t = sum t =-= (getSum . foldMap Sum) t+    productP :: t n -> Property+    productP t = product t =-= (getProduct . foldMap Product) t+    maximumP :: t o -> Property+    maximumP t = not (null t) ==> maximum t =-= maximum (toList t)+    minimumP :: t o -> Property+    minimumP t = not (null t) ==> minimum t =-= minimum (toList t)+    foldr1P :: (a -> a -> a) -> t a -> Property+    foldr1P f t = not (null t) ==> foldr1 f t =-= foldr1 f (toList t)+    foldl1P :: (a -> a -> a) -> t a -> Property+    foldl1P f t = not (null t) ==> foldl1 f t =-= foldl1 f (toList t)+    toListP :: t a -> Property+    toListP t = toList t =-= foldr (:) [] t+    nullP :: t a -> Property+    nullP t = null t =-= foldr (const (const False)) True t+    -- TODO: Check strictness+    foldr'P :: (a -> b -> b) -> b -> t a -> Property+    foldr'P f z t = foldr' f z t =-= foldr' f z (toList t)+    -- TODO: Check strictness+    foldl'P :: (b -> a -> b) -> b -> t a -> Property+    foldl'P f z t = foldl' f z t =-= foldl' f z (toList t)+    elemP :: o -> t o -> Property+    elemP o t = elem o t =-= elem o (toList t)++foldableFunctor :: forall t a m.+                   ( Functor t, Foldable t+                   , CoArbitrary a+                   , Arbitrary m, Arbitrary (t a)+                   , EqProp m+                   , Monoid m+                   , Show (t a)) =>+                   t (a, m) -> TestBatch+foldableFunctor = const ( "Foldable Functor"+                        , [ ("foldMap f = fold . fmap f", property foldMapP) ]+                        )+  where+    foldMapP :: (a -> m) -> t a -> Property+    foldMapP f t = foldMap f t =-= fold (fmap f t)

@@ -9,5 +9,5 @@   arbitrary   =     (\x -> listArray (0,fromIntegral (length x - 1)) x) <$> arbitrary -instance (Ix a, Integral a, CoArbitrary b) => CoArbitrary (Array a b) where+instance CoArbitrary b => CoArbitrary (Array a b) where   coarbitrary = coarbitrary . elems

@@ -4,7 +4,7 @@ import Test.QuickCheck.Checkers import Control.Monad.Extensions -notEqualTo :: (Eq a,Arbitrary a) => a -> Gen a -> Gen a+notEqualTo :: (Eq a) => a -> Gen a -> Gen a notEqualTo v = satisfiesM (/= v)  notOneof :: (Eq a,Arbitrary a) => [a] -> Gen a

@@ -20,7 +20,7 @@ negative :: (Eq a, Num a, Arbitrary a) => Gen a negative = negate <$> positive -nonZero :: (Eq a, Num a, Arbitrary a) => Gen a -> Gen a+nonZero :: (Eq a, Num a) => Gen a -> Gen a nonZero g =   sized (\s -> satisfiesM (/= 0) (if (s == 0) then (resize 1 g) else g)) 

@@ -3,8 +3,8 @@ import Test.QuickCheck import Control.Monad.Extensions -greaterThan :: (Ord a,Arbitrary a) => a -> Gen a -> Gen a+greaterThan :: (Ord a) => a -> Gen a -> Gen a greaterThan v = satisfiesM (> v) -lessThan :: (Ord a,Arbitrary a) => a -> Gen a -> Gen a+lessThan :: (Ord a) => a -> Gen a -> Gen a lessThan v = satisfiesM (< v)

@@ -47,7 +47,7 @@ isCommutable :: (Arbitrary a,Show a,Eq b) => (a -> a -> b) -> Property isCommutable = isCommutableBy (==) arbitrary -isTotalOrder :: (Arbitrary a,Show a,Ord a) => a -> a -> Property+isTotalOrder :: (Ord a) => a -> a -> Property isTotalOrder x y =     classify (x > y)  "less than" $     classify (x == y) "equals" $