packages feed

quickcheck-classes 0.2 → 0.3

raw patch · 3 files changed

+386/−62 lines, 3 filesdep +transformersdep +vector

Dependencies added: transformers, vector

Files

quickcheck-classes.cabal view
@@ -1,5 +1,5 @@ name: quickcheck-classes-version: 0.2+version: 0.3 synopsis: QuickCheck common typeclasses description: QuickCheck common typeclasses homepage: https://github.com/andrewthad/quickcheck-classes#readme@@ -20,6 +20,7 @@   build-depends:       base >= 4.7 && < 5     , QuickCheck+    , transformers     , primitive     , prim-array     , aeson@@ -35,6 +36,7 @@     , QuickCheck     , primitive     , aeson+    , vector   default-language: Haskell2010  source-repository head
src/Test/QuickCheck/Classes.hs view
@@ -1,44 +1,84 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -Wall #-}++{-|++This library provides lists of properties that should hold for common typeclasses.+All of these take a 'Proxy' argument that is used to nail down the type for which+the typeclass dictionaries should be tested. For example, at GHCi:++>>> lawsCheck (monoidLaws (Proxy :: Proxy Ordering))+Monoid: Associative +++ OK, passed 100 tests.+Monoid: Left Identity +++ OK, passed 100 tests.+Monoid: Right Identity +++ OK, passed 100 tests.++Assuming that the 'Arbitrary' instance for 'Ordering' is good, we now+have confidence that the 'Monoid' instance for 'Ordering' satisfies+the monoid laws. We can check multiple typeclasses with:++>>> foldMap (lawsCheck . ($ (Proxy :: Proxy Word))) [jsonLaws,showReadLaws]+ToJSON/FromJSON: Encoding Equals Value +++ OK, passed 100 tests.+ToJSON/FromJSON: Partial Isomorphism +++ OK, passed 100 tests.+Show/Read: Partial Isomorphism +++ OK, passed 100 tests.++-} module Test.QuickCheck.Classes-  ( primProps-  , storableProps-  , semigroupProps-  , monoidProps-  , showReadProps-  , jsonProps-  , eqProps+  ( -- * Running+    lawsCheck+    -- * Properties+    -- ** Ground Types+  , semigroupLaws+  , monoidLaws+  , commutativeMonoidLaws+  , eqLaws+  , ordLaws+  , showReadLaws+  , jsonLaws+  , isListLaws+  , primLaws+  , storableLaws #if MIN_VERSION_QuickCheck(2,10,0)-  , functorProps-  , applicativeProps-  , monadProps+    -- ** Higher-Kinded Types+  , functorLaws+  , applicativeLaws+  , monadLaws+  , foldableLaws #endif+    -- * Types+  , Laws(..)   ) where  import Test.QuickCheck+import Test.QuickCheck.Monadic (monadicIO) import Data.Primitive hiding (sizeOf,newArray,copyArray) import Data.Primitive.PrimArray import Data.Proxy import Control.Monad.ST import Control.Monad-import Data.Monoid (Endo(..))+import Data.Monoid (Endo(..),Sum(..),Dual(..)) import GHC.Ptr (Ptr(..)) import Data.Primitive.Addr (Addr(..)) import Foreign.Marshal.Alloc import System.IO.Unsafe import Data.Semigroup (Semigroup)-import GHC.Exts (fromList,toList)+import GHC.Exts (IsList(fromList,toList,fromListN),Item) import Foreign.Marshal.Array import Foreign.Storable import Text.Read (readMaybe) import Data.Aeson (FromJSON(..),ToJSON(..)) import Data.Functor.Classes import Control.Applicative+import Data.Foldable (foldlM,fold,foldMap,foldl',foldr')+import Control.Exception (ErrorCall,evaluate,try)+import Control.Monad.Trans.Class (lift)+import qualified Data.Foldable as F import qualified Data.Aeson as AE import qualified Data.Primitive as P import qualified Data.Semigroup as SG@@ -48,14 +88,46 @@ import Test.QuickCheck.Arbitrary (Arbitrary1(..)) #endif -jsonProps :: (ToJSON a, FromJSON a, Show a, Arbitrary a, Eq a) => Proxy a -> [(String,Property)]-jsonProps p =+-- | A set of laws associated with a typeclass.+data Laws = Laws+  { lawsTypeclass :: String+    -- ^ Name of the typeclass whose laws are tested+  , lawsProperties :: [(String,Property)]+    -- ^ Pairs of law name and property+  }++-- | A convenience for working testing properties in GHCi.+--   See the test suite of this library for an example of how to+--   integrate multiple properties into larger test suite.+lawsCheck :: Laws -> IO ()+lawsCheck (Laws className properties) = do+  flip foldlMapM properties $ \(name,p) -> do+    putStr (className ++ ": " ++ name ++ " ")+    quickCheck p++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++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)   ] -showReadProps :: (Show a, Read a, Eq a, Arbitrary a) => Proxy a -> [(String,Property)]-showReadProps p =+-- | Tests the following properties:+--+-- [/Partial Isomorphism/]+--   @fromList . toList ≡ id@+-- [/Length Preservation/]+--   @fromList xs ≡ fromListN (length xs) xs@+isListLaws :: (IsList a, Show a, Show (Item a), Arbitrary a, Arbitrary (Item a), Eq a) => Proxy a -> Laws+isListLaws p = Laws "IsList"+  [ ("Partial Isomorphism", isListPartialIsomorphism p)+  , ("Length Preservation", isListLengthPreservation p)+  ]++showReadLaws :: (Show a, Read a, Eq a, Arbitrary a) => Proxy a -> Laws+showReadLaws p = Laws "Show/Read"   [ ("Partial Isomorphism", showReadPartialIsomorphism p)   ] @@ -63,8 +135,8 @@ -- -- [/Associative/] --   @a <> (b <> c) ≡ (a <> b) <> c@-semigroupProps :: (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> [(String,Property)]-semigroupProps p =+semigroupLaws :: (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws+semigroupLaws p = Laws "Semigroup"   [ ("Associative", semigroupAssociative p)   ] @@ -74,34 +146,59 @@ --   @a == b ∧ b == c ⇒ a == c@ -- [/Symmetric/] --   @a == b ⇒ b == a@+-- [/Reflexive/]+--   @a == a@ -- -- Some of these properties involve implication. In the case that -- the left hand side of the implication arrow does not hold, we -- do not retry. Consequently, these properties only end up being -- useful when the data type has a small number of inhabitants.-eqProps :: (Eq a, Arbitrary a, Show a) => Proxy a -> [(String,Property)]-eqProps p =+eqLaws :: (Eq a, Arbitrary a, Show a) => Proxy a -> Laws+eqLaws p = Laws "Eq"   [ ("Transitive", eqTransitive p)   , ("Symmetric", eqSymmetric p)+  , ("Reflexive", eqReflexive p)   ]  -- | Tests the following properties: --+-- [/Transitive/]+--   @a ≤ b ∧ b ≤ c ⇒ a ≤ c@+-- [/Comparable/]+--   @a ≤ b ∨ a > b@+ordLaws :: (Ord a, Arbitrary a, Show a) => Proxy a -> Laws+ordLaws p = Laws "Ord"+  [ ("Transitive", ordTransitive p)+  , ("Comparable", ordComparable p)+  ]++-- | Tests the following properties:+-- -- [/Associative/] --   @mappend a (mappend b c) ≡ mappend (mappend a b) c@ -- [/Left Identity/] --   @mappend mempty a ≡ a@ -- [/Right Identity/] --   @mappend a mempty ≡ a@-monoidProps :: (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> [(String,Property)]-monoidProps p =+monoidLaws :: (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws+monoidLaws p = Laws "Monoid"   [ ("Associative", monoidAssociative p)   , ("Left Identity", monoidLeftIdentity p)   , ("Right Identity", monoidRightIdentity p)   ] -primProps :: (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> [(String,Property)]-primProps p =+-- | Tests everything from 'monoidProps' plus the following:+--+-- [/Commutative/]+--   @mappend a b ≡ mappend b a@+commutativeMonoidLaws :: (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws+commutativeMonoidLaws p = Laws "Commutative Monoid" $ lawsProperties (monoidLaws p) +++  [ ("Commutative", monoidCommutative 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"   [ ("ByteArray Set-Get (you get back what you put in)", primSetGetByteArray p)   , ("ByteArray Get-Set (putting back what you got out has no effect)", primGetSetByteArray p)   , ("ByteArray Set-Set (setting twice is same as setting once)", primSetSetByteArray p)@@ -111,13 +208,21 @@   , ("Addr List Conversion Roundtrips", primListAddr p)   ] -storableProps :: (Storable a, Eq a, Arbitrary a, Show a) => Proxy a -> [(String,Property)]-storableProps p =+storableLaws :: (Storable a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws+storableLaws p = Laws "Storable"   [ ("Set-Get (you get back what you put in)", storableSetGet p)   , ("Get-Set (putting back what you got out has no effect)", storableGetSet p)   , ("List Conversion Roundtrips", storableList p)   ] +isListPartialIsomorphism :: forall a. (IsList a, Show a, Arbitrary a, Eq a) => Proxy a -> Property+isListPartialIsomorphism _ = property $ \(a :: a) ->+  fromList (toList a) == a++isListLengthPreservation :: forall a. (IsList a, Show (Item a), Arbitrary (Item a), Eq a) => Proxy a -> Property+isListLengthPreservation _ = property $ \(xs :: [Item a]) ->+  (fromList xs :: a) == fromListN (length xs) xs+ showReadPartialIsomorphism :: forall a. (Show a, Read a, Arbitrary a, Eq a) => Proxy a -> Property showReadPartialIsomorphism _ = property $ \(a :: a) ->   readMaybe (show a) == Just a@@ -143,11 +248,32 @@     True -> a /= c     False -> True +-- Technically, this tests something a little stronger than it is supposed to.+-- But that should be alright since this additional strength is implied by+-- the rest of the Ord laws.+ordTransitive :: forall a. (Show a, Ord a, Arbitrary a) => Proxy a -> Property+ordTransitive _ = property $ \(a :: a) b c -> case (compare a b, compare b c) of+  (LT,LT) -> a < c+  (LT,EQ) -> a < c+  (LT,GT) -> True+  (EQ,LT) -> a < c+  (EQ,EQ) -> a == c+  (EQ,GT) -> a > c+  (GT,LT) -> True+  (GT,EQ) -> a > c+  (GT,GT) -> a > c++ordComparable :: forall a. (Show a, Ord a, Arbitrary a) => Proxy a -> Property+ordComparable _ = property $ \(a :: a) b -> a > b || b >= a+ eqSymmetric :: forall a. (Show a, Eq a, Arbitrary a) => Proxy a -> Property eqSymmetric _ = property $ \(a :: a) b -> case a == b of   True -> b == a   False -> b /= a +eqReflexive :: forall a. (Show a, Eq a, Arbitrary a) => Proxy a -> Property+eqReflexive _ = property $ \(a :: a) -> a == a+ semigroupAssociative :: forall a. (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Property semigroupAssociative _ = property $ \(a :: a) b c -> a SG.<> (b SG.<> c) == (a SG.<> b) SG.<> c @@ -160,6 +286,9 @@ monoidRightIdentity :: forall a. (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Property monoidRightIdentity _ = property $ \(a :: a) -> mappend a mempty == a +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+ primListByteArray :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property primListByteArray _ = property $ \(as :: [a]) ->   as == toList (fromList as :: PrimArray a)@@ -308,8 +437,8 @@ --   @fmap (f . g) ≡ 'fmap' f . 'fmap' g@ -- [/Const/] --   @(<$) ≡ 'fmap' 'const'@-functorProps :: (Functor f, Eq1 f, Show1 f, Arbitrary1 f) => Proxy f -> [(String,Property)]-functorProps p =+functorLaws :: (Functor f, Eq1 f, Show1 f, Arbitrary1 f) => Proxy f -> Laws+functorLaws p = Laws "Functor"   [ ("Identity", functorIdentity p)   , ("Composition", functorComposition p)   , ("Const", functorConst p)@@ -327,8 +456,8 @@ --   @u '<*>' 'pure' y ≡ 'pure' ('$' y) '<*>' u@ -- [/LiftA2 (1)/] --   @('<*>') ≡ 'liftA2' 'id'@-applicativeProps :: (Applicative f, Eq1 f, Show1 f, Arbitrary1 f) => Proxy f -> [(String,Property)]-applicativeProps p =+applicativeLaws :: (Applicative f, Eq1 f, Show1 f, Arbitrary1 f) => Proxy f -> Laws+applicativeLaws p = Laws "Applicative"   [ ("Identity", applicativeIdentity p)   , ("Composition", applicativeComposition p)   , ("Homomorphism", applicativeHomomorphism p)@@ -350,8 +479,8 @@ --   @'pure' ≡ 'return'@ -- [/Ap/] --   @('<*>') ≡ 'ap'@-monadProps :: (Monad f, Eq1 f, Show1 f, Arbitrary1 f) => Proxy f -> [(String,Property)]-monadProps p =+monadLaws :: (Monad f, Eq1 f, Show1 f, Arbitrary1 f) => Proxy f -> Laws+monadLaws p = Laws "Monad"   [ ("Left Identity", monadLeftIdentity p)   , ("Right Identity", monadRightIdentity p)   , ("Associativity", monadAssociativity p)@@ -359,14 +488,156 @@   , ("Ap", monadAp p)   ] +-- | Tests the following 'Foldable' properties:+--+-- [/fold/]+--   @'fold' ≡ 'foldMap' 'id'@+-- [/foldMap/]+--   @'foldMap' f ≡ 'foldr' ('mappend' . f) 'mempty'@+-- [/foldr/]+--   @'foldr' f z t ≡ 'appEndo' ('foldMap' ('Endo' . f) t ) z@+-- [/foldr'/]+--   @'foldr'' f z0 xs = let f\' k x z = k '$!' f x z in 'foldl' f\' 'id' xs z0@+-- [/foldl/]+--   @'foldl' f z t ≡ 'appEndo' ('getDual' ('foldMap' ('Dual' . 'Endo' . 'flip' f) t)) z@+-- [/foldl'/]+--   @'foldl'' f z0 xs = let f' x k z = k '$!' f z x in 'foldr' f\' 'id' xs z0@+-- [/toList/]+--   @'F.toList' ≡ 'foldr' (:) []@+-- [/null/]+--   @'null' ≡ 'foldr' ('const' ('const' 'False')) 'True'@+-- [/length/]+--   @'length' ≡ getSum . foldMap ('const' ('Sum' 1))@+--+-- Note that this checks to ensure that @foldl\'@ and @foldr\'@+-- are suitably strict.+foldableLaws :: (Foldable f, Eq1 f, Show1 f, Arbitrary1 f) => Proxy f -> Laws+foldableLaws = foldableLawsInternal++foldableLawsInternal :: forall f. (Foldable f, Eq1 f, Show1 f, Arbitrary1 f) => Proxy f -> Laws+foldableLawsInternal p = Laws "Foldable"+  [ (,) "fold" $ property $ \(Apply (a :: f (Sum Integer))) ->+      fold a == foldMap id a+  , (,) "foldMap" $ property $ \(Apply (a :: f Integer)) (e :: Equation) ->+      let f = Sum . runEquation e+       in foldMap f a == foldr (mappend . f) mempty a+  , (,) "foldr" $ property $ \(e :: EquationTwo) (z :: Integer) (Apply (t :: f Integer)) ->+      let f = runEquationTwo e+       in foldr f z t == appEndo (foldMap (Endo . f) t) z+  , (,) "foldr'" (foldableFoldr' p)+  , (,) "foldl" $ property $ \(e :: EquationTwo) (z :: Integer) (Apply (t :: f Integer)) ->+      let f = runEquationTwo e+       in foldl f z t == appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z+  , (,) "foldl'" (foldableFoldl' p)+  , (,) "toList" $ property $ \(Apply (t :: f Integer)) ->+      eq1 (F.toList t) (foldr (:) [] t)+  , (,) "null" $ property $ \(Apply (t :: f Integer)) ->+      null t == foldr (const (const False)) True t+  , (,) "length" $ property $ \(Apply (t :: f Integer)) ->+      length t == getSum (foldMap (const (Sum 1)) t)+  ]++foldableFoldl' :: forall f. (Foldable f, Eq1 f, Show1 f, Arbitrary1 f) => Proxy f -> Property+foldableFoldl' _ = property $ \(_ :: ChooseSecond) (_ :: LastNothing) (Apply (xs :: f (Bottom Integer))) ->+  monadicIO $ do+    let f :: Integer -> Bottom Integer -> Integer+        f a b = case b of+          BottomUndefined -> error "foldableFoldl' example"+          BottomValue v -> if even v+            then a+            else v+        z0 = 0+    r1 <- lift $ do+      let f' x k z = k $! f z x+      e <- try (evaluate (foldr f' id xs z0))+      case e of+        Left (_ :: ErrorCall) -> return Nothing+        Right i -> return (Just i)+    r2 <- lift $ do+      e <- try (evaluate (foldl' f z0 xs))+      case e of+        Left (_ :: ErrorCall) -> return Nothing+        Right i -> return (Just i)+    return (r1 == r2)++foldableFoldr' :: forall f. (Foldable f, Eq1 f, Show1 f, Arbitrary1 f) => Proxy f -> Property+foldableFoldr' _ = property $ \(_ :: ChooseFirst) (_ :: LastNothing) (Apply (xs :: f (Bottom Integer))) ->+  monadicIO $ do+    let f :: Bottom Integer -> Integer -> Integer+        f a b = case a of+          BottomUndefined -> error "foldableFoldl' example"+          BottomValue v -> if even v+            then v+            else b+        z0 = 0+    r1 <- lift $ do+      let f' k x z = k $! f x z+      e <- try (evaluate (foldl f' id xs z0))+      case e of+        Left (_ :: ErrorCall) -> return Nothing+        Right i -> return (Just i)+    r2 <- lift $ do+      e <- try (evaluate (foldr' f z0 xs))+      case e of+        Left (_ :: ErrorCall) -> return Nothing+        Right i -> return (Just i)+    return (r1 == r2)++data ChooseSecond = ChooseSecond+  deriving (Eq)++data ChooseFirst = ChooseFirst+  deriving (Eq)++data LastNothing = LastNothing+  deriving (Eq)++data Bottom a = BottomUndefined | BottomValue a+  deriving (Eq)++instance Show ChooseFirst where+  show ChooseFirst = "\\a b -> if even a then a else b"++instance Show ChooseSecond where+  show ChooseSecond = "\\a b -> if even b then a else b"++instance Show LastNothing where+  show LastNothing = "0"++instance Show a => Show (Bottom a) where+  show x = case x of+    BottomUndefined -> "undefined"+    BottomValue a -> show a++instance Arbitrary ChooseSecond where+  arbitrary = pure ChooseSecond++instance Arbitrary ChooseFirst where+  arbitrary = pure ChooseFirst++instance Arbitrary LastNothing where+  arbitrary = pure LastNothing++instance Arbitrary a => Arbitrary (Bottom a) where+  arbitrary = fmap maybeToBottom arbitrary+  shrink x = map maybeToBottom (shrink (bottomToMaybe x))++bottomToMaybe :: Bottom a -> Maybe a+bottomToMaybe BottomUndefined = Nothing+bottomToMaybe (BottomValue a) = Just a++maybeToBottom :: Maybe a -> Bottom a+maybeToBottom Nothing = BottomUndefined+maybeToBottom (Just a) = BottomValue a+ data Apply f a = Apply { getApply :: f a }  instance (Eq1 f, Eq a) => Eq (Apply f a) where   Apply a == Apply b = eq1 a b  data LinearEquation = LinearEquation-  { linearEquationLinear :: Integer-  , linearEquationConstant :: Integer+  { _linearEquationLinear :: Integer+  , _linearEquationConstant :: Integer   } deriving (Eq)  data LinearEquationM m = LinearEquationM (m LinearEquation) (m LinearEquation)@@ -432,7 +703,28 @@      in map (\(x,y,z) -> Equation (abs x) (abs y) (abs z)) xs  runEquation :: Equation -> Integer -> Integer-runEquation (Equation a b c) x = a * x ^ 2 + b * x + c+runEquation (Equation a b c) x = a * x ^ (2 :: Integer) + b * x + c++-- linear equation of two variables+data EquationTwo = EquationTwo Integer Integer+  deriving (Eq)++-- This show instance is does not actually provide a+-- way to create an EquationTwo. Instead, it makes it look+-- like a lambda that takes two variables.+instance Show EquationTwo where+  show (EquationTwo a b) = "\\x y -> " ++ show a ++ " * x + " ++ show b ++ " * y"++instance Arbitrary EquationTwo where+  arbitrary = do+    (a,b) <- arbitrary+    return (EquationTwo (abs a) (abs b))+  shrink (EquationTwo a b) =+    let xs = shrink (a,b)+     in map (\(x,y) -> EquationTwo (abs x) (abs y)) xs++runEquationTwo :: EquationTwo -> Integer -> Integer -> Integer+runEquationTwo (EquationTwo a b) x y = a * x + b * y  -- This show instance is intentionally a little bit wrong. -- We don't wrap the result in Apply since the end user
test/Spec.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -13,22 +14,26 @@ import Foreign.Storable import Data.Functor.Classes import Data.Aeson (ToJSON,FromJSON)+import Data.Vector (Vector) +import qualified Data.Vector as V+ import Test.QuickCheck.Classes  main :: IO () main = do   putStrLn "Testing properties for common typeclasses"-  r <- flip foldlMapM allPropsApplied $ \(typeName,properties) -> do+  r <- flip foldlMapM allPropsApplied $ \(typeName,laws) -> do     putStrLn $ "------------"     putStrLn $ "-- " ++ typeName     putStrLn $ "------------"-    flip foldlMapM properties $ \(name,p) -> do-      putStrLn name-      r <- quickCheckResult p-      return $ case r of-        Success _ _ _ -> Good-        _ -> Bad+    flip foldlMapM laws $ \(Laws typeClassName properties) -> do+      flip foldlMapM properties $ \(name,p) -> do+        putStr (typeClassName ++ ": " ++ name ++ " ")+        r <- quickCheckResult p+        return $ case r of+          Success _ _ _ -> Good+          _ -> Bad   putStrLn ""   case r of     Good -> putStrLn "All tests succeeded"@@ -41,34 +46,59 @@   mappend Good x = x   mappend Bad _ = Bad -allPropsApplied :: [(String,[(String,Property)])]+allPropsApplied :: [(String,[Laws])] allPropsApplied = -  [ ("Int",allProps (Proxy :: Proxy Int))-  , ("Int64",allProps (Proxy :: Proxy Int64))-  , ("Word",allProps (Proxy :: Proxy Word))-  , ("Maybe",allHigherProps (Proxy :: Proxy Maybe))-  , ("List",allHigherProps (Proxy :: Proxy []))+  [ ("Int",allLaws (Proxy :: Proxy Int))+  , ("Int64",allLaws (Proxy :: Proxy Int64))+  , ("Word",allLaws (Proxy :: Proxy Word))+#if MIN_VERSION_QuickCheck(2,10,0)+  , ("Maybe",allHigherLaws (Proxy :: Proxy Maybe))+  , ("List",allHigherLaws (Proxy :: Proxy []))+#endif+  , ("Vector",[isListLaws (Proxy :: Proxy (Vector Word))])   ] -allProps :: forall a. (Num a, Prim a, Storable a, Eq a, Arbitrary a, Show a, Read a, ToJSON a, FromJSON a) => Proxy a -> [(String,Property)]-allProps p = concat-  [ primProps p-  , storableProps p-  , monoidProps (Proxy :: Proxy (Sum a))-  , showReadProps p-  , jsonProps p-  , eqProps p+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 p = +  [ primLaws p+  , storableLaws p+  , monoidLaws (Proxy :: Proxy (Sum a))+  , showReadLaws p+  , jsonLaws p+  , eqLaws p+  , ordLaws p   ]  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  #if MIN_VERSION_QuickCheck(2,10,0)-allHigherProps :: (Monad f, Eq1 f, Arbitrary1 f, Show1 f) => Proxy f -> [(String,Property)]-allHigherProps p = concat-  [ functorProps p-  , applicativeProps p-  , monadProps p+allHigherLaws :: (Foldable f, Monad f, Eq1 f, Arbitrary1 f, Show1 f) => Proxy f -> [Laws]+allHigherLaws p = +  [ functorLaws p+  , applicativeLaws p+  , monadLaws p+  , foldableLaws p   ] #endif++-- This type is fails the laws for the strict functions+-- in Foldable. It is used just to confirm that+-- those property tests actually work.+newtype Rouge a = Rouge [a]+  deriving (Eq,Show,Arbitrary,Arbitrary1,Eq1,Show1)++instance Foldable Rouge where+  foldMap f (Rouge xs) = foldMap f xs+  foldl f x (Rouge xs) = foldl f x xs+  foldl' f x (Rouge xs) = foldl f x xs+  foldr' f x (Rouge xs) = foldr f x xs++-------------------+-- Orphan Instances+-------------------++instance Arbitrary a => Arbitrary (Vector a) where+  arbitrary = V.fromList <$> arbitrary+  shrink v = map V.fromList (shrink (V.toList v))