packages feed

quickcheck-classes 0.4.12 → 0.4.13

raw patch · 9 files changed

+348/−3 lines, 9 files

Files

changelog.md view
@@ -4,6 +4,10 @@ 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.13] - 2018-07-18+### Added+- Laws for `Enum` typeclass.+ ## [0.4.12] - 2018-06-07 ### Added - Remaining laws for `Storable` typeclass.
quickcheck-classes.cabal view
@@ -1,5 +1,5 @@ name: quickcheck-classes-version: 0.4.12+version: 0.4.13 synopsis: QuickCheck common typeclasses description:   This library provides QuickCheck properties to ensure@@ -11,7 +11,7 @@ homepage: https://github.com/andrewthad/quickcheck-classes#readme license: BSD3 license-file: LICENSE-author: Andrew Martin+author: Andrew Martin, Daniel Cartwright maintainer: andrew.thaddeus@gmail.com copyright: 2018 Andrew Martin category: Testing@@ -53,16 +53,21 @@     Test.QuickCheck.Classes.Alt     Test.QuickCheck.Classes.Alternative     Test.QuickCheck.Classes.Applicative+    Test.QuickCheck.Classes.Apply+    -- Test.QuickCheck.Classes.Arrow     Test.QuickCheck.Classes.Bifunctor     Test.QuickCheck.Classes.Bits+    Test.QuickCheck.Classes.Category     Test.QuickCheck.Classes.Common     Test.QuickCheck.Classes.Compat+    Test.QuickCheck.Classes.Enum     Test.QuickCheck.Classes.Eq     Test.QuickCheck.Classes.Foldable     Test.QuickCheck.Classes.Functor     Test.QuickCheck.Classes.Integral     Test.QuickCheck.Classes.Json     Test.QuickCheck.Classes.Monad+    Test.QuickCheck.Classes.MonadFail     Test.QuickCheck.Classes.MonadPlus     Test.QuickCheck.Classes.MonadZip     Test.QuickCheck.Classes.Monoid@@ -98,8 +103,10 @@       base     , quickcheck-classes     , QuickCheck+    , containers      , primitive     , vector+    , semigroupoids      , transformers     , tagged   if flag(aeson)
src/Test/QuickCheck/Classes.hs view
@@ -27,6 +27,8 @@ #endif   , monoidLaws   , ordLaws+  , enumLaws+  , boundedEnumLaws   , primLaws   , semigroupLaws   , showReadLaws@@ -36,6 +38,7 @@   , alternativeLaws #if defined(VERSION_semigroupoids)   , altLaws+  , applyLaws #endif   , applicativeLaws #if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)@@ -60,6 +63,7 @@  -- Ground Types import Test.QuickCheck.Classes.Bits+import Test.QuickCheck.Classes.Enum import Test.QuickCheck.Classes.Eq import Test.QuickCheck.Classes.Integral #if MIN_VERSION_base(4,7,0)@@ -82,6 +86,7 @@ import Test.QuickCheck.Classes.Alternative #if defined(VERSION_semigroupoids) import Test.QuickCheck.Classes.Alt+import Test.QuickCheck.Classes.Apply #endif import Test.QuickCheck.Classes.Applicative #if MIN_VERSION_transformers(0,5,0)
+ src/Test/QuickCheck/Classes/Apply.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}++{-# OPTIONS_GHC -Wall #-}++module Test.QuickCheck.Classes.Apply+  (+#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if defined(VERSION_semigroupoids)+    applyLaws+#endif+#endif+) where++import Data.Functor++#if defined(VERSION_semigroupoids)+import qualified Data.Functor.Apply as FunctorApply+#endif++import Test.QuickCheck hiding ((.&.))+#if MIN_VERSION_QuickCheck(2,10,0)+import Test.QuickCheck.Arbitrary (Arbitrary1(..))+#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+import Data.Functor.Classes+#endif+#endif+import Test.QuickCheck.Property (Property)++import Test.QuickCheck.Classes.Common++#if MIN_VERSION_QuickCheck(2,10,0)++#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)++-- | Tests the following alt properties:+--+-- [/LiftF2 (1)/]+--   @('FunctorApply.<.>') ≡ 'liftF2' 'id'@+#if defined(VERSION_semigroupoids)+applyLaws :: (FunctorApply.Apply f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Laws+applyLaws p = Laws "Apply"+  [ ("LiftF2 part 1", applyLiftF2_1 p)+  ]++applyLiftF2_1 :: forall proxy f. (FunctorApply.Apply f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Property+applyLiftF2_1 _ = property $ \(Apply (f' :: f QuadraticEquation)) (Apply (x :: f Integer)) ->+  let f = fmap runQuadraticEquation f'+  in eq1 (FunctorApply.liftF2 id f x) (f FunctorApply.<.> x)+#endif+#endif+#endif+
+ src/Test/QuickCheck/Classes/Category.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}++{-# OPTIONS_GHC -Wall #-}++module Test.QuickCheck.Classes.Category+  (+#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)+    categoryLaws+  , commutativeCategoryLaws+#endif  +  ) where++import Prelude hiding (id, (.))+import Control.Category (Category(..))+import Test.QuickCheck hiding ((.&.))+#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+import Data.Functor.Classes+#endif+import Test.QuickCheck.Property (Property)++import Test.QuickCheck.Classes.Common++#if MIN_VERSION_QuickCheck(2,10,0)++#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)++-- | Tests the following 'Category' properties:+--+-- [/Right Identity/]+--   @f '.' 'id' ≡ f+-- [/Left Identity/]+--   @'id' '.' f ≡ f@+-- [/Associativity/]+--   @f '.' (g '.' h) ≡ (f '.' g) '.' h@+--+-- /Note/: This property test is only available when this package is built with+-- @base-4.9+@ or @transformers-0.5+@.+categoryLaws :: (Category cat, Eq2 cat, Show2 cat, Arbitrary2 cat) => proxy cat -> Laws+categoryLaws p = Laws "Category"+  [ ("Right Identity", categoryRightIdentity p)+  , ("Left Identity", categoryLeftIdentity p)+  , ("Second Identity", categoryAssociativity p)+  ]++-- | Test everything from 'categoryLaws' plus the following:+--+-- [/Commutative/]+--   @f '.' g ≡ g '.' f@+--+-- /Note/: This property test is only available when this package is built with+-- @base-4.9+@ or @transformers-0.5+@.+commutativeCategoryLaws :: (Category cat, Eq2 cat, Show2 cat, Arbitrary2 cat) => proxy cat -> Laws+commutativeCategoryLaws p = Laws "Commutative Category" $ lawsProperties (categoryLaws p) +++  [ ("Commutative", categoryCommutativity p)+  ]++categoryRightIdentity :: forall proxy cat. (Category cat, Eq2 cat, Show2 cat, Arbitrary2 cat) => proxy cat -> Property+categoryRightIdentity _ = property $ \(Apply2 (x :: cat Integer Integer)) -> eq2 (x . id) x++categoryLeftIdentity :: forall proxy cat. (Category cat, Eq2 cat, Show2 cat, Arbitrary2 cat) => proxy cat -> Property+categoryLeftIdentity _ = property $ \(Apply2 (x :: cat Integer Integer)) -> eq2 (id . x) x++categoryAssociativity :: forall proxy cat. (Category cat, Eq2 cat, Show2 cat, Arbitrary2 cat) => proxy cat -> Property+categoryAssociativity _ = property $ \(Apply2 (f :: cat Integer Integer)) (Apply2 (g :: cat Integer Integer)) (Apply2 (h :: cat Integer Integer)) -> eq2 (f . (g . h)) ((f . g) . h)++categoryCommutativity :: forall proxy cat. (Category cat, Eq2 cat, Show2 cat, Arbitrary2 cat) => proxy cat -> Property+categoryCommutativity _ = property $ \(Apply2 (f :: cat Integer Integer)) (Apply2 (g :: cat Integer Integer)) -> eq2 (f . g) (g . f)++#endif++#endif+
+ src/Test/QuickCheck/Classes/Enum.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE ScopedTypeVariables #-}++{-# OPTIONS_GHC -Wall #-}++module Test.QuickCheck.Classes.Enum+  ( enumLaws+  , boundedEnumLaws+  ) 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:+--+-- [/Succ Pred Identity/]+--   @succ (pred x) ≡ x@+-- [/Pred Succ Identity/]+--   @pred (succ x) ≡ x@+--+-- This only works for @Enum@ types that are not bounded, meaning+-- that 'succ' and 'pred' must be total. This means that these property+-- tests work correctly for types like 'Integer' but not for 'Int'.+--+-- Sadly, there is not a good way to test 'fromEnum' and 'toEnum',+-- since many types that have reasonable implementations for 'succ'+-- and 'pred' have more inhabitants than 'Int' does.+enumLaws :: (Enum a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws+enumLaws p = Laws "Enum"+  [ ("Succ Pred Identity", succPredIdentity p)+  , ("Pred Succ Identity", predSuccIdentity p)+  ]++-- | Tests the same properties as 'enumLaws' except that it requires+-- the type to have a 'Bounded' instance. These tests avoid taking the+-- successor of the maximum element or the predecessor of the minimal+-- element.+boundedEnumLaws :: (Enum a, Bounded a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws+boundedEnumLaws p = Laws "Enum"+  [ ("Succ Pred Identity", succPredBoundedIdentity p)+  , ("Pred Succ Identity", predSuccBoundedIdentity p)+  ]++succPredIdentity :: forall a. (Enum a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+succPredIdentity _ = myForAllShrink False (const True)+  (\(a :: a) -> ["a = " ++ show a])+  "succ (pred x)"+  (\a -> succ (pred a))+  "x"+  (\a -> a)++predSuccIdentity :: forall a. (Enum a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+predSuccIdentity _ = myForAllShrink False (const True)+  (\(a :: a) -> ["a = " ++ show a])+  "pred (succ x)"+  (\a -> pred (succ a))+  "x"+  (\a -> a)++succPredBoundedIdentity :: forall a. (Enum a, Bounded a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+succPredBoundedIdentity _ = myForAllShrink False (\a -> a /= minBound)+  (\(a :: a) -> ["a = " ++ show a])+  "succ (pred x)"+  (\a -> succ (pred a))+  "x"+  (\a -> a)++predSuccBoundedIdentity :: forall a. (Enum a, Bounded a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+predSuccBoundedIdentity _ = myForAllShrink False (\a -> a /= maxBound)+  (\(a :: a) -> ["a = " ++ show a])+  "pred (succ x)"+  (\a -> pred (succ a))+  "x"+  (\a -> a)+
+ src/Test/QuickCheck/Classes/MonadFail.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}++{-# OPTIONS_GHC -Wall #-}++module Test.QuickCheck.Classes.MonadFail+  (+#if MIN_VERSION_base(4,9,0) && MIN_VERSION_transformers(0,4,0)+    monadFailLaws+#endif  +  ) where++import Control.Applicative+import Test.QuickCheck hiding ((.&.))+#if MIN_VERSION_QuickCheck(2,10,0)+import Control.Monad (ap)+import Test.QuickCheck.Arbitrary (Arbitrary1(..))+#if MIN_VERSION_base(4,9,0) && MIN_VERSION_transformers(0,4,0)+import Data.Functor.Classes+import Prelude hiding (fail)+import Control.Monad.Fail (MonadFail(..))+#endif+#endif+import Test.QuickCheck.Property (Property)++import Test.QuickCheck.Classes.Common++#if MIN_VERSION_QuickCheck(2,10,0)++#if MIN_VERSION_base(4,9,0) && MIN_VERSION_transformers(0,4,0)++-- | Tests the following 'MonadFail' properties:+-- +-- [/Left Zero/]+-- @'fail' s '>>=' f ≡ 'fail' s@+monadFailLaws :: (MonadFail f, Applicative f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Laws+monadFailLaws p = Laws "Monad"+  [ ("Left Zero", monadFailLeftZero p)+  ]+ +monadFailLeftZero :: forall proxy f. (MonadFail f, Functor f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Property+monadFailLeftZero _ = property $ \(k' :: LinearEquationM f) (s :: String) ->+  let k = runLinearEquationM k'+  in eq1 (fail s >>= k) (fail s)++#endif++#endif+
src/Test/QuickCheck/Classes/Storable.hs view
@@ -26,6 +26,12 @@  import Test.QuickCheck.Classes.Common (Laws(..)) +-- | Tests the following alternative properties:+--+-- [/Set-Get/]+--   @'runST' ('pokeElemOff' ptr ix a >> 'peekElemOff' ptr ix') ≡  a@+-- [/Get-Set/]+--   @'runST' ('peekElemOff' ptr ix >> 'pokeElemOff' ptr ix a) ≡ a@ 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)
test/Spec.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveFunctor #-}  import Control.Monad import Control.Monad.Zip (MonadZip)@@ -12,8 +13,19 @@ #endif import Data.Bits import Data.Foldable+#if defined(VERSION_containers)+import Data.Map (Map)+#endif+#if MIN_VERSION_containers(0,5,9)+import qualified Data.Map.Merge.Strict as MM+#endif import Data.Traversable #if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if defined(VERSION_semigroupoids)+import Data.Functor.Apply (Apply((<.>)))+#endif+#endif+#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0) import Data.Functor.Classes #endif import Data.Int@@ -24,6 +36,7 @@ import Data.Word import Foreign.Storable import Test.QuickCheck+import Text.Show.Functions  import qualified Data.Vector as V import qualified Data.Foldable as F@@ -31,7 +44,9 @@ import Test.QuickCheck.Classes  main :: IO ()-main = lawsCheckMany allPropsApplied+main = do+  quickCheck prop_map_apply_equals+  lawsCheckMany allPropsApplied  allPropsApplied :: [(String,[Laws])] allPropsApplied = @@ -44,6 +59,14 @@   , ("List",allHigherLaws (Proxy1 :: Proxy1 [])) #endif #endif+#if MIN_VERSION_QuickCheck(2,10,0)+#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if defined(VERSION_semigroupoids)+  , ("Map", someHigherLaws (Proxy1 :: Proxy1 (Map Int)))+  , ("Pound", someHigherLaws (Proxy1 :: Proxy1 (Pound Int)))+#endif+#endif+#endif #if MIN_VERSION_base(4,7,0)   , ("Vector",[isListLaws (Proxy :: Proxy (Vector Word))]) #endif@@ -57,6 +80,8 @@   , Arbitrary a   , Show a   , Read a+  , Enum a+  , Bounded a #if defined(VERSION_aeson)   , ToJSON a   , FromJSON a@@ -71,6 +96,7 @@   , semigroupLaws (Proxy :: Proxy (Sum a))   , monoidLaws (Proxy :: Proxy (Sum a))   , showReadLaws p+  , boundedEnumLaws p #if defined(VERSION_aeson)   , jsonLaws p #endif@@ -100,6 +126,17 @@ #endif #endif +#if MIN_VERSION_QuickCheck(2,10,0)+#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if defined(VERSION_semigroupoids)+someHigherLaws :: (Apply f, Eq1 f, Arbitrary1 f, Show1 f) => proxy f -> [Laws]+someHigherLaws p = +  [ applyLaws p+  ]+#endif+#endif+#endif+ -- This type fails the laws for the strict functions -- in Foldable. It is used just to confirm that -- those property tests actually work.@@ -118,6 +155,40 @@ #if MIN_VERSION_base(4,6,0)   foldl' f x (Rouge xs) = F.foldl f x xs   foldr' f x (Rouge xs) = F.foldr f x xs+#endif++newtype Pound k v = Pound { getPound :: Map k v }+#if MIN_VERSION_QuickCheck(2,10,0) && (MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0))+  deriving (Eq,Functor,Show,Arbitrary,Arbitrary1,Eq1,Show1)+#else+  deriving (Eq,Show,Arbitrary)+#endif++#if defined(VERSION_semigroupoids)+#if MIN_VERSION_containers(0,5,9)+instance Ord k => Apply (Pound k) where+  Pound m1 <.> Pound m2 = Pound $+    MM.merge+      MM.dropMissing+      MM.dropMissing+      (MM.zipWithMatched (\_ f a -> f a))+      m1+      m2+#endif+#endif++#if defined(VERSION_semigroupoids)+#if MIN_VERSION_containers(0,5,9)+prop_map_apply_equals :: Map Int (Int -> Int)+                      -> Map Int Int+                      -> Bool+prop_map_apply_equals mf ma =+  let pf = Pound mf+      pa = Pound ma+      m = mf <.> ma+      p = pf <.> pa+  in m == (getPound p)+#endif #endif  -------------------