packages feed

quickcheck-classes 0.6.2.1 → 0.6.2.2

raw patch · 7 files changed

+271/−5 lines, 7 filesdep ~primitive-addr

Dependency ranges changed: primitive-addr

Files

changelog.md view
@@ -4,6 +4,11 @@ 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.6.2.2] - 2019-06-18+### Added+- `numLaws`+- `bitraversableLaws`+ ## [0.6.2.1] - 2019-05-23 ### Fixed - Removal of BadList test that was causing the test suite to fail
quickcheck-classes.cabal view
@@ -1,5 +1,5 @@ name: quickcheck-classes-version: 0.6.2.1+version: 0.6.2.2 synopsis: QuickCheck common typeclasses description:   This library provides QuickCheck properties to ensure@@ -85,6 +85,7 @@     -- Test.QuickCheck.Classes.Arrow     Test.QuickCheck.Classes.Bifoldable     Test.QuickCheck.Classes.Bifunctor+    Test.QuickCheck.Classes.Bitraversable     Test.QuickCheck.Classes.Bits     Test.QuickCheck.Classes.Category     Test.QuickCheck.Classes.Common@@ -104,6 +105,7 @@     Test.QuickCheck.Classes.MonadZip     Test.QuickCheck.Classes.Monoid     Test.QuickCheck.Classes.MVector+    Test.QuickCheck.Classes.Num     Test.QuickCheck.Classes.Ord     Test.QuickCheck.Classes.Plus     Test.QuickCheck.Classes.Prim@@ -123,7 +125,7 @@     , QuickCheck >= 2.7     , transformers >= 0.3 && < 0.6     , primitive >= 0.7 && < 0.8-    , primitive-addr >= 0.1 && < 0.2+    , primitive-addr >= 0.1.0.1 && < 0.2     , containers >= 0.4.2.1     , semigroups >= 0.17     , tagged
src/Test/QuickCheck/Classes.hs view
@@ -6,9 +6,9 @@ {-| This library provides sets of properties that should hold for common     typeclasses. -    /Note:/ on GHC < 8.5, this library uses the higher-kinded typeclasses+    /Note:/ on GHC < 8.6, this library uses the higher-kinded typeclasses     ('Data.Functor.Classes.Show1', 'Data.Functor.Classes.Eq1', 'Data.Functor.Classes.Ord1', etc.),-    but on GHC >= 8.5, it uses `-XQuantifiedConstraints` to express these+    but on GHC >= 8.6, it uses @-XQuantifiedConstraints@ to express these     constraints more cleanly. -} module Test.QuickCheck.Classes@@ -22,6 +22,7 @@   , bitsLaws #endif   , eqLaws+  , numLaws   , integralLaws   , ixLaws #if MIN_VERSION_base(4,7,0)@@ -75,7 +76,9 @@ #endif #if HAVE_BINARY_LAWS     -- ** Binary type constructors+  , bifoldableLaws   , bifunctorLaws+  , bitraversableLaws    , categoryLaws   , commutativeCategoryLaws #if HAVE_SEMIGROUPOIDS@@ -100,6 +103,7 @@ import Test.QuickCheck.Classes.Bits import Test.QuickCheck.Classes.Enum import Test.QuickCheck.Classes.Eq+import Test.QuickCheck.Classes.Num import Test.QuickCheck.Classes.Integral import Test.QuickCheck.Classes.Ix #if MIN_VERSION_base(4,7,0)@@ -145,6 +149,8 @@ -- Binary type constructors #if HAVE_BINARY_LAWS import Test.QuickCheck.Classes.Bifunctor+import Test.QuickCheck.Classes.Bifoldable+import Test.QuickCheck.Classes.Bitraversable import Test.QuickCheck.Classes.Category #if HAVE_SEMIGROUPOIDS import Test.QuickCheck.Classes.Semigroupoid
+ src/Test/QuickCheck/Classes/Bitraversable.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}++#if HAVE_QUANTIFIED_CONSTRAINTS+{-# LANGUAGE QuantifiedConstraints #-}+#endif++{-# OPTIONS_GHC -Wall #-}++module Test.QuickCheck.Classes.Bitraversable+  (+#if HAVE_BINARY_LAWS+    bitraversableLaws+#endif+  ) where++import Data.Bitraversable(Bitraversable(..))+import Test.QuickCheck hiding ((.&.))+#if HAVE_BINARY_LAWS+import Data.Functor.Compose (Compose(..))+import Data.Functor.Identity (Identity(..))+import Data.Functor.Classes (Eq2,Show2)+#endif+import Test.QuickCheck.Property (Property)++import Test.QuickCheck.Classes.Common+#if HAVE_BINARY_LAWS+import Test.QuickCheck.Classes.Compat (eq1_2)+#endif++#if HAVE_BINARY_LAWS++-- | Tests the following 'Bitraversable' properties:+--+-- [/Naturality/]+--   @'bitraverse' (t '.' f) (t '.' g) ≡ t '.' 'bitraverse' f g@ for every applicative transformation @t@+-- [/Identity/]+--   @'bitraverse' 'Identity' 'Identity' ≡ 'Identity'@+-- [/Composition/] +--   @'Compose' '.' 'fmap' ('bitraverse' g1 g2) '.' 'bitraverse' f1 f2 ≡ 'bitraverse' ('Compose' '.' 'fmap' g1 g2 '.' f1) ('Compose' '.' 'fmap' g2 '.' f2)@+--+-- /Note/: This property test is only available when this package is built with+-- @base-4.9+@ or @transformers-0.5+@.+bitraversableLaws :: forall proxy f.+#if HAVE_QUANTIFIED_CONSTRAINTS+  (Bitraversable f, forall a b. (Eq a, Eq b) => Eq (f a b), forall a b. (Show a, Show b) => Show (f a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b))+#else+  (Bitraversable f, Eq2 f, Show2 f, Arbitrary2 f)+#endif+  => proxy f -> Laws+bitraversableLaws p = Laws "Bitraversable"+  [ ("Naturality", bitraversableNaturality p)+  , ("Identity", bitraversableIdentity p)+  , ("Composition", bitraversableComposition p)+  ]++bitraversableNaturality :: forall proxy f.+#if HAVE_QUANTIFIED_CONSTRAINTS+  (Bitraversable f, forall a b. (Eq a, Eq b) => Eq (f a b), forall a b. (Show a, Show b) => Show (f a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b))+#else+  (Bitraversable f, Eq2 f, Show2 f, Arbitrary2 f)+#endif+  => proxy f -> Property+bitraversableNaturality _ = property $ \(Apply2 (x :: f Integer Integer)) ->+  let t = apTrans+      f = func4+      g = func4+      x' = bitraverse (t . f) (t . g) x+      y' = t (bitraverse f g x)+  in eq1_2 x' y'++bitraversableIdentity :: forall proxy f.+#if HAVE_QUANTIFIED_CONSTRAINTS+  (Bitraversable f, forall a b. (Eq a, Eq b) => Eq (f a b), forall a b. (Show a, Show b) => Show (f a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b))+#else+  (Bitraversable f, Eq2 f, Show2 f, Arbitrary2 f)+#endif+  => proxy f -> Property+bitraversableIdentity _ = property $ \(Apply2 (x :: f Integer Integer)) -> eq1_2 (bitraverse Identity Identity x) (Identity x)++bitraversableComposition :: forall proxy f.+#if HAVE_QUANTIFIED_CONSTRAINTS+  (Bitraversable f, forall a b. (Eq a, Eq b) => Eq (f a b), forall a b. (Show a, Show b) => Show (f a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b))+#else+  (Bitraversable f, Eq2 f, Show2 f, Arbitrary2 f)+#endif+  => proxy f -> Property+bitraversableComposition _ = property $ \(Apply2 (x :: f Integer Integer)) ->+  let f1 = func6+      f2 = func5+      g1 = func4+      g2 = func4+      x' = Compose . fmap (bitraverse g1 g2) . bitraverse f1 f2 $ x+      y' = bitraverse (Compose . fmap g1 . f1) (Compose . fmap g2 . f2) x+  in eq1_2 x' y'++#endif
src/Test/QuickCheck/Classes/Compat.hs view
@@ -12,6 +12,7 @@ #endif #if HAVE_BINARY_LAWS   , eq2+  , eq1_2 #endif   , readMaybe   ) where@@ -52,11 +53,22 @@  #if HAVE_UNARY_LAWS #if HAVE_QUANTIFIED_CONSTRAINTS-eq1 :: (forall a. Eq a => Eq (f a), Eq a) => f a -> f a -> Bool+eq1 :: (forall x. Eq x => Eq (f x), Eq a) => f a -> f a -> Bool eq1 = (==) #else eq1 :: (C.Eq1 f, Eq a) => f a -> f a -> Bool eq1 = C.eq1+#endif+#endif++#if HAVE_UNARY_LAWS+#if HAVE_QUANTIFIED_CONSTRAINTS+eq1_2 :: (forall a. Eq a => Eq (f a), forall a b. (Eq a, Eq b) => Eq (g a b), Eq x, Eq y)+  => f (g x y) -> f (g x y) -> Bool+eq1_2 = (==)+#else+eq1_2 :: (C.Eq1 f, C.Eq2 g, Eq a, Eq b) => f (g a b) -> f (g a b) -> Bool+eq1_2 = C.liftEq C.eq2 #endif #endif
+ src/Test/QuickCheck/Classes/Num.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE ScopedTypeVariables #-}++{-# OPTIONS_GHC -Wall #-}++module Test.QuickCheck.Classes.Num+  ( numLaws+  ) where++import Data.Proxy (Proxy)+import Test.QuickCheck hiding ((.&.))+import Test.QuickCheck.Property (Property)++import Test.QuickCheck.Classes.Common (Laws(..), myForAllShrink)++-- | Tests the following properties:+--+-- [/Additive Commutativity/]+--   @a + b ≡ b + a@+-- [/Additive Left Identity/]+--   @0 + a ≡ a@+-- [/Additive Right Identity/]+--   @a + 0 ≡ a@+-- [/Multiplicative Associativity/]+--   @a * (b * c) ≡ (a * b) * c@+-- [/Multiplicative Left Identity/]+--   @1 * a ≡ a@+-- [/Multiplicative Right Identity/]+--   @a * 1 ≡ a@+-- [/Multiplication Left Distributes Over Addition/]+--   @a * (b + c) ≡ (a * b) + (a * c)@+-- [/Multiplication Right Distributes Over Addition/]+--   @(a + b) * c ≡ (a * c) + (b * c)@+-- [/Multiplicative Left Annihilation/]+--   @0 * a ≡ 0@+-- [/Multiplicative Right Annihilation/]+--   @a * 0 ≡ 0@+-- [/Additive Inverse/]+--   @'negate' a '+' a ≡ 0@+numLaws :: (Num a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws+numLaws p = Laws "Num"+  [ ("Additive Commutativity", numCommutativePlus p)+  , ("Additive Left Identity", numLeftIdentityPlus p)+  , ("Additive Right Identity", numRightIdentityPlus p)+  , ("Multiplicative Associativity", numAssociativeTimes p)+  , ("Multiplicative Left Identity", numLeftIdentityTimes p)+  , ("Multiplicative Right Identity", numRightIdentityTimes p)+  , ("Multiplication Left Distributes Over Addition", numLeftMultiplicationDistributes p)+  , ("Multiplication Right Distributes Over Addition", numRightMultiplicationDistributes p)+  , ("Multiplicative Left Annihilation", numLeftAnnihilation p)+  , ("Multiplicative Right Annihilation", numRightAnnihilation p)+  , ("Additive Inverse", numAdditiveInverse p)+  ]++numLeftMultiplicationDistributes :: forall a. (Num a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+numLeftMultiplicationDistributes _ = myForAllShrink True (const True)+  (\(a :: a,b,c) -> ["a = " ++ show a, "b = " ++ show b, "c = " ++ show c])+  "a * (b + c)"+  (\(a,b,c) -> a * (b + c))+  "(a * b) + (a * c)"+  (\(a,b,c) -> (a * b) + (a * c))++numRightMultiplicationDistributes :: forall a. (Num a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+numRightMultiplicationDistributes _ = myForAllShrink True (const True)+  (\(a :: a,b,c) -> ["a = " ++ show a, "b = " ++ show b, "c = " ++ show c])+  "(a + b) * c"+  (\(a,b,c) -> (a + b) * c)+  "(a * c) + (b * c)"+  (\(a,b,c) -> (a * c) + (b * c))++numLeftIdentityPlus :: forall a. (Num a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+numLeftIdentityPlus _ = myForAllShrink False (const True)+  (\(a :: a) -> ["a = " ++ show a])+  "0 + a"+  (\a -> 0 + a)+  "a"+  (\a -> a)++numRightIdentityPlus :: forall a. (Num a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+numRightIdentityPlus _ = myForAllShrink False (const True)+  (\(a :: a) -> ["a = " ++ show a])+  "a + 0"+  (\a -> a + 0)+  "a"+  (\a -> a)++numRightIdentityTimes :: forall a. (Num a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+numRightIdentityTimes _ = myForAllShrink False (const True)+  (\(a :: a) -> ["a = " ++ show a])+  "a * 1"+  (\a -> a * 1)+  "a"+  (\a -> a)++numLeftIdentityTimes :: forall a. (Num a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+numLeftIdentityTimes _ = myForAllShrink False (const True)+  (\(a :: a) -> ["a = " ++ show a])+  "1 * a"+  (\a -> 1 * a)+  "a"+  (\a -> a)++numLeftAnnihilation :: forall a. (Num a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+numLeftAnnihilation _ = myForAllShrink False (const True)+  (\(a :: a) -> ["a = " ++ show a])+  "0 * a"+  (\a -> 0 * a)+  "0"+  (\_ -> 0)++numRightAnnihilation :: forall a. (Num a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+numRightAnnihilation _ = myForAllShrink False (const True)+  (\(a :: a) -> ["a = " ++ show a])+  "a * 0"+  (\a -> a * 0)+  "0"+  (\_ -> 0)++numCommutativePlus :: forall a. (Num a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+numCommutativePlus _ = myForAllShrink True (const True)+  (\(a :: a,b) -> ["a = " ++ show a, "b = " ++ show b])+  "a + b"+  (\(a,b) -> a + b)+  "b + a"+  (\(a,b) -> b + a)++numAssociativeTimes :: forall a. (Num a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+numAssociativeTimes _ = myForAllShrink True (const True)+  (\(a :: a,b,c) -> ["a = " ++ show a, "b = " ++ show b, "c = " ++ show c])+  "a * (b * c)"+  (\(a,b,c) -> a * (b * c))+  "(a * b) * c"+  (\(a,b,c) -> (a * b) * c)++numAdditiveInverse :: forall a. (Num a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+numAdditiveInverse _ = myForAllShrink True (const True)+  (\(a :: a) -> ["a = " ++ show a])+  "negate a + a"+  (\a -> (-a) + a)+  "0"+  (const 0)
test/Spec.hs view
@@ -61,6 +61,8 @@   [ ("Int",allLaws (Proxy :: Proxy Int))   , ("Int64",allLaws (Proxy :: Proxy Int64))   , ("Word",allLaws (Proxy :: Proxy Word))+  , ("Tuple",[bitraversableLaws (Proxy :: Proxy (,))])+  , ("Either",[bitraversableLaws (Proxy :: Proxy Either)]) #if HAVE_UNARY_LAWS   , ("Maybe",allHigherLaws (Proxy1 :: Proxy1 Maybe))   , ("List",allHigherLaws (Proxy1 :: Proxy1 []))@@ -86,6 +88,7 @@  allLaws :: forall a.   ( Integral a+  , Num a   , Prim a   , Storable a   , Ord a@@ -113,6 +116,7 @@ #endif   , eqLaws p   , ordLaws p+  , numLaws p   , integralLaws p #if MIN_VERSION_base(4,7,0)   , bitsLaws p