packages feed

quickcheck-classes 0.4.5 → 0.4.6

raw patch · 5 files changed

+138/−8 lines, 5 files

Files

changelog.md view
@@ -4,6 +4,15 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## [0.4.6] - 2018-03-29+### Added+- Property test the naturality law for `MonadZip`. There is another law+  that instances should satisfy (the Information Preservation law), but+  it's more difficult to write a test for. It has been omitted for now.+- Property tests for all `MonadPlus` laws.+- Several additional property tests for list-like containers: mapMaybe,+  replicate, filter.+ ## [0.4.5] - 2018-03-26 ### Added - Property tests for list-like containers that have `IsList` instances.
quickcheck-classes.cabal view
@@ -1,5 +1,5 @@ name: quickcheck-classes-version: 0.4.5+version: 0.4.6 synopsis: QuickCheck common typeclasses description:   This library provides quickcheck properties to
src/Test/QuickCheck/Classes.hs view
@@ -69,6 +69,8 @@   , traversableLaws   , functorLaws   , monadLaws+  , monadPlusLaws +  , monadZipLaws #endif #if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)   , bifunctorLaws @@ -100,6 +102,8 @@ import Test.QuickCheck hiding ((.&.)) import Test.QuickCheck.Property (Property(..)) import Control.Monad.Primitive (PrimMonad,PrimState,primitive,primitive_)+import Control.Monad.Zip (MonadZip(mzip))+import Control.Arrow ((***)) import qualified Control.Monad.Trans.Writer.Lazy as WL import qualified Data.Primitive as P import qualified Data.Semigroup as SG@@ -128,7 +132,7 @@  #if MIN_VERSION_QuickCheck(2,10,0) import Control.Exception (ErrorCall,try,evaluate)-import Control.Monad (ap)+import Control.Monad (ap,liftM,MonadPlus(mzero,mplus)) import Control.Monad.Trans.Class (lift) #if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0) import Data.Functor.Classes@@ -805,6 +809,27 @@   , ("Associativity", alternativeAssociativity p)   ] +-- | Tests the following monad plus properties:+--+-- [/Left Identity/]+--   @'mplus' 'empty' x ≡ x@+-- [/Right Identity/]+--   @'mplus' x 'empty' ≡ x@+-- [/Associativity/]+--   @'mplus' a ('mplus' b c) ≡ 'mplus' ('mplus' a b) c)@ +-- [/Left Zero/]+--   @'mzero' '>>=' f ≡ 'mzero'@+-- [/Right Zero/]+--   @m >> 'mzero' ≡ 'mzero'@+monadPlusLaws :: (MonadPlus f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Laws+monadPlusLaws p = Laws "MonadPlus"+  [ ("Left Identity", monadPlusLeftIdentity p)+  , ("Right Identity", monadPlusRightIdentity p)+  , ("Associativity", monadPlusAssociativity p)+  , ("Left Zero", monadPlusLeftZero p)+  , ("Right Zero", monadPlusRightZero p)+  ]+ -- | Tests the following applicative properties: -- -- [/Identity/]@@ -869,6 +894,18 @@   , ("Ap", monadAp p)   ] +-- | Tests the following monadic zipping properties:+--+-- [/Naturality/]+--   @liftM (f *** g) (mzip ma mb) = mzip (liftM f ma) (liftM g mb)@+--+-- In the laws above, the infix function @***@ refers to a typeclass+-- method of 'Arrow'.+monadZipLaws :: (MonadZip f, Applicative f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Laws+monadZipLaws p = Laws "MonadZip"+  [ ("Naturality", monadZipNaturality p)+  ]+ -- | Tests the following 'Foldable' properties: -- -- [/fold/]@@ -1220,13 +1257,13 @@  data LinearEquationM m = LinearEquationM (m LinearEquation) (m LinearEquation) -runLinearEquation :: Integer -> LinearEquation -> Integer-runLinearEquation x (LinearEquation a b) = a * x + b+runLinearEquation :: LinearEquation -> Integer -> Integer+runLinearEquation (LinearEquation a b) x = a * x + b  runLinearEquationM :: Functor m => LinearEquationM m -> Integer -> m Integer runLinearEquationM (LinearEquationM e1 e2) i = if odd i-  then fmap (runLinearEquation i) e1-  else fmap (runLinearEquation i) e2+  then fmap (flip runLinearEquation i) e1+  else fmap (flip runLinearEquation i) e2  instance Eq1 m => Eq (LinearEquationM m) where   LinearEquationM a1 b1 == LinearEquationM a2 b2 = eq1 a1 a2 && eq1 b1 b2@@ -1337,6 +1374,21 @@ alternativeAssociativity :: forall proxy f. (Alternative f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Property alternativeAssociativity _ = property $ \(Apply (a :: f Integer)) (Apply (b :: f Integer)) (Apply (c :: f Integer)) -> eq1 (a <|> (b <|> c)) ((a <|> b) <|> c) +monadPlusLeftIdentity :: forall proxy f. (MonadPlus f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Property+monadPlusLeftIdentity _ = property $ \(Apply (a :: f Integer)) -> eq1 (mplus mzero a) a++monadPlusRightIdentity :: forall proxy f. (MonadPlus f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Property+monadPlusRightIdentity _ = property $ \(Apply (a :: f Integer)) -> eq1 (mplus a mzero) a++monadPlusAssociativity :: forall proxy f. (MonadPlus f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Property+monadPlusAssociativity _ = property $ \(Apply (a :: f Integer)) (Apply (b :: f Integer)) (Apply (c :: f Integer)) -> eq1 (mplus a (mplus b c)) (mplus (mplus a b) c)++monadPlusLeftZero :: forall proxy f. (MonadPlus f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Property+monadPlusLeftZero _ = property $ \(k' :: LinearEquationM f) -> eq1 (mzero >>= runLinearEquationM k') mzero++monadPlusRightZero :: forall proxy f. (MonadPlus f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Property+monadPlusRightZero _ = property $ \(Apply (a :: f Integer)) -> eq1 (a >> (mzero :: f Integer)) mzero+ applicativeIdentity :: forall proxy f. (Applicative f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Property applicativeIdentity _ = property $ \(Apply (a :: f Integer)) -> eq1 (pure id <*> a) a @@ -1365,6 +1417,12 @@ monadLeftIdentity _ = property $ \(k' :: LinearEquationM f) (a :: Integer) ->    let k = runLinearEquationM k'    in eq1 (return a >>= k) (k a)++monadZipNaturality :: forall proxy f. (MonadZip f, Functor f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Property+monadZipNaturality _ = property $ \(f' :: LinearEquation) (g' :: LinearEquation) (Apply (ma :: f Integer)) (Apply (mb :: f Integer)) -> +  let f = runLinearEquation f'+      g = runLinearEquation g'+   in eq1 (liftM (f *** g) (mzip ma mb)) (mzip (liftM f ma) (liftM g mb))  monadRightIdentity :: forall proxy f. (Monad f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Property monadRightIdentity _ = property $ \(Apply (m :: f Integer)) ->
src/Test/QuickCheck/Classes/IsList.hs view
@@ -32,14 +32,21 @@   , traverseProp   , generateProp   , generateMProp+  , replicateProp+  , replicateMProp+  , filterProp+  , filterMProp+  , mapMaybeProp+  , mapMaybeMProp #endif   ) where  #if MIN_VERSION_base(4,7,0) import Control.Monad.ST (ST,runST)-import Control.Monad (mapM)+import Control.Monad (mapM,filterM,replicateM) import Control.Applicative (liftA2) import GHC.Exts (IsList,Item,toList,fromList)+import Data.Maybe (mapMaybe,catMaybes) import Data.Proxy (Proxy) import Data.Foldable (foldlM) import Test.QuickCheck (Property,Arbitrary,Function,CoArbitrary,(===),property,@@ -117,6 +124,56 @@ generateMProp _ f = property $ \(NonNegative len) func ->   fromList (runST (stGenerateList len (stApplyFun func))) === runST (f len (stApplyFun func)) +replicateProp :: (Item c ~ a, Eq c, Show c, IsList c, Arbitrary a, Show a)+  => Proxy a -- ^ input element type+  -> (Int -> a -> c) -- replicate function+  -> Property+replicateProp _ f = property $ \(NonNegative len) a ->+  fromList (replicate len a) === f len a++replicateMProp :: (Item c ~ a, Eq c, Show c, IsList c, Arbitrary a, Show a)+  => Proxy a -- ^ input element type+  -> (forall s. Int -> ST s a -> ST s c) -- replicate function+  -> Property+replicateMProp _ f = property $ \(NonNegative len) a ->+  fromList (runST (replicateM len (return a))) === runST (f len (return a))++-- | Property for the @filter@ function, which keeps elements for which+-- the predicate holds true.+filterProp :: (IsList c, Item c ~ a, Arbitrary c, Show c, Show a, Eq c, CoArbitrary a, Function a)+  => Proxy a -- ^ element type+  -> ((a -> Bool) -> c -> c) -- ^ map function+  -> Property+filterProp _ f = property $ \c func ->+  fromList (filter (applyFun func) (toList c)) === f (applyFun func) c++-- | Property for the @filterM@ function, which keeps elements for which+-- the predicate holds true in an applicative context.+filterMProp :: (IsList c, Item c ~ a, Arbitrary c, Show c, Show a, Eq c, CoArbitrary a, Function a)+  => Proxy a -- ^ element type+  -> (forall s. (a -> ST s Bool) -> c -> ST s c) -- ^ traverse function+  -> Property+filterMProp _ f = property $ \c func ->+  fromList (runST (filterM (return . applyFun func) (toList c))) === runST (f (return . applyFun func) c)++-- | Property for the @mapMaybe@ function, which keeps elements for which+-- the predicate holds true.+mapMaybeProp :: (IsList c, Item c ~ a, Item d ~ b, Eq d, IsList d, Arbitrary b, Show d, Show b, Arbitrary c, Show c, Show a, Eq c, CoArbitrary a, Function a)+  => Proxy a -- ^ input element type+  -> Proxy b -- ^ output element type+  -> ((a -> Maybe b) -> c -> d) -- ^ map function+  -> Property+mapMaybeProp _ _ f = property $ \c func ->+  fromList (mapMaybe (applyFun func) (toList c)) === f (applyFun func) c++mapMaybeMProp :: (IsList c, IsList d, Eq d, Show d, Show b, Item c ~ a, Item d ~ b, Arbitrary c, Arbitrary b, Show c, Show a, CoArbitrary a, Function a)+  => Proxy a -- ^ input element type+  -> Proxy b -- ^ output element type+  -> (forall s. (a -> ST s (Maybe b)) -> c -> ST s d) -- ^ traverse function+  -> Property+mapMaybeMProp _ _ f = property $ \c func ->+  fromList (runST (mapMaybeMList (return . applyFun func) (toList c))) === runST (f (return . applyFun func) c)+ imapList :: (Int -> a -> b) -> [a] -> [b] imapList f xs = map (uncurry f) (zip (enumFrom 0) xs) @@ -124,6 +181,9 @@ imapMList f = go 0 where   go !_ [] = return []   go !ix (x : xs) = liftA2 (:) (f ix x) (go (ix + 1) xs)++mapMaybeMList :: Applicative f => (a -> f (Maybe b)) -> [a] -> f [b]+mapMaybeMList f = fmap catMaybes . traverse f  generateList :: Int -> (Int -> a) -> [a] generateList len f = go 0 where
test/Spec.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE ScopedTypeVariables #-}  import Control.Monad+import Control.Monad.Zip (MonadZip) import Control.Applicative #if defined(VERSION_aeson) import Data.Aeson (ToJSON,FromJSON)@@ -88,11 +89,13 @@  #if MIN_VERSION_QuickCheck(2,10,0) #if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)-allHigherLaws :: (Traversable f, Monad f, Applicative f, Eq1 f, Arbitrary1 f, Show1 f) => proxy f -> [Laws]+allHigherLaws :: (Traversable f, MonadZip f, MonadPlus f, Applicative f, Eq1 f, Arbitrary1 f, Show1 f) => proxy f -> [Laws] allHigherLaws p =    [ functorLaws p   , applicativeLaws p   , monadLaws p+  , monadPlusLaws p+  , monadZipLaws p   , foldableLaws p   , traversableLaws p   ]