quickcheck-classes 0.3.1 → 0.3.2

raw patch · 3 files changed

+68/−13 lines, 3 files

Files

• quickcheck-classes.cabal +1/−1
• src/Test/QuickCheck/Classes.hs +65/−11
• test/Spec.hs +2/−1

@@ -1,5 +1,5 @@ name: quickcheck-classes-version: 0.3.1+version: 0.3.2 synopsis: QuickCheck common typeclasses description:   This library provides quickcheck properties to

@@ -45,6 +45,7 @@   , isListLaws   , primLaws   , storableLaws+  , integralLaws #if MIN_VERSION_QuickCheck(2,10,0)     -- ** Higher-Kinded Types   , functorLaws@@ -140,10 +141,19 @@ foldlMapM :: (Foldable t, Monoid b, Monad m) => (a -> m b) -> t a -> m b foldlMapM f = foldlM (\b a -> fmap (mappend b) (f a)) mempty +-- | Tests the following properties:+--+-- [/Partial Isomorphism/]+--   @decode . encode ≡ Just@+-- [/Encoding Equals Value/]+--   @decode . encode ≡ Just . toJSON@+--+-- Note that in the second propertiy, the type of decode is @ByteString -> Value@,+-- not @ByteString -> a@ jsonLaws :: (ToJSON a, FromJSON a, Show a, Arbitrary a, Eq a) => Proxy a -> Laws jsonLaws p = Laws "ToJSON/FromJSON"-  [ ("Encoding Equals Value", jsonEncodingEqualsValue p)-  , ("Partial Isomorphism", jsonEncodingPartialIsomorphism p)+  [ ("Partial Isomorphism", jsonEncodingPartialIsomorphism p)+  , ("Encoding Equals Value", jsonEncodingEqualsValue p)   ]  -- | Tests the following properties:@@ -228,6 +238,21 @@   [ ("Commutative", monoidCommutative p)   ] +-- | Tests the following properties:+--+-- [/Quotient Remainder/]+--   @(quot x y) * y + (rem x y) ≡ x@+-- [/Division Modulus/]+--   @(div x y) * y + (mod x y) ≡ x@+-- [/Integer Roundtrip/]+--   @fromInteger (toInteger x) ≡ x@+integralLaws :: (Integral a, Arbitrary a, Show a) => Proxy a -> Laws+integralLaws p = Laws "Monoid"+  [ ("Quotient Remainder", integralQuotientRemainder p)+  , ("Division Modulus", integralDivisionModulus p)+  , ("Integer Roundtrip", integralIntegerRoundtrip p)+  ]+ -- | Test that a 'Prim' instance obey the several laws. primLaws :: (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws primLaws p = Laws "Prim"@@ -248,7 +273,7 @@   ]  isListPartialIsomorphism :: forall a. (IsList a, Show a, Arbitrary a, Eq a) => Proxy a -> Property-isListPartialIsomorphism _ = myForAllShrink False+isListPartialIsomorphism _ = myForAllShrink False (const True)   (\(a :: a) -> ["a = " ++ show a])   "fromList (toList a)"   (\a -> fromList (toList a))@@ -314,7 +339,7 @@ semigroupAssociative _ = property $ \(a :: a) b c -> a SG.<> (b SG.<> c) == (a SG.<> b) SG.<> c  monoidAssociative :: forall a. (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Property-monoidAssociative _ = myForAllShrink True+monoidAssociative _ = myForAllShrink True (const True)   (\(a :: a,b,c) -> ["a = " ++ show a, "b = " ++ show b, "c = " ++ show c])   "mappend a (mappend b c)"   (\(a,b,c) -> mappend a (mappend b c))@@ -322,7 +347,7 @@   (\(a,b,c) -> mappend (mappend a b) c)  monoidLeftIdentity :: forall a. (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Property-monoidLeftIdentity _ = myForAllShrink False+monoidLeftIdentity _ = myForAllShrink False (const True)   (\(a :: a) -> ["a = " ++ show a])   "mappend mempty a"   (\a -> mappend mempty a)@@ -330,15 +355,44 @@   (\a -> a)  monoidRightIdentity :: forall a. (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Property-monoidRightIdentity _ = myForAllShrink False+monoidRightIdentity _ = myForAllShrink False (const True)   (\(a :: a) -> ["a = " ++ show a])   "mappend a mempty"   (\a -> mappend a mempty)   "a"   (\a -> a) +integralQuotientRemainder :: forall a. (Integral a, Arbitrary a, Show a) => Proxy a -> Property+integralQuotientRemainder _ = myForAllShrink False (\(_,y) -> y /= 0)+  (\(x :: a, y) -> ["x = " ++ show x, "y = " ++ show y])+  "(quot x y) * y + (rem x y)"+  (\(x,y) -> (quot x y) * y + (rem x y))+  "x"+  (\(x,_) -> x)++integralDivisionModulus :: forall a. (Integral a, Arbitrary a, Show a) => Proxy a -> Property+integralDivisionModulus _ = myForAllShrink False (\(_,y) -> y /= 0)+  (\(x :: a, y) -> ["x = " ++ show x, "y = " ++ show y])+  "(div x y) * y + (mod x y)"+  (\(x,y) -> (div x y) * y + (mod x y))+  "x"+  (\(x,_) -> x)++integralIntegerRoundtrip :: forall a. (Integral a, Arbitrary a, Show a) => Proxy a -> Property+integralIntegerRoundtrip _ = myForAllShrink False (const True)+  (\(x :: a) -> ["x = " ++ show x])+  "fromInteger (toInteger x)"+  (\x -> fromInteger (toInteger x))+  "x"+  (\x -> x)+ monoidCommutative :: forall a. (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Property-monoidCommutative _ = property $ \(a :: a) b -> mappend a b == mappend b a+monoidCommutative _ = myForAllShrink True (const True)+  (\(a :: a,b) -> ["a = " ++ show a, "b = " ++ show b])+  "mappend a b"+  (\(a,b) -> mappend a b)+  "mappend b a"+  (\(a,b) -> mappend b a)  primListByteArray :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property primListByteArray _ = property $ \(as :: [a]) ->@@ -854,8 +908,8 @@  #endif -myForAllShrink :: (Arbitrary a, Show b, Eq b) => Bool -> (a -> [String]) -> String -> (a -> b) -> String -> (a -> b) -> Property-myForAllShrink displayRhs showInputs name1 calc1 name2 calc2 =+myForAllShrink :: (Arbitrary a, Show b, Eq b) => Bool -> (a -> Bool) -> (a -> [String]) -> String -> (a -> b) -> String -> (a -> b) -> Property+myForAllShrink displayRhs isValid showInputs name1 calc1 name2 calc2 =   again $   MkProperty $   arbitrary >>= \x ->@@ -866,6 +920,6 @@           sb1 = show b1           sb2 = show b2           description = "  Description: " ++ name1 ++ " = " ++ name2-          err = description ++ "\n" ++ unlines (map ("  " ++) (showInputs x)) ++ "  " ++ name1 ++ " = " ++ sb1 ++ (if displayRhs then "\n  " ++ name2 ++ " = " ++ sb2 else "")-       in counterexample err (b1 == b2)+          err = description ++ "\n" ++ unlines (map ("  " ++) (showInputs x')) ++ "  " ++ name1 ++ " = " ++ sb1 ++ (if displayRhs then "\n  " ++ name2 ++ " = " ++ sb2 else "")+       in isValid x' ==> counterexample err (b1 == b2) 

@@ -35,7 +35,7 @@   , ("Vector",[isListLaws (Proxy :: Proxy (Vector Word))])   ] -allLaws :: forall a. (Num a, Prim a, Storable a, Ord a, Arbitrary a, Show a, Read a, ToJSON a, FromJSON a) => Proxy a -> [Laws]+allLaws :: forall a. (Integral a, Prim a, Storable a, Ord a, Arbitrary a, Show a, Read a, ToJSON a, FromJSON a) => Proxy a -> [Laws] allLaws p =    [ primLaws p   , storableLaws p@@ -44,6 +44,7 @@   , jsonLaws p   , eqLaws p   , ordLaws p+  , integralLaws p   ]  foldlMapM :: (Foldable t, Monoid b, Monad m) => (a -> m b) -> t a -> m b