{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} #if HAVE_QUANTIFIED_CONSTRAINTS {-# LANGUAGE QuantifiedConstraints #-} #endif {-# OPTIONS_GHC -Wall #-} module Test.QuickCheck.Classes.Category ( #if HAVE_BINARY_LAWS categoryLaws , commutativeCategoryLaws #endif ) where import Prelude hiding (id, (.)) import Control.Category (Category(..)) import Test.QuickCheck hiding ((.&.)) #if HAVE_BINARY_LAWS import Data.Functor.Classes (Eq2,Show2) #endif import Test.QuickCheck.Property (Property) import Test.QuickCheck.Classes.Internal #if HAVE_BINARY_LAWS -- | 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 :: forall proxy c. #if HAVE_QUANTIFIED_CONSTRAINTS (Category c, forall a b. (Eq a, Eq b) => Eq (c a b), forall a b. (Show a, Show b) => Show (c a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (c a b)) #else (Category c, Eq2 c, Show2 c, Arbitrary2 c) #endif => proxy c -> Laws categoryLaws p = Laws "Category" [ ("Right Identity", categoryRightIdentity p) , ("Left Identity", categoryLeftIdentity p) , ("Associativity", 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 :: forall proxy c. #if HAVE_QUANTIFIED_CONSTRAINTS (Category c, forall a b. (Eq a, Eq b) => Eq (c a b), forall a b. (Show a, Show b) => Show (c a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (c a b)) #else (Category c, Eq2 c, Show2 c, Arbitrary2 c) #endif => proxy c -> Laws commutativeCategoryLaws p = Laws "Commutative Category" $ lawsProperties (categoryLaws p) ++ [ ("Commutative", categoryCommutativity p) ] categoryRightIdentity :: forall proxy c. #if HAVE_QUANTIFIED_CONSTRAINTS (Category c, forall a b. (Eq a, Eq b) => Eq (c a b), forall a b. (Show a, Show b) => Show (c a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (c a b)) #else (Category c, Eq2 c, Show2 c, Arbitrary2 c) #endif => proxy c -> Property categoryRightIdentity _ = property $ \(Apply2 (x :: c Integer Integer)) -> eq2 (x . id) x categoryLeftIdentity :: forall proxy c. #if HAVE_QUANTIFIED_CONSTRAINTS (Category c, forall a b. (Eq a, Eq b) => Eq (c a b), forall a b. (Show a, Show b) => Show (c a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (c a b)) #else (Category c, Eq2 c, Show2 c, Arbitrary2 c) #endif => proxy c -> Property categoryLeftIdentity _ = property $ \(Apply2 (x :: c Integer Integer)) -> eq2 (id . x) x categoryAssociativity :: forall proxy c. #if HAVE_QUANTIFIED_CONSTRAINTS (Category c, forall a b. (Eq a, Eq b) => Eq (c a b), forall a b. (Show a, Show b) => Show (c a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (c a b)) #else (Category c, Eq2 c, Show2 c, Arbitrary2 c) #endif => proxy c -> Property categoryAssociativity _ = property $ \(Apply2 (f :: c Integer Integer)) (Apply2 (g :: c Integer Integer)) (Apply2 (h :: c Integer Integer)) -> eq2 (f . (g . h)) ((f . g) . h) categoryCommutativity :: forall proxy c. #if HAVE_QUANTIFIED_CONSTRAINTS (Category c, forall a b. (Eq a, Eq b) => Eq (c a b), forall a b. (Show a, Show b) => Show (c a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (c a b)) #else (Category c, Eq2 c, Show2 c, Arbitrary2 c) #endif => proxy c -> Property categoryCommutativity _ = property $ \(Apply2 (f :: c Integer Integer)) (Apply2 (g :: c Integer Integer)) -> eq2 (f . g) (g . f) #endif