quickcheck-monoid-subclasses 0.1.0.0 → 0.2.0.0
raw patch · 8 files changed
+728/−79 lines, 8 filesdep ~basedep ~semigroupoidsPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, semigroupoids
API changes (from Hackage documentation)
Files
- CHANGELOG.md +8/−0
- README.md +4/−3
- quickcheck-monoid-subclasses.cabal +3/−3
- src/internal/Internal/Semigroup/Tuple.hs +163/−63
- src/public/Test/QuickCheck/Classes/Monoid/GCD.hs +545/−2
- src/public/Test/QuickCheck/Classes/Monoid/LCM.hs +0/−3
- src/public/Test/QuickCheck/Classes/Monoid/Null.hs +2/−2
- src/public/Test/QuickCheck/Classes/Semigroup/Cancellative.hs +3/−3
CHANGELOG.md view
@@ -1,3 +1,11 @@+# 0.2.0.0++- Improved generation of arbitrary `Semigroup` value combinations.+- Added derived laws for the `LeftGCDMonoid` type class.+- Added derived laws for the `RightGCDMonoid` type class.+- Removed hard-to-satisfy coverage check from `LCMMonoid` type class laws.+- Added support for building with GHC `9.6` series.+ # 0.1.0.0 - Added laws for the `LCMMonoid` type class.
README.md view
@@ -59,12 +59,13 @@ > import Test.QuickCheck.Classes.Monoid.Monus > import Test.QuickCheck.Classes.Monoid.Null > import Test.QuickCheck.Classes.Semigroup.Cancellative-> +> > lawsCheckOne (Proxy :: Proxy (Sum Natural)) > [ cancellativeGCDMonoidLaws > , cancellativeLaws > , commutativeLaws > , gcdMonoidLaws+> , lcmMonoidLaws > , leftCancellativeLaws > , leftGCDMonoidLaws > , leftReductiveLaws@@ -98,9 +99,9 @@ > ```hs > isPrefixOf a b == isJust (stripPrefix a b) > ```-> +> > This library will also test that the following __derived__ laws hold:-> +> > ```hs > isPrefixOf a (a <> a) == isJust (stripPrefix a (a <> a)) > isPrefixOf a (a <> b) == isJust (stripPrefix a (a <> b))
quickcheck-monoid-subclasses.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: quickcheck-monoid-subclasses-version: 0.1.0.0+version: 0.2.0.0 bug-reports: https://github.com/jonathanknowles/quickcheck-monoid-subclasses/issues license: Apache-2.0 license-file: LICENSE@@ -19,7 +19,7 @@ README.md common dependency-base- build-depends:base >= 4.14.3.0 && < 4.18+ build-depends:base >= 4.14.3.0 && < 4.19 common dependency-bytestring build-depends:bytestring >= 0.10.12.0 && < 0.12 common dependency-commutative-semigroups@@ -39,7 +39,7 @@ common dependency-quickcheck-instances build-depends:quickcheck-instances >= 0.3.28 && < 0.4 common dependency-semigroupoids- build-depends:semigroupoids >= 5.3.7 && < 5.4+ build-depends:semigroupoids >= 5.3.7 && < 6.1 common dependency-text build-depends:text >= 1.2.4.1 && < 2.1 common dependency-vector
src/internal/Internal/Semigroup/Tuple.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE NamedFieldPuns #-} {- HLINT ignore "Redundant bracket" -} -- |@@ -7,10 +9,24 @@ module Internal.Semigroup.Tuple where +import Data.Functor+ ( (<&>) ) import Data.List.NonEmpty ( NonEmpty (..) )+import GHC.Generics+ ( Generic ) import Test.QuickCheck- ( Arbitrary (..), Gen, choose, shuffle, suchThatMap )+ ( Arbitrary (..)+ , Gen+ , applyArbitrary2+ , applyArbitrary3+ , applyArbitrary4+ , choose+ , genericShrink+ , oneof+ , shuffle+ , suchThatMap+ ) import Text.Show.Pretty ( ppShow ) @@ -19,68 +35,111 @@ import qualified Data.Semigroup.Foldable as F1 ----------------------------------------------------------------------------------- Tuple selectors+-- Variables -------------------------------------------------------------------------------- -data TupleLens3- = TupleLens3A- | TupleLens3B- | TupleLens3C+data Variable = A | B | C | D deriving (Bounded, Enum, Eq, Ord, Show) -evalTupleLens3 :: (s, s, s) -> TupleLens3 -> s-evalTupleLens3 (a, b, c) = \case- TupleLens3A -> a- TupleLens3B -> b- TupleLens3C -> c+bindVariable :: BindingSet s -> Variable -> s+bindVariable BindingSet {bindingForA} A = bindingForA+bindVariable BindingSet {bindingForB} B = bindingForB+bindVariable BindingSet {bindingForC} C = bindingForC+bindVariable BindingSet {bindingForD} D = bindingForD ----------------------------------------------------------------------------------- Semigroup combinations+-- Variable sums -------------------------------------------------------------------------------- -newtype Combination3 = Combination3 (NonEmpty TupleLens3)- deriving (Eq, Ord, Show)+newtype VariableSum = VariableSum (NonEmpty Variable)+ deriving (Eq, Ord, Semigroup) -arbitraryCombination3 :: Gen Combination3-arbitraryCombination3 =- Combination3 <$> arbitraryTupleLensList `suchThatMap` NE.nonEmpty+instance Arbitrary VariableSum where+ arbitrary = genVariableSum++instance Show VariableSum where+ show (VariableSum vs) = F1.intercalate1 " <> " $ show <$> vs++a = VariableSum (A :| [])+b = VariableSum (B :| [])+c = VariableSum (C :| [])+d = VariableSum (D :| [])++genVariableSum :: Gen VariableSum+genVariableSum =+ VariableSum <$> genVariableList `suchThatMap` NE.nonEmpty where- arbitraryTupleLensList :: Gen [TupleLens3]- arbitraryTupleLensList = do- itemCount <- choose (1, 3)+ genVariableList :: Gen [Variable]+ genVariableList = do+ itemCount <- choose (1, 4) take itemCount <$> shuffle universe -evalCombination3 :: (s, s, s) -> Combination3 -> NonEmpty s-evalCombination3 tuple (Combination3 selectors) =- evalTupleLens3 tuple <$> selectors+bindVariableSum :: BindingSet s -> VariableSum -> NonEmpty s+bindVariableSum tuple (VariableSum selectors) =+ bindVariable tuple <$> selectors -showCombination3 :: Show s => (s, s, s) -> Combination3 -> String-showCombination3 tuple =- F1.intercalateMap1 " <> " show . evalCombination3 tuple+evalVariableSum :: Semigroup s => BindingSet s -> VariableSum -> s+evalVariableSum = (F1.fold1 .) . bindVariableSum +showVariableSum :: Show s => (BindingSet s) -> VariableSum -> String+showVariableSum tuple =+ F1.intercalateMap1 " <> " show . bindVariableSum tuple+ ----------------------------------------------------------------------------------- Semigroup tuples+-- Binding sets (for variables) -------------------------------------------------------------------------------- -data Tuple1 s = Tuple1 Combination3 (s, s, s)+data BindingSet s = BindingSet+ { bindingForA :: s+ , bindingForB :: s+ , bindingForC :: s+ , bindingForD :: s+ }+ deriving (Eq, Generic, Ord)++instance Show s => Show (BindingSet s) where+ show (BindingSet va vb vc vd) = mconcat+ [ "BindingSet {"+ , "a = " <> show va <> ", "+ , "b = " <> show vb <> ", "+ , "c = " <> show vc <> ", "+ , "d = " <> show vd+ , "}"+ ]++instance Arbitrary s => Arbitrary (BindingSet s) where+ arbitrary = genBindingSet+ shrink = shrinkBindingSet++genBindingSet :: Arbitrary s => Gen (BindingSet s)+genBindingSet = applyArbitrary4 BindingSet++shrinkBindingSet :: Arbitrary s => BindingSet s -> [BindingSet s]+shrinkBindingSet = genericShrink++--------------------------------------------------------------------------------+-- Tuples+--------------------------------------------------------------------------------++data Tuple1 s = Tuple1 VariableSum (BindingSet s) deriving (Eq, Ord) -data Tuple2 s = Tuple2 Combination3 Combination3 (s, s, s)+data Tuple2 s = Tuple2 VariableSum VariableSum (BindingSet s) deriving (Eq, Ord) -data Tuple3 s = Tuple3 Combination3 Combination3 Combination3 (s, s, s)+data Tuple3 s = Tuple3 VariableSum VariableSum VariableSum (BindingSet s) deriving (Eq, Ord) instance Arbitrary a => Arbitrary (Tuple1 a) where- arbitrary = arbitraryTuple1+ arbitrary = genTuple1 shrink = shrinkTuple1 instance Arbitrary a => Arbitrary (Tuple2 a) where- arbitrary = arbitraryTuple2+ arbitrary = genTuple2 shrink = shrinkTuple2 instance Arbitrary a => Arbitrary (Tuple3 a) where- arbitrary = arbitraryTuple3+ arbitrary = genTuple3 shrink = shrinkTuple3 instance (Show s, Semigroup s) => Show (Tuple1 s) where@@ -92,58 +151,99 @@ instance (Show s, Semigroup s) => Show (Tuple3 s) where show = showTuple3 -arbitraryTuple1 :: Arbitrary a => Gen (Tuple1 a)-arbitraryTuple1 = Tuple1- <$> arbitraryCombination3- <*> arbitrary+genTuple1 :: Arbitrary a => Gen (Tuple1 a)+genTuple1 = applyArbitrary2 Tuple1 -arbitraryTuple2 :: Arbitrary a => Gen (Tuple2 a)-arbitraryTuple2 = Tuple2- <$> arbitraryCombination3- <*> arbitraryCombination3- <*> arbitrary+genTuple2 :: forall a. Arbitrary a => Gen (Tuple2 a)+genTuple2 = oneof [genRandom, genHandChosen]+ where+ genRandom :: Gen (Tuple2 a)+ genRandom = applyArbitrary3 Tuple2 -arbitraryTuple3 :: Arbitrary a => Gen (Tuple3 a)-arbitraryTuple3 = Tuple3- <$> arbitraryCombination3- <*> arbitraryCombination3- <*> arbitraryCombination3- <*> arbitrary+ genHandChosen :: Gen (Tuple2 a)+ genHandChosen = oneof $ fmap (arbitrary <&>)+ [ -- All identical:+ Tuple2 a a+ , -- All different:+ Tuple2 a b+ -- Shared common prefix:+ , Tuple2 (a <> b) (a <> c)+ -- Shared common suffix:+ , Tuple2 (a <> c) (b <> c)+ -- Shared common overlap (left to right):+ , Tuple2 (a <> b) (b <> c)+ -- Shared common overlap (right to left):+ , Tuple2 (c <> b) (b <> a)+ -- Append to the RHS (from left to right):+ , Tuple2 (a) (a <> b)+ -- Append to the RHS (from right to left):+ , Tuple2 (a <> b) (a)+ -- Append to the LHS (from left to right):+ , Tuple2 (b) (a <> b)+ -- Append to the LHS (from right to left):+ , Tuple2 (a <> b) (b)+ ] +genTuple3 :: forall a. Arbitrary a => Gen (Tuple3 a)+genTuple3 = oneof [genRandom, genHandChosen]+ where+ genRandom :: Gen (Tuple3 a)+ genRandom = applyArbitrary4 Tuple3++ genHandChosen :: Gen (Tuple3 a)+ genHandChosen = oneof $ fmap (arbitrary <&>)+ [ -- All identical:+ Tuple3 a a a+ -- All different:+ , Tuple3 a b c+ -- Shared common prefix:+ , Tuple3 (a <> b) (a <> c) (a <> d)+ -- Shared common suffix:+ , Tuple3 (a <> d) (b <> d) (c <> d)+ -- Append to the RHS (from left to right):+ , Tuple3 (a) (a <> b) (a <> b <> c)+ -- Append to the RHS (from right to left):+ , Tuple3 (a <> b <> c) (a <> b) (a)+ -- Append to the LHS (from left to right):+ , Tuple3 (c) (b <> c) (a <> b <> c)+ -- Append to the LHS (from right to left):+ , Tuple3 (a <> b <> c) (b <> c) (c)+ ]+ evalTuple1 :: Semigroup s => Tuple1 s -> s evalTuple1 (Tuple1 c1 t) =- ( F1.fold1 $ evalCombination3 t c1+ ( evalVariableSum t c1 ) evalTuple2 :: Semigroup s => Tuple2 s -> (s, s) evalTuple2 (Tuple2 c1 c2 t) =- ( F1.fold1 $ evalCombination3 t c1- , F1.fold1 $ evalCombination3 t c2+ ( evalVariableSum t c1+ , evalVariableSum t c2 ) evalTuple3 :: Semigroup s => Tuple3 s -> (s, s, s) evalTuple3 (Tuple3 c1 c2 c3 t) =- ( F1.fold1 $ evalCombination3 t c1- , F1.fold1 $ evalCombination3 t c2- , F1.fold1 $ evalCombination3 t c3+ ( evalVariableSum t c1+ , evalVariableSum t c2+ , evalVariableSum t c3 ) showTuple1 :: (Semigroup a, Show a) => Tuple1 a -> String-showTuple1 (evalTuple1 -> a) = unlines- [ mempty, "a:", showWrap a+showTuple1 (evalTuple1 -> va) = unlines+ [ mempty, "a:", showWrap va ] showTuple2 :: (Semigroup a, Show a) => Tuple2 a -> String-showTuple2 (evalTuple2 -> (a, b)) = unlines- [ mempty, "a:", showWrap a- , mempty, "b:", showWrap b+showTuple2 (evalTuple2 -> (va, vb)) = unlines+ [ mempty, "a:", showWrap va+ , mempty, "b:", showWrap vb ] showTuple3 :: (Semigroup a, Show a) => Tuple3 a -> String-showTuple3 (evalTuple3 -> (a, b, c)) = unlines- [ mempty, "a:", showWrap a- , mempty, "b:", showWrap b- , mempty, "c:", showWrap c+showTuple3 (evalTuple3 -> (va, vb, vc)) = unlines+ [ mempty, "a:", showWrap va+ , mempty, "b:", showWrap vb+ , mempty, "c:", showWrap vc ] shrinkTuple1 :: Arbitrary a => Tuple1 a -> [Tuple1 a]
src/public/Test/QuickCheck/Classes/Monoid/GCD.hs view
@@ -1,5 +1,6 @@ {- HLINT ignore "Use camelCase" -} {- HLINT ignore "Redundant bracket" -}+{- HLINT ignore "Redundant ==" -} -- | -- Copyright: © 2022–2023 Jonathan Knowles@@ -23,7 +24,7 @@ import Data.Function ( (&) ) import Data.Maybe- ( isJust )+ ( isJust, isNothing ) import Data.Monoid.GCD ( GCDMonoid (..) , LeftGCDMonoid (..)@@ -190,7 +191,7 @@ -- 'gcd' (a '<>' c) (b '<>' c) '==' 'gcd' a b '<>' c -- @ ----- __/Equivalence/__+-- __/Equivalences/__ -- -- @ -- 'gcd' a b '==' 'commonPrefix' a b@@ -490,7 +491,65 @@ -- -- Includes the following laws: --+-- __/Reductivity/__+-- -- @+-- 'isJust' ('stripPrefix' ('commonPrefix' a b) a)+-- @+-- @+-- 'isJust' ('stripPrefix' ('commonPrefix' a b) b)+-- @+--+-- __/Uniqueness/__+--+-- @+-- 'all' 'isJust'+-- [ 'stripPrefix' c a+-- , 'stripPrefix' c b+-- , 'stripPrefix' ('commonPrefix' a b) c+-- ]+-- ==>+-- (c '==' 'commonPrefix' a b)+-- @+--+-- __/Idempotence/__+--+-- @+-- 'commonPrefix' a a '==' a+-- @+--+-- __/Identity/__+--+-- @+-- 'commonPrefix' 'mempty' a '==' 'mempty'+-- @+-- @+-- 'commonPrefix' a 'mempty' '==' 'mempty'+-- @+--+-- __/Commutativity/__+--+-- @+-- 'commonPrefix' a b == 'commonPrefix' b a+-- @+--+-- __/Associativity/__+--+-- @+-- 'commonPrefix' ('commonPrefix' a b) c+-- '=='+-- 'commonPrefix' a ('commonPrefix' b c)+-- @+--+-- __/Distributivity/__+--+-- @+-- 'commonPrefix' (a '<>' b) (a '<>' c) '==' a '<>' 'commonPrefix' b c+-- @+--+-- __/Equivalences/__+--+-- @ -- 'stripCommonPrefix' a b '&' \\(p, _, _) -> p '==' 'commonPrefix' a b -- @ --@@ -521,6 +580,33 @@ -> Laws leftGCDMonoidLaws _ = Laws "LeftGCDMonoid" [ makeLaw2 @a+ "leftGCDMonoidLaw_reductivity_left"+ (leftGCDMonoidLaw_reductivity_left)+ , makeLaw2 @a+ "leftGCDMonoidLaw_reductivity_right"+ (leftGCDMonoidLaw_reductivity_right)+ , makeLaw2 @a+ "leftGCDMonoidLaw_uniqueness"+ (leftGCDMonoidLaw_uniqueness)+ , makeLaw1 @a+ "leftGCDMonoidLaw_idempotence"+ (leftGCDMonoidLaw_idempotence)+ , makeLaw1 @a+ "leftGCDMonoidLaw_identity_left"+ (leftGCDMonoidLaw_identity_left)+ , makeLaw1 @a+ "leftGCDMonoidLaw_identity_right"+ (leftGCDMonoidLaw_identity_right)+ , makeLaw2 @a+ "leftGCDMonoidLaw_commutativity"+ (leftGCDMonoidLaw_commutativity)+ , makeLaw3 @a+ "leftGCDMonoidLaw_associativity"+ (leftGCDMonoidLaw_associativity)+ , makeLaw3 @a+ "leftGCDMonoidLaw_distributivity"+ (leftGCDMonoidLaw_distributivity)+ , makeLaw2 @a "leftGCDMonoidLaw_stripCommonPrefix_commonPrefix" (leftGCDMonoidLaw_stripCommonPrefix_commonPrefix) , makeLaw2 @a@@ -537,6 +623,192 @@ (leftGCDMonoidLaw_stripCommonPrefix_stripPrefix_2) ] +leftGCDMonoidLaw_reductivity_left+ :: (Eq a, Show a, LeftGCDMonoid a) => a -> a -> Property+leftGCDMonoidLaw_reductivity_left a b =+ makeProperty+ "isJust (stripPrefix (commonPrefix a b) a)"+ (isJust (stripPrefix (commonPrefix a b) a))+ & cover+ "commonPrefix a b /= mempty"+ (commonPrefix a b /= mempty)+ & cover+ "stripPrefix (commonPrefix a b) a /= mempty"+ (stripPrefix (commonPrefix a b) a /= mempty)+ & report+ "commonPrefix a b"+ (commonPrefix a b)+ & report+ "stripPrefix (commonPrefix a b) a"+ (stripPrefix (commonPrefix a b) a)++leftGCDMonoidLaw_reductivity_right+ :: (Eq a, Show a, LeftGCDMonoid a) => a -> a -> Property+leftGCDMonoidLaw_reductivity_right a b =+ makeProperty+ "isJust (stripPrefix (commonPrefix a b) b)"+ (isJust (stripPrefix (commonPrefix a b) b))+ & cover+ "commonPrefix a b /= mempty"+ (commonPrefix a b /= mempty)+ & cover+ "stripPrefix (commonPrefix a b) b /= mempty"+ (stripPrefix (commonPrefix a b) b /= mempty)+ & report+ "commonPrefix a b"+ (commonPrefix a b)+ & report+ "stripPrefix (commonPrefix a b) b"+ (stripPrefix (commonPrefix a b) b)++leftGCDMonoidLaw_uniqueness+ :: (Eq a, Show a, LeftGCDMonoid a) => a -> a -> a -> Property+leftGCDMonoidLaw_uniqueness a b c =+ makeProperty+ "antecedent ==> consequent"+ (antecedent ==> consequent)+ -- Note that in the expressions below, we use '==' to compare Boolean+ -- expressions, even in cases where it is redundant, in order to make+ -- test output more readable:+ & cover+ "antecedent == True"+ (antecedent == True)+ & cover+ "antecedent == False"+ (antecedent == False)+ & cover+ "consequent == True"+ (consequent == True)+ & cover+ "consequent == False"+ (consequent == False)+ & report+ "stripPrefix c a"+ (stripPrefix c a)+ & report+ "stripPrefix c b"+ (stripPrefix c b)+ & report+ "commonPrefix a b"+ (commonPrefix a b)+ & report+ "stripPrefix (commonPrefix a b) c"+ (stripPrefix (commonPrefix a b) c)+ where+ antecedent =+ all isJust+ [ stripPrefix c a+ , stripPrefix c b+ , stripPrefix (commonPrefix a b) c+ ]+ consequent =+ c == commonPrefix a b++leftGCDMonoidLaw_idempotence+ :: (Eq a, Show a, LeftGCDMonoid a) => a -> Property+leftGCDMonoidLaw_idempotence a =+ makeProperty+ "commonPrefix a a == a"+ (commonPrefix a a == a)+ & report+ "commonPrefix a a"+ (commonPrefix a a)++leftGCDMonoidLaw_identity_left+ :: (Eq a, Show a, LeftGCDMonoid a) => a -> Property+leftGCDMonoidLaw_identity_left a =+ makeProperty+ "commonPrefix mempty a == mempty"+ (commonPrefix mempty a == mempty)+ & cover+ "a /= mempty"+ (a /= mempty)+ & report+ "commonPrefix mempty a"+ (commonPrefix mempty a)++leftGCDMonoidLaw_identity_right+ :: (Eq a, Show a, LeftGCDMonoid a) => a -> Property+leftGCDMonoidLaw_identity_right a =+ makeProperty+ "commonPrefix a mempty == mempty"+ (commonPrefix a mempty == mempty)+ & cover+ "a /= mempty"+ (a /= mempty)+ & report+ "commonPrefix a mempty"+ (commonPrefix a mempty)++leftGCDMonoidLaw_commutativity+ :: (Eq a, Show a, LeftGCDMonoid a) => a -> a -> Property+leftGCDMonoidLaw_commutativity a b =+ makeProperty+ "commonPrefix a b == commonPrefix b a"+ (commonPrefix a b == commonPrefix b a)+ & cover+ "commonPrefix a b == mempty"+ (commonPrefix a b == mempty)+ & cover+ "commonPrefix a b /= mempty"+ (commonPrefix a b /= mempty)+ & report+ "commonPrefix a b"+ (commonPrefix a b)+ & report+ "commonPrefix b a"+ (commonPrefix b a)++leftGCDMonoidLaw_associativity+ :: (Eq a, Show a, LeftGCDMonoid a) => a -> a -> a -> Property+leftGCDMonoidLaw_associativity a b c =+ makeProperty+ "commonPrefix (commonPrefix a b) c == commonPrefix a (commonPrefix b c)"+ (commonPrefix (commonPrefix a b) c == commonPrefix a (commonPrefix b c))+ & cover+ "commonPrefix (commonPrefix a b) c /= mempty"+ (commonPrefix (commonPrefix a b) c /= mempty)+ & cover+ "commonPrefix a (commonPrefix b c) /= mempty"+ (commonPrefix a (commonPrefix b c) /= mempty)+ & report+ "commonPrefix a b"+ (commonPrefix a b)+ & report+ "commonPrefix (commonPrefix a b) c"+ (commonPrefix (commonPrefix a b) c)+ & report+ "commonPrefix b c"+ (commonPrefix b c)+ & report+ "commonPrefix a (commonPrefix b c)"+ (commonPrefix a (commonPrefix b c))++leftGCDMonoidLaw_distributivity+ :: (Eq a, Show a, LeftGCDMonoid a) => a -> a -> a -> Property+leftGCDMonoidLaw_distributivity a b c =+ makeProperty+ "commonPrefix (a <> b) (a <> c) == a <> commonPrefix b c"+ (commonPrefix (a <> b) (a <> c) == a <> commonPrefix b c)+ & cover+ "commonPrefix b c /= mempty && a /= mempty"+ (commonPrefix b c /= mempty && a /= mempty)+ & report+ "a <> b"+ (a <> b)+ & report+ "a <> c"+ (a <> c)+ & report+ "commonPrefix (a <> b) (a <> c)"+ (commonPrefix (a <> b) (a <> c))+ & report+ "commonPrefix b c"+ (commonPrefix b c)+ & report+ "a <> commonPrefix b c"+ (a <> commonPrefix b c)+ leftGCDMonoidLaw_stripCommonPrefix_commonPrefix :: (Eq a, Show a, LeftGCDMonoid a) => a -> a -> Property leftGCDMonoidLaw_stripCommonPrefix_commonPrefix a b =@@ -767,7 +1039,65 @@ -- -- Includes the following laws: --+-- __/Reductivity/__+-- -- @+-- 'isJust' ('stripSuffix' ('commonSuffix' a b) a)+-- @+-- @+-- 'isJust' ('stripSuffix' ('commonSuffix' a b) b)+-- @+--+-- __/Uniqueness/__+--+-- @+-- 'all' 'isJust'+-- [ 'stripSuffix' c a+-- , 'stripSuffix' c b+-- , 'stripSuffix' ('commonSuffix' a b) c+-- ]+-- ==>+-- (c '==' 'commonSuffix' a b)+-- @+--+-- __/Idempotence/__+--+-- @+-- 'commonSuffix' a a '==' a+-- @+--+-- __/Identity/__+--+-- @+-- 'commonSuffix' 'mempty' a '==' 'mempty'+-- @+-- @+-- 'commonSuffix' a 'mempty' '==' 'mempty'+-- @+--+-- __/Commutativity/__+--+-- @+-- 'commonSuffix' a b == 'commonSuffix' b a+-- @+--+-- __/Associativity/__+--+-- @+-- 'commonSuffix' ('commonSuffix' a b) c+-- '=='+-- 'commonSuffix' a ('commonSuffix' b c)+-- @+--+-- __/Distributivity/__+--+-- @+-- 'commonSuffix' (a '<>' c) (b '<>' c) '==' 'commonSuffix' a b '<>' c+-- @+--+-- __/Equivalences/__+--+-- @ -- 'stripCommonSuffix' a b '&' \\(_, _, s) -> s '==' 'commonSuffix' a b -- @ --@@ -798,6 +1128,33 @@ -> Laws rightGCDMonoidLaws _ = Laws "RightGCDMonoid" [ makeLaw2 @a+ "rightGCDMonoidLaw_reductivity_left"+ (rightGCDMonoidLaw_reductivity_left)+ , makeLaw2 @a+ "rightGCDMonoidLaw_reductivity_right"+ (rightGCDMonoidLaw_reductivity_right)+ , makeLaw2 @a+ "rightGCDMonoidLaw_uniqueness"+ (rightGCDMonoidLaw_uniqueness)+ , makeLaw1 @a+ "rightGCDMonoidLaw_idempotence"+ (rightGCDMonoidLaw_idempotence)+ , makeLaw1 @a+ "rightGCDMonoidLaw_identity_left"+ (rightGCDMonoidLaw_identity_left)+ , makeLaw1 @a+ "rightGCDMonoidLaw_identity_right"+ (rightGCDMonoidLaw_identity_right)+ , makeLaw2 @a+ "rightGCDMonoidLaw_commutativity"+ (rightGCDMonoidLaw_commutativity)+ , makeLaw3 @a+ "rightGCDMonoidLaw_associativity"+ (rightGCDMonoidLaw_associativity)+ , makeLaw3 @a+ "rightGCDMonoidLaw_distributivity"+ (rightGCDMonoidLaw_distributivity)+ , makeLaw2 @a "rightGCDMonoidLaw_stripCommonSuffix_commonSuffix" (rightGCDMonoidLaw_stripCommonSuffix_commonSuffix) , makeLaw2 @a@@ -813,6 +1170,192 @@ "rightGCDMonoidLaw_stripCommonSuffix_stripSuffix_2" (rightGCDMonoidLaw_stripCommonSuffix_stripSuffix_2) ]++rightGCDMonoidLaw_reductivity_left+ :: (Eq a, Show a, RightGCDMonoid a) => a -> a -> Property+rightGCDMonoidLaw_reductivity_left a b =+ makeProperty+ "isJust (stripSuffix (commonSuffix a b) a)"+ (isJust (stripSuffix (commonSuffix a b) a))+ & cover+ "commonSuffix a b /= mempty"+ (commonSuffix a b /= mempty)+ & cover+ "stripSuffix (commonSuffix a b) a /= mempty"+ (stripSuffix (commonSuffix a b) a /= mempty)+ & report+ "commonSuffix a b"+ (commonSuffix a b)+ & report+ "stripSuffix (commonSuffix a b) a"+ (stripSuffix (commonSuffix a b) a)++rightGCDMonoidLaw_reductivity_right+ :: (Eq a, Show a, RightGCDMonoid a) => a -> a -> Property+rightGCDMonoidLaw_reductivity_right a b =+ makeProperty+ "isJust (stripSuffix (commonSuffix a b) b)"+ (isJust (stripSuffix (commonSuffix a b) b))+ & cover+ "commonSuffix a b /= mempty"+ (commonSuffix a b /= mempty)+ & cover+ "stripSuffix (commonSuffix a b) b /= mempty"+ (stripSuffix (commonSuffix a b) b /= mempty)+ & report+ "commonSuffix a b"+ (commonSuffix a b)+ & report+ "stripSuffix (commonSuffix a b) b"+ (stripSuffix (commonSuffix a b) b)++rightGCDMonoidLaw_uniqueness+ :: (Eq a, Show a, RightGCDMonoid a) => a -> a -> a -> Property+rightGCDMonoidLaw_uniqueness a b c =+ makeProperty+ "antecedent ==> consequent"+ (antecedent ==> consequent)+ -- Note that in the expressions below, we use '==' to compare Boolean+ -- expressions, even in cases where it is redundant, in order to make+ -- test output more readable:+ & cover+ "antecedent == True"+ (antecedent == True)+ & cover+ "antecedent == False"+ (antecedent == False)+ & cover+ "consequent == True"+ (consequent == True)+ & cover+ "consequent == False"+ (consequent == False)+ & report+ "stripSuffix c a"+ (stripSuffix c a)+ & report+ "stripSuffix c b"+ (stripSuffix c b)+ & report+ "commonSuffix a b"+ (commonSuffix a b)+ & report+ "stripSuffix (commonSuffix a b) c"+ (stripSuffix (commonSuffix a b) c)+ where+ antecedent =+ all isJust+ [ stripSuffix c a+ , stripSuffix c b+ , stripSuffix (commonSuffix a b) c+ ]+ consequent =+ c == commonSuffix a b++rightGCDMonoidLaw_idempotence+ :: (Eq a, Show a, RightGCDMonoid a) => a -> Property+rightGCDMonoidLaw_idempotence a =+ makeProperty+ "commonSuffix a a == a"+ (commonSuffix a a == a)+ & report+ "commonSuffix a a"+ (commonSuffix a a)++rightGCDMonoidLaw_identity_left+ :: (Eq a, Show a, RightGCDMonoid a) => a -> Property+rightGCDMonoidLaw_identity_left a =+ makeProperty+ "commonSuffix mempty a == mempty"+ (commonSuffix mempty a == mempty)+ & cover+ "a /= mempty"+ (a /= mempty)+ & report+ "commonSuffix mempty a"+ (commonSuffix mempty a)++rightGCDMonoidLaw_identity_right+ :: (Eq a, Show a, RightGCDMonoid a) => a -> Property+rightGCDMonoidLaw_identity_right a =+ makeProperty+ "commonSuffix a mempty == mempty"+ (commonSuffix a mempty == mempty)+ & cover+ "a /= mempty"+ (a /= mempty)+ & report+ "commonSuffix a mempty"+ (commonSuffix a mempty)++rightGCDMonoidLaw_commutativity+ :: (Eq a, Show a, RightGCDMonoid a) => a -> a -> Property+rightGCDMonoidLaw_commutativity a b =+ makeProperty+ "commonSuffix a b == commonSuffix b a"+ (commonSuffix a b == commonSuffix b a)+ & cover+ "commonSuffix a b == mempty"+ (commonSuffix a b == mempty)+ & cover+ "commonSuffix a b /= mempty"+ (commonSuffix a b /= mempty)+ & report+ "commonSuffix a b"+ (commonSuffix a b)+ & report+ "commonSuffix b a"+ (commonSuffix b a)++rightGCDMonoidLaw_associativity+ :: (Eq a, Show a, RightGCDMonoid a) => a -> a -> a -> Property+rightGCDMonoidLaw_associativity a b c =+ makeProperty+ "commonSuffix (commonSuffix a b) c == commonSuffix a (commonSuffix b c)"+ (commonSuffix (commonSuffix a b) c == commonSuffix a (commonSuffix b c))+ & cover+ "commonSuffix (commonSuffix a b) c /= mempty"+ (commonSuffix (commonSuffix a b) c /= mempty)+ & cover+ "commonSuffix a (commonSuffix b c) /= mempty"+ (commonSuffix a (commonSuffix b c) /= mempty)+ & report+ "commonSuffix a b"+ (commonSuffix a b)+ & report+ "commonSuffix (commonSuffix a b) c"+ (commonSuffix (commonSuffix a b) c)+ & report+ "commonSuffix b c"+ (commonSuffix b c)+ & report+ "commonSuffix a (commonSuffix b c)"+ (commonSuffix a (commonSuffix b c))++rightGCDMonoidLaw_distributivity+ :: (Eq a, Show a, RightGCDMonoid a) => a -> a -> a -> Property+rightGCDMonoidLaw_distributivity a b c =+ makeProperty+ "commonSuffix (a <> c) (b <> c) == commonSuffix a b <> c"+ (commonSuffix (a <> c) (b <> c) == commonSuffix a b <> c)+ & cover+ "commonSuffix a b /= mempty && c /= mempty"+ (commonSuffix a b /= mempty && c /= mempty)+ & report+ "a <> c"+ (a <> c)+ & report+ "b <> c"+ (b <> c)+ & report+ "commonSuffix (a <> c) (b <> c)"+ (commonSuffix (a <> c) (b <> c))+ & report+ "commonSuffix a b"+ (commonSuffix a b)+ & report+ "commonSuffix a b <> c"+ (commonSuffix a b <> c) rightGCDMonoidLaw_stripCommonSuffix_commonSuffix :: (Eq a, Show a, RightGCDMonoid a) => a -> a -> Property
src/public/Test/QuickCheck/Classes/Monoid/LCM.hs view
@@ -287,9 +287,6 @@ "lcm a b == lcm b a" (lcm a b == lcm b a) & cover- "lcm a b == mempty"- (lcm a b == mempty)- & cover "lcm a b /= mempty" (lcm a b /= mempty) & report
src/public/Test/QuickCheck/Classes/Monoid/Null.hs view
@@ -40,7 +40,7 @@ -- | 'Laws' for instances of 'MonoidNull'. ----- Tests the following law:+-- Includes the following law: -- -- @ -- 'null' a '==' (a '==' 'mempty')@@ -85,7 +85,7 @@ -- | 'Laws' for instances of 'PositiveMonoid'. ----- Tests the following law:+-- Includes the following law: -- -- @ -- 'null' (a '<>' b) '==' ('null' a '&&' 'null' b)
src/public/Test/QuickCheck/Classes/Semigroup/Cancellative.hs view
@@ -115,7 +115,7 @@ -- | 'Laws' for instances of 'Commutative'. ----- Tests the following law:+-- Includes the following law: -- -- @ -- a '<>' b '==' b '<>' a@@ -157,7 +157,7 @@ -- | 'Laws' for instances of 'LeftCancellative'. ----- Tests the following law:+-- Includes the following law: -- -- @ -- 'stripPrefix' a (a '<>' b) '==' 'Just' b@@ -373,7 +373,7 @@ -- | 'Laws' for instances of 'RightCancellative'. ----- Tests the following law:+-- Includes the following law: -- -- @ -- 'stripSuffix' b (a '<>' b) '==' 'Just' a