monoid-subclasses 1.2.5.1 → 1.2.6
raw patch · 12 files changed
+264/−86 lines, 12 filesdep ~containers
Dependency ranges changed: containers
Files
- CHANGELOG.md +13/−0
- Test/TestMonoidSubclasses.hs +107/−36
- monoid-subclasses.cabal +17/−4
- src/Data/Monoid/Factorial.hs +12/−4
- src/Data/Monoid/GCD.hs +24/−2
- src/Data/Monoid/Instances/PrefixMemory.hs +4/−0
- src/Data/Monoid/Instances/Stateful.hs +2/−2
- src/Data/Monoid/LCM.hs +10/−0
- src/Data/Monoid/Monus.hs +39/−4
- src/Data/Monoid/Null.hs +4/−4
- src/Data/Semigroup/Cancellative.hs +18/−26
- src/Data/Semigroup/Factorial.hs +14/−4
CHANGELOG.md view
@@ -1,3 +1,16 @@+Version 1.2.6+---------------++* Improved the performance of `instance FactorialMonoid PrefixMemory`+* Bumped the `containers` dependency upper bound+* Thanks to Jonathan Knowles:+ * Documented and added tests for `Monus` laws+ * Added the missing class instances and tests for `Identity` and `Const`+ * Using `GeneralizedNewtypeDeriving` to simplify existing instances+ * Fixed compilation on older versions of GHC+ * Updated and improved the CI+ * Removed trailing whitespace+ Version 1.2.5.1 ---------------
Test/TestMonoidSubclasses.hs view
@@ -1,4 +1,4 @@-{- +{- Copyright 2013-2019 Mario Blazevic License: BSD3 (see BSD3-LICENSE.txt file)@@ -70,7 +70,7 @@ import Data.Semigroup (Semigroup, (<>), Max, Min) import Data.Monoid (Monoid, mempty, mconcat, All(All), Any(Any), Dual(Dual), First(First), Last(Last), Sum(Sum), Product(Product))-import Data.Semigroup.Factorial (Factorial, StableFactorial, +import Data.Semigroup.Factorial (Factorial, StableFactorial, factors, primePrefix, primeSuffix, foldl, foldl', foldr, length, reverse) import Data.Semigroup.Cancellative (Commutative, Reductive, LeftReductive, RightReductive,@@ -231,6 +231,8 @@ factorialInstances = map upcast stableFactorialInstances ++ [FactorialMonoidInstance (mempty :: Sum Integer), FactorialMonoidInstance (mempty :: Product Int32),+ FactorialMonoidInstance (mempty :: Identity String),+ FactorialMonoidInstance (mempty :: Const String Int), FactorialMonoidInstance (mempty :: Maybe String), FactorialMonoidInstance (mempty :: (Text, String)), FactorialMonoidInstance (mempty :: (Product Int32, ByteString, Sum Integer)),@@ -247,7 +249,7 @@ where upcast (StableFactorialMonoidInstance i) = FactorialMonoidInstance i stableFactorialInstances :: [StableFactorialMonoidInstance]-stableFactorialInstances = stable1 ++ map measure stable1 ++ map prefixed stable1 ++ map position stable1 +stableFactorialInstances = stable1 ++ map measure stable1 ++ map prefixed stable1 ++ map position stable1 where stable1 = map upcast stableTextualInstances ++ [StableFactorialMonoidInstance (mempty :: ByteString), StableFactorialMonoidInstance (mempty :: Lazy.ByteString),@@ -257,7 +259,7 @@ upcast (StableTextualMonoidInstance i) = StableFactorialMonoidInstance i measure (StableFactorialMonoidInstance i) = StableFactorialMonoidInstance (Measured.measure i) prefixed (StableFactorialMonoidInstance i) = StableFactorialMonoidInstance (PrefixMemory.shadowed i)- position (StableFactorialMonoidInstance (i :: a)) = + position (StableFactorialMonoidInstance (i :: a)) = StableFactorialMonoidInstance (pure i :: OffsetPositioned a) textualInstances :: [TextualMonoidInstance]@@ -282,7 +284,7 @@ StableTextualMonoidInstance (mempty :: Vector Char)] measure (StableTextualMonoidInstance i) = StableTextualMonoidInstance (Measured.measure i) prefixed (StableTextualMonoidInstance i) = StableTextualMonoidInstance (PrefixMemory.shadowed i)- position (StableTextualMonoidInstance (i :: a)) = + position (StableTextualMonoidInstance (i :: a)) = [StableTextualMonoidInstance (pure i :: OffsetPositioned a), StableTextualMonoidInstance (pure i :: LinePositioned a)] @@ -338,6 +340,8 @@ overlappingGCDMonoidInstances = map upcast monusInstances ++ [OverlappingGCDMonoidInstance (mempty :: String),+ OverlappingGCDMonoidInstance (mempty :: Identity String),+ OverlappingGCDMonoidInstance (mempty :: Const String Int), OverlappingGCDMonoidInstance (mempty :: Seq Int), OverlappingGCDMonoidInstance (mempty :: ByteString), OverlappingGCDMonoidInstance (mempty :: Lazy.ByteString),@@ -350,12 +354,19 @@ monusInstances = [MonusInstance (mempty :: Product Natural), MonusInstance (mempty :: Sum Natural),+ MonusInstance (mempty :: Identity (Sum Natural)),+ MonusInstance (mempty :: Const (Sum Natural) Int), MonusInstance (mempty :: Dual (Product Natural)), MonusInstance (mempty :: Maybe ()), MonusInstance (mempty :: Maybe (Product Natural)), MonusInstance (mempty :: Maybe (Sum Natural)), MonusInstance (mempty :: IntSet),- MonusInstance (mempty :: Set String)]+ MonusInstance (mempty :: Set String),+ MonusInstance (mempty :: ()),+ MonusInstance (mempty :: (Sum Natural)),+ MonusInstance (mempty :: (Sum Natural, Sum Natural)),+ MonusInstance (mempty :: (Sum Natural, Sum Natural, Sum Natural)),+ MonusInstance (mempty :: (Sum Natural, Sum Natural, Sum Natural, Sum Natural))] leftCancellativeInstances = map upcast cancellativeInstances ++ [LeftCancellativeMonoidInstance (mempty :: String),@@ -388,6 +399,8 @@ LeftGCDMonoidInstance (mempty :: Lazy.ByteString), LeftGCDMonoidInstance (mempty :: Text), LeftGCDMonoidInstance (mempty :: Lazy.Text),+ LeftGCDMonoidInstance (mempty :: Identity ByteString),+ LeftGCDMonoidInstance (mempty :: Const ByteString Int), LeftGCDMonoidInstance (mempty :: Dual ByteString), LeftGCDMonoidInstance (mempty :: (Text, String)), LeftGCDMonoidInstance (mempty :: (ByteString, Text, String)),@@ -410,6 +423,8 @@ RightGCDMonoidInstance (mempty :: Text), RightGCDMonoidInstance (mempty :: Lazy.Text), RightGCDMonoidInstance (mempty :: String),+ RightGCDMonoidInstance (mempty :: Identity ByteString),+ RightGCDMonoidInstance (mempty :: Const ByteString Int), RightGCDMonoidInstance (mempty :: Dual String), RightGCDMonoidInstance (mempty :: (Seq Int, ByteString)), RightGCDMonoidInstance (mempty :: Seq Int),@@ -422,6 +437,8 @@ gcdInstances = [ GCDMonoidInstance (mempty :: ()) , GCDMonoidInstance (mempty :: Product Natural)+ , GCDMonoidInstance (mempty :: Identity (Sum Natural))+ , GCDMonoidInstance (mempty :: Const (Sum Natural) Int) , GCDMonoidInstance (mempty :: Dual (Product Natural)) , GCDMonoidInstance (mempty :: IntSet) , GCDMonoidInstance (mempty :: Set String)@@ -436,6 +453,8 @@ , DistributiveGCDMonoidInstance (mempty :: Set ()) , DistributiveGCDMonoidInstance (mempty :: Set Bool) , DistributiveGCDMonoidInstance (mempty :: Set Word)+ , DistributiveGCDMonoidInstance (mempty :: Identity (Sum Natural))+ , DistributiveGCDMonoidInstance (mempty :: Const (Sum Natural) Int) , DistributiveGCDMonoidInstance (mempty :: Dual (Set ())) , DistributiveGCDMonoidInstance (mempty :: Dual (Set Bool)) , DistributiveGCDMonoidInstance (mempty :: Dual (Set Word))@@ -466,6 +485,12 @@ , LeftDistributiveGCDMonoidInstance (mempty :: Set Bool) , LeftDistributiveGCDMonoidInstance (mempty :: Set Word) -- Instances for monoid transformers:+ , LeftDistributiveGCDMonoidInstance (mempty :: Identity [()])+ , LeftDistributiveGCDMonoidInstance (mempty :: Identity [Bool])+ , LeftDistributiveGCDMonoidInstance (mempty :: Identity [Word])+ , LeftDistributiveGCDMonoidInstance (mempty :: Const [()] Int)+ , LeftDistributiveGCDMonoidInstance (mempty :: Const [Bool] Int)+ , LeftDistributiveGCDMonoidInstance (mempty :: Const [Word] Int) , LeftDistributiveGCDMonoidInstance (mempty :: Dual [()]) , LeftDistributiveGCDMonoidInstance (mempty :: Dual [Bool]) , LeftDistributiveGCDMonoidInstance (mempty :: Dual [Word])@@ -496,6 +521,12 @@ , RightDistributiveGCDMonoidInstance (mempty :: Set Bool) , RightDistributiveGCDMonoidInstance (mempty :: Set Word) -- Instances for monoid transformers:+ , RightDistributiveGCDMonoidInstance (mempty :: Identity [()])+ , RightDistributiveGCDMonoidInstance (mempty :: Identity [Bool])+ , RightDistributiveGCDMonoidInstance (mempty :: Identity [Word])+ , RightDistributiveGCDMonoidInstance (mempty :: Const [()] Int)+ , RightDistributiveGCDMonoidInstance (mempty :: Const [Bool] Int)+ , RightDistributiveGCDMonoidInstance (mempty :: Const [Word] Int) , RightDistributiveGCDMonoidInstance (mempty :: Dual [()]) , RightDistributiveGCDMonoidInstance (mempty :: Dual [Bool]) , RightDistributiveGCDMonoidInstance (mempty :: Dual [Word])@@ -504,6 +535,8 @@ lcmInstances = [LCMMonoidInstance (mempty :: Product Natural), LCMMonoidInstance (mempty :: Sum Natural),+ LCMMonoidInstance (mempty :: Identity (Sum Natural)),+ LCMMonoidInstance (mempty :: Const (Sum Natural) Int), LCMMonoidInstance (mempty :: Dual (Product Natural)), LCMMonoidInstance (mempty :: Dual (Sum Natural)), LCMMonoidInstance (mempty :: IntSet),@@ -525,6 +558,8 @@ , DistributiveLCMMonoidInstance (mempty :: Set ()) , DistributiveLCMMonoidInstance (mempty :: Set Bool) , DistributiveLCMMonoidInstance (mempty :: Set Word)+ , DistributiveLCMMonoidInstance (mempty :: Identity (Sum Natural))+ , DistributiveLCMMonoidInstance (mempty :: Const (Sum Natural) Int) , DistributiveLCMMonoidInstance (mempty :: Dual (Product Natural)) , DistributiveLCMMonoidInstance (mempty :: Dual (Sum Natural)) ]@@ -542,14 +577,14 @@ checkInstances (LeftReductiveTest checkType) = (map checkType leftReductiveInstances) checkInstances (RightReductiveTest checkType) = (map checkType rightReductiveInstances) checkInstances (ReductiveTest checkType) = (map checkType reductiveInstances)-checkInstances (LeftCancellativeTest checkType) = (map checkType leftCancellativeInstances) -checkInstances (RightCancellativeTest checkType) = (map checkType rightCancellativeInstances) -checkInstances (CancellativeTest checkType) = (map checkType cancellativeInstances) +checkInstances (LeftCancellativeTest checkType) = (map checkType leftCancellativeInstances)+checkInstances (RightCancellativeTest checkType) = (map checkType rightCancellativeInstances)+checkInstances (CancellativeTest checkType) = (map checkType cancellativeInstances) checkInstances (OverlappingGCDTest checkType) = (map checkType overlappingGCDMonoidInstances) checkInstances (MonusTest checkType) = (map checkType monusInstances)-checkInstances (LeftGCDTest checkType) = (map checkType leftGCDInstances) -checkInstances (RightGCDTest checkType) = (map checkType rightGCDInstances) -checkInstances (GCDTest checkType) = (map checkType gcdInstances) +checkInstances (LeftGCDTest checkType) = (map checkType leftGCDInstances)+checkInstances (RightGCDTest checkType) = (map checkType rightGCDInstances)+checkInstances (GCDTest checkType) = (map checkType gcdInstances) checkInstances (DistributiveGCDTest checkType) = (map checkType distributiveGCDMonoidInstances) checkInstances (LeftDistributiveGCDTest checkType) = (map checkType leftDistributiveGCDMonoidInstances) checkInstances (RightDistributiveGCDTest checkType) = (map checkType rightDistributiveGCDMonoidInstances)@@ -629,6 +664,12 @@ ("overlap idempotence", OverlappingGCDTest checkOverlap_idempotence), ("overlap identity (left)", OverlappingGCDTest checkOverlap_identity_left), ("overlap identity (right)", OverlappingGCDTest checkOverlap_identity_right),+ ("Monus identity (1)", MonusTest checkMonus_identity_1),+ ("Monus identity (2)", MonusTest checkMonus_identity_2),+ ("Monus mappend (1)", MonusTest checkMonus_mappend_1),+ ("Monus mappend (2)", MonusTest checkMonus_mappend_2),+ ("Monus stripPrefixOverlap", MonusTest checkMonus_stripPrefixOverlap),+ ("Monus stripSuffixOverlap", MonusTest checkMonus_stripSuffixOverlap), ("isPrefixOf", LeftReductiveTest checkIsPrefixOf), ("stripSuffix", RightReductiveTest checkStripSuffix), ("isSuffixOf", RightReductiveTest checkIsSuffixOf),@@ -694,16 +735,16 @@ checkFactorsOfFactors (FactorialMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen a) (all singleton . factors) where singleton prime = factors prime == [prime] -checkSplitPrimePrefix (FactorialMonoidInstance (_ :: a)) = +checkSplitPrimePrefix (FactorialMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen a) (\a-> factors a == unfoldr splitPrimePrefix a) checkSplitPrimeSuffix (FactorialMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen a) check where check a = factors a == reverse (unfoldr (fmap swap . splitPrimeSuffix) a) -checkPrimePrefix (FactorialMonoidInstance (_ :: a)) = +checkPrimePrefix (FactorialMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen a) (\a-> primePrefix a == maybe mempty fst (splitPrimePrefix a)) -checkPrimeSuffix (FactorialMonoidInstance (_ :: a)) = +checkPrimeSuffix (FactorialMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen a) (\a-> primeSuffix a == maybe mempty snd (splitPrimeSuffix a)) checkInits (FactorialMonoidInstance (_ :: a)) =@@ -712,16 +753,16 @@ checkTails (FactorialMonoidInstance (_ :: a)) = mapSize (`div` 5) $ forAll (arbitrary :: Gen a) (\a-> tails a == List.map mconcat (List.tails $ factors a)) -checkLeftFold (FactorialMonoidInstance (_ :: a)) = +checkLeftFold (FactorialMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen a) (\a-> foldl (flip (:)) [] a == List.foldl (flip (:)) [] (factors a)) -checkLeftFold' (FactorialMonoidInstance (_ :: a)) = +checkLeftFold' (FactorialMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen a) (\a-> foldl' (flip (:)) [] a == List.foldl' (flip (:)) [] (factors a)) -checkRightFold (FactorialMonoidInstance (_ :: a)) = +checkRightFold (FactorialMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen a) (\a-> foldr (:) [] a == List.foldr (:) [] (factors a)) -checkLength (FactorialMonoidInstance (_ :: a)) = +checkLength (FactorialMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen a) (\a-> length a == List.length (factors a)) checkSpan (FactorialMonoidInstance (_ :: a)) = property $ \p-> forAll (arbitrary :: Gen a) (check p)@@ -744,19 +785,19 @@ where check i a = splitAt i a == (mconcat l, mconcat r) where (l, r) = List.splitAt i (factors a) -checkReverse (FactorialMonoidInstance (_ :: a)) = +checkReverse (FactorialMonoidInstance (_ :: a)) = property $ forAll (arbitrary :: Gen a) (\a-> reverse a == mconcat (List.reverse $ factors a)) checkStability (StableFactorialMonoidInstance (_ :: a)) = property $ forAll (arbitrary :: Gen (a, a)) (\(a, b)-> factors (a <> b) == factors a <> factors b) -checkFromText (TextualMonoidInstance (_ :: a)) = +checkFromText (TextualMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen Text) (\t-> Textual.fromText t == (fromString (Text.unpack t) :: a)) -checkSingleton (TextualMonoidInstance (_ :: a)) = +checkSingleton (TextualMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen Char) (\c-> Textual.singleton c == (fromString [c] :: a)) -checkSplitCharacterPrefix (TextualMonoidInstance (_ :: a)) = +checkSplitCharacterPrefix (TextualMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen String) check1 .&&. forAll (arbitrary :: Gen a) check2 where check1 s = unfoldr Textual.splitCharacterPrefix (fromString s :: a) == s check2 t = Textual.splitCharacterPrefix (primePrefix t)@@ -774,7 +815,7 @@ checkFactorsFromString (TextualMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen String) check where check s = unfoldr Textual.splitCharacterPrefix (fromString s :: a) == s -checkTextualMap (TextualMonoidInstance (_ :: a)) = +checkTextualMap (TextualMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2 where check1 a = Textual.map wrapSucc a == Textual.concatMap (Textual.singleton . wrapSucc) a && Textual.map id a == a@@ -783,7 +824,7 @@ | c == maxBound = minBound | otherwise = succ c -checkConcatMap (TextualMonoidInstance (_ :: a)) = +checkConcatMap (TextualMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2 where check1 a = Textual.concatMap (fromString . f) a == mconcat (map apply $ factors a) && Textual.concatMap Textual.singleton a == a@@ -797,19 +838,19 @@ checkAny (TextualMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen a) check where check a = Textual.any isLetter a == Textual.foldr (const id) ((||) . isLetter) False a -checkTextualFoldl (TextualMonoidInstance (_ :: a)) = +checkTextualFoldl (TextualMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2 where check1 a = Textual.foldl (\l a-> Left a : l) (\l c-> Right c : l) [] a == List.reverse (textualFactors a) && Textual.foldl (<>) (\a-> (a <>) . Textual.singleton) mempty a == a check2 s = Textual.foldl undefined (flip (:)) [] s == List.foldl (flip (:)) [] s -checkTextualFoldr (TextualMonoidInstance (_ :: a)) = +checkTextualFoldr (TextualMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2 where check1 a = Textual.foldr (\a l-> Left a : l) (\c l-> Right c : l) [] a == textualFactors a && Textual.foldr (<>) ((<>) . Textual.singleton) mempty a == a check2 s = Textual.foldr undefined (:) [] (fromString s :: a) == s -checkTextualFoldl' (TextualMonoidInstance (_ :: a)) = +checkTextualFoldl' (TextualMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2 where check1 a = Textual.foldl' (\l a-> Left a : l) (\l c-> Right c : l) [] a == List.reverse (textualFactors a) && Textual.foldl' (<>) (\a-> (a <>) . Textual.singleton) mempty a == a@@ -868,28 +909,28 @@ where check1 a = forAll arbitrary $ \f-> Textual.toText f a == Textual.foldr (\t s-> f t <> s) Text.cons Text.empty a check2 s = Textual.toText undefined (Textual.fromText s :: a) == s -checkTextualMapAccumL (TextualMonoidInstance (_ :: a)) = +checkTextualMapAccumL (TextualMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2 where check1 a = uncurry (Textual.mapAccumL (,)) ((), a) == ((), a) check2 s = Textual.mapAccumL f c (fromString s :: a) == fmap fromString (List.mapAccumL f c s) c = 0 :: Int f n c = if isLetter c then (succ n, succ c) else (2*n, c) -checkTextualMapAccumR (TextualMonoidInstance (_ :: a)) = +checkTextualMapAccumR (TextualMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2 where check1 a = uncurry (Textual.mapAccumR (,)) ((), a) == ((), a) check2 s = Textual.mapAccumR f c (fromString s :: a) == fmap fromString (List.mapAccumR f c s) c = 0 :: Int f n c = if isLetter c then (succ n, succ c) else (2*n, c) -checkTextualTakeWhile (TextualMonoidInstance (_ :: a)) = +checkTextualTakeWhile (TextualMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2 where check1 a = textualFactors (Textual.takeWhile (const True) isLetter a) == List.takeWhile (either (const True) isLetter) (textualFactors a) && Textual.takeWhile (const True) (const True) a == a check2 s = Textual.takeWhile undefined isLetter (fromString s :: a) == fromString (List.takeWhile isLetter s) -checkTextualDropWhile (TextualMonoidInstance (_ :: a)) = +checkTextualDropWhile (TextualMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2 where check1 a = textualFactors (Textual.dropWhile (const True) isLetter a) == List.dropWhile (either (const True) isLetter) (textualFactors a)@@ -942,14 +983,14 @@ foldMaybe = Textual.foldl_' gc (Just s0) gc s c = s >>= flip fc c -checkTextualTakeWhile_ (TextualMonoidInstance (_ :: a)) = +checkTextualTakeWhile_ (TextualMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2 where check1 a = textualFactors (Textual.takeWhile_ True isLetter a) == List.takeWhile (either (const True) isLetter) (textualFactors a) && Textual.takeWhile_ True (const True) a == a check2 s = Textual.takeWhile_ undefined isLetter (fromString s :: a) == fromString (List.takeWhile isLetter s) -checkTextualDropWhile_ (TextualMonoidInstance (_ :: a)) = +checkTextualDropWhile_ (TextualMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2 where check1 a = textualFactors (Textual.dropWhile_ True isLetter a) == List.dropWhile (either (const True) isLetter) (textualFactors a)@@ -961,7 +1002,7 @@ where check a = List.all (List.all isLetter . rights . textualFactors) (Textual.split (not . isLetter) a) && (mconcat . intersperse (fromString " ") . Textual.split (== ' ')) a == a -checkTextualFind (TextualMonoidInstance (_ :: a)) = +checkTextualFind (TextualMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2 where check1 a = Textual.find isLetter a == (List.find isLetter . rights . textualFactors) a check2 s = Textual.find isLetter (fromString s :: a) == List.find isLetter s@@ -1263,11 +1304,41 @@ where check a b c = gcd a (lcm b c) === lcm (gcd a b) (gcd a c) +checkMonus_identity_1 (MonusInstance (_ :: a)) =+ forAll (arbitrary :: Gen a) check+ where+ check a = a <\> a === mempty++checkMonus_identity_2 (MonusInstance (_ :: a)) =+ forAll (arbitrary :: Gen a) check+ where+ check a = mempty <\> a === mempty++checkMonus_mappend_1 (MonusInstance (_ :: a)) =+ forAll (arbitrary :: Gen (a, a)) check+ where+ check a b = a <> (b <\> a) === b <> (a <\> b)++checkMonus_mappend_2 (MonusInstance (_ :: a)) =+ forAll (arbitrary :: Gen (a, a, a)) check+ where+ check (a, b, c) = (a <\> b) <\> c === a <\> (b <> c)++checkMonus_stripPrefixOverlap (MonusInstance (_ :: a)) =+ forAll (arbitrary :: Gen (a, a)) check+ where+ check (a, b) = (a <\> b) === stripPrefixOverlap b a++checkMonus_stripSuffixOverlap (MonusInstance (_ :: a)) =+ forAll (arbitrary :: Gen (a, a)) check+ where+ check (a, b) = (a <\> b) === stripSuffixOverlap b a+ textualFactors :: TextualMonoid t => t -> [Either t Char] textualFactors = map characterize . factors where characterize prime = maybe (Left prime) Right (Textual.characterPrefix prime) -newtype TestString = TestString String deriving (Eq, Show, Arbitrary, CoArbitrary, +newtype TestString = TestString String deriving (Eq, Show, Arbitrary, CoArbitrary, Semigroup, LeftReductive, LeftCancellative, StableFactorial, Monoid, LeftGCDMonoid, MonoidNull, PositiveMonoid, IsString)
monoid-subclasses.cabal view
@@ -1,14 +1,27 @@ Name: monoid-subclasses-Version: 1.2.5.1+Version: 1.2.6 Cabal-Version: >= 1.10 Build-Type: Simple Synopsis: Subclasses of Monoid Category: Data, Algebra, Text-Tested-with: GHC==9.0.1, GHC==8.10.4, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2+Tested-with: GHC==8.0.2+ , GHC==8.2.2+ , GHC==8.4.4+ , GHC==8.6.5+ , GHC==8.8.4+ , GHC==8.10.7+ , GHC==9.0.2+ , GHC==9.2.8+ , GHC==9.4.8+ , GHC==9.6.6+ , GHC==9.8.4+ , GHC==9.10.1+ , GHC==9.12.1+ Description: A hierarchy of subclasses of 'Monoid' together with their instances for all data structures from base, containers, and text packages.- + License: BSD3 License-file: BSD3-LICENSE.txt Copyright: (c) 2013-2024 Mario Blažević@@ -42,7 +55,7 @@ , Data.Semigroup.Factorial Build-Depends: base >= 4.9 && < 5, bytestring >= 0.9 && < 1.0,- containers >= 0.5.7.0 && < 0.8,+ containers >= 0.5.7.0 && < 0.9, text >= 0.11 && < 1.3 || >= 2.0 && < 2.2, primes == 0.2.*, vector >= 0.12 && < 0.14,
src/Data/Monoid/Factorial.hs view
@@ -1,13 +1,15 @@-{- +{- Copyright 2013-2017 Mario Blazevic License: BSD3 (see BSD3-LICENSE.txt file) -} -- | This module defines the 'FactorialMonoid' class and some of its instances.--- +-- {-# LANGUAGE Haskell2010, ConstraintKinds, FlexibleInstances, Trustworthy #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-} module Data.Monoid.Factorial ( module Data.Semigroup.Factorial,@@ -16,6 +18,8 @@ where import Control.Arrow (first)+import Data.Functor.Const (Const (Const))+import Data.Functor.Identity (Identity (Identity)) import Data.Monoid -- (Monoid (..), Dual(..), Sum(..), Product(..), Endo(Endo, appEndo)) import qualified Data.Foldable as Foldable import qualified Data.List as List@@ -46,9 +50,9 @@ -- Factors of a list are /not/ its elements but all its single-item sublists: -- -- prop> factors "abc" == ["a", "b", "c"]--- +-- -- The methods of this class satisfy the following laws in addition to those of 'Factorial':--- +-- -- > null == List.null . factors -- > factors == unfoldr splitPrimePrefix == List.reverse . unfoldr (fmap swap . splitPrimeSuffix) -- > reverse == mconcat . List.reverse . factors@@ -162,6 +166,10 @@ instance FactorialMonoid () where splitPrimePrefix () = Nothing splitPrimeSuffix () = Nothing++deriving instance FactorialMonoid a => FactorialMonoid (Identity a)++deriving instance FactorialMonoid a => FactorialMonoid (Const a b) instance FactorialMonoid a => FactorialMonoid (Dual a) where splitPrimePrefix (Dual a) = case splitPrimeSuffix a
src/Data/Monoid/GCD.hs view
@@ -1,4 +1,4 @@-{- +{- Copyright 2013-2019 Mario Blazevic License: BSD3 (see BSD3-LICENSE.txt file)@@ -49,6 +49,8 @@ -- Subclass of 'RightGCDMonoid' with /right/-distributivity. -- {-# LANGUAGE CPP, Haskell2010, FlexibleInstances, Trustworthy #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-} module Data.Monoid.GCD ( GCDMonoid (..)@@ -63,6 +65,8 @@ import qualified Prelude +import Data.Functor.Const (Const (Const))+import Data.Functor.Identity (Identity (Identity)) import Data.Monoid -- (Monoid, Dual(..), Sum(..), Product(..)) import qualified Data.ByteString as ByteString import qualified Data.ByteString.Unsafe as ByteString@@ -210,7 +214,7 @@ -- | Class of monoids capable of finding the equivalent of greatest common divisor on the right side of two monoidal -- values. The following laws must be respected:--- +-- -- > stripCommonSuffix a b == (a', b', s) -- > where s = commonSuffix a b -- > Just a' = stripSuffix p a@@ -285,6 +289,18 @@ instance RightGCDMonoid () where commonSuffix () () = () +-- Identity instances++deriving instance GCDMonoid a => GCDMonoid (Identity a)+deriving instance LeftGCDMonoid a => LeftGCDMonoid (Identity a)+deriving instance RightGCDMonoid a => RightGCDMonoid (Identity a)++-- Const instances++deriving instance GCDMonoid a => GCDMonoid (Const a b)+deriving instance LeftGCDMonoid a => LeftGCDMonoid (Const a b)+deriving instance RightGCDMonoid a => RightGCDMonoid (Const a b)+ -- Dual instances instance GCDMonoid a => GCDMonoid (Dual a) where@@ -617,6 +633,8 @@ => DistributiveGCDMonoid m instance DistributiveGCDMonoid ()+instance DistributiveGCDMonoid a => DistributiveGCDMonoid (Identity a)+instance DistributiveGCDMonoid a => DistributiveGCDMonoid (Const a b) instance DistributiveGCDMonoid (Product Natural) instance DistributiveGCDMonoid (Sum Natural) instance DistributiveGCDMonoid IntSet.IntSet@@ -655,6 +673,8 @@ instance Ord a => LeftDistributiveGCDMonoid (Set.Set a) -- Instances for monoid transformers:+instance LeftDistributiveGCDMonoid a => LeftDistributiveGCDMonoid (Identity a)+instance LeftDistributiveGCDMonoid a => LeftDistributiveGCDMonoid (Const a b) instance RightDistributiveGCDMonoid a => LeftDistributiveGCDMonoid (Dual a) --------------------------------------------------------------------------------@@ -689,4 +709,6 @@ instance Ord a => RightDistributiveGCDMonoid (Set.Set a) -- Instances for monoid transformers:+instance RightDistributiveGCDMonoid a => RightDistributiveGCDMonoid (Identity a)+instance RightDistributiveGCDMonoid a => RightDistributiveGCDMonoid (Const a b) instance LeftDistributiveGCDMonoid a => RightDistributiveGCDMonoid (Dual a)
src/Data/Monoid/Instances/PrefixMemory.hs view
@@ -130,6 +130,10 @@ where rewrap (cp, cs) = (Shadowed p cp, Shadowed (p <> cp) cs) splitPrimeSuffix (Shadowed p c) = fmap rewrap (splitPrimeSuffix c) where rewrap (cp, cs) = (Shadowed p cp, Shadowed (p <> cp) cs)+ inits (Shadowed p c) = Shadowed p <$> inits c+ tails (Shadowed p c)+ | null p = zipWith Shadowed (inits c) (tails c)+ | otherwise = zipWith (Shadowed . (p <>)) (inits c) (tails c) spanMaybe s0 f (Shadowed p0 c) = rewrap $ Factorial.spanMaybe (s0, p0) f' c where f' (s, p) prime = do s' <- f s (Shadowed p prime) let p' = p <> prime
src/Data/Monoid/Instances/Stateful.hs view
@@ -70,11 +70,11 @@ {-# INLINE mempty #-} {-# INLINE mappend #-} -instance (MonoidNull a, MonoidNull b) => MonoidNull (Stateful a b) where+instance (Semigroup a, Semigroup b, MonoidNull a, MonoidNull b) => MonoidNull (Stateful a b) where null (Stateful x) = null x {-# INLINE null #-} -instance (PositiveMonoid a, PositiveMonoid b) => PositiveMonoid (Stateful a b)+instance (Semigroup a, Semigroup b, PositiveMonoid a, PositiveMonoid b) => PositiveMonoid (Stateful a b) instance (LeftReductive a, LeftReductive b) => LeftReductive (Stateful a b) where isPrefixOf (Stateful x) (Stateful x') = isPrefixOf x x'
src/Data/Monoid/LCM.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE Haskell2010, FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-} -- | This module defines the 'LCMMonoid' subclass of the 'Monoid' class. --@@ -21,6 +23,8 @@ import Prelude hiding (gcd, lcm, max) import qualified Prelude +import Data.Functor.Const (Const (Const))+import Data.Functor.Identity (Identity (Identity)) import Data.IntSet (IntSet) import Data.Monoid (Dual (..), Product (..), Sum (..)) import Data.Monoid.GCD (GCDMonoid (..), DistributiveGCDMonoid)@@ -106,6 +110,10 @@ instance LCMMonoid () where lcm () () = () +deriving instance LCMMonoid a => LCMMonoid (Identity a)++deriving instance LCMMonoid a => LCMMonoid (Const a b)+ instance LCMMonoid a => LCMMonoid (Dual a) where lcm (Dual a) (Dual b) = Dual (lcm a b) @@ -166,6 +174,8 @@ class (DistributiveGCDMonoid m, LCMMonoid m) => DistributiveLCMMonoid m instance DistributiveLCMMonoid ()+instance DistributiveLCMMonoid a => DistributiveLCMMonoid (Identity a)+instance DistributiveLCMMonoid a => DistributiveLCMMonoid (Const a b) instance DistributiveLCMMonoid (Product Natural) instance DistributiveLCMMonoid (Sum Natural) instance DistributiveLCMMonoid IntSet
src/Data/Monoid/Monus.hs view
@@ -1,4 +1,4 @@-{- +{- Copyright 2013-2019 Mario Blazevic License: BSD3 (see BSD3-LICENSE.txt file)@@ -9,12 +9,16 @@ -- @since 1.0 {-# LANGUAGE Haskell2010, FlexibleInstances, Trustworthy #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-} module Data.Monoid.Monus ( Monus(..), OverlappingGCDMonoid(..) ) where- ++import Data.Functor.Const (Const (Const))+import Data.Functor.Identity (Identity (Identity)) import Data.Monoid -- (Monoid, Dual(..), Sum(..), Product(..)) import qualified Data.ByteString as ByteString import qualified Data.ByteString.Lazy as LazyByteString@@ -34,12 +38,33 @@ import Prelude hiding (null) --- | Class of Abelian monoids with monus. The monus operation '<\>' is a synonym for both 'stripPrefixOverlap' and--- 'stripSuffixOverlap', which must be equivalent as '<>' is both associative and commutative:+-- | Class of Abelian monoids with monus. --+-- The monus operation '<\>' is a synonym for both 'stripPrefixOverlap' and+-- 'stripSuffixOverlap', which must be equivalent as '<>' is both associative+-- and commutative:+-- -- > (<\>) = flip stripPrefixOverlap -- > (<\>) = flip stripSuffixOverlap --+-- In addition, the monus operation '<\>' must satisfy the following laws:+--+-- @+-- a '<\>' a '==' 'mempty'+-- @+--+-- @+-- 'mempty' '<\>' a '==' 'mempty'+-- @+--+-- @+-- a '<>' (b '<\>' a) '==' b '<>' (a '<\>' b)+-- @+--+-- @+-- (a '<\>' b) '<\>' c '==' a '<\>' (b '<>' c)+-- @+-- -- @since 1.0 class (Commutative m, Monoid m, OverlappingGCDMonoid m) => Monus m where (<\>) :: m -> m -> m@@ -111,6 +136,16 @@ stripOverlap () () = ((), (), ()) stripPrefixOverlap () () = () stripSuffixOverlap () () = ()++-- Identity instances++deriving instance Monus a => Monus (Identity a)+deriving instance OverlappingGCDMonoid a => OverlappingGCDMonoid (Identity a)++-- Const instances++deriving instance Monus a => Monus (Const a b)+deriving instance OverlappingGCDMonoid a => OverlappingGCDMonoid (Const a b) -- Dual instances
src/Data/Monoid/Null.hs view
@@ -8,6 +8,8 @@ -- {-# LANGUAGE Haskell2010, CPP, FlexibleInstances, DefaultSignatures, Trustworthy #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-} module Data.Monoid.Null ( MonoidNull(..), PositiveMonoid@@ -140,12 +142,10 @@ #endif -- | @since 1.2.5.0-instance MonoidNull r => MonoidNull (Const r a) where- null (Const r) = null r+deriving instance MonoidNull a => MonoidNull (Const a b) -- | @since 1.2.5.0-instance MonoidNull a => MonoidNull (Identity a) where- null (Identity a) = null a+deriving instance MonoidNull a => MonoidNull (Identity a) -- | @since 1.2.5.0 instance MonoidNull a => MonoidNull (WrappedMonoid a) where
src/Data/Semigroup/Cancellative.hs view
@@ -1,4 +1,4 @@-{- +{- Copyright 2013-2019 Mario Blazevic License: BSD3 (see BSD3-LICENSE.txt file)@@ -17,16 +17,18 @@ -- -- All semigroup subclasses listed above are for Abelian, /i.e./, commutative or symmetric semigroups. Since most -- practical semigroups in Haskell are not Abelian, each of the these classes has two symmetric superclasses:--- +-- -- * 'LeftReductive'--- +-- -- * 'LeftCancellative'--- +-- -- * 'RightReductive'--- +-- -- * 'RightCancellative' {-# LANGUAGE Haskell2010, FlexibleInstances, Trustworthy #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-} module Data.Semigroup.Cancellative ( -- * Symmetric, commutative semigroup classes@@ -59,7 +61,7 @@ -- | Class of Abelian semigroups with a partial inverse for the Semigroup '<>' operation. The inverse operation '</>' must -- satisfy the following laws:--- +-- -- > maybe a (b <>) (a </> b) == a -- > maybe a (<> b) (a </> b) == a --@@ -81,11 +83,11 @@ class (LeftCancellative m, RightCancellative m, Reductive m) => Cancellative m -- | Class of semigroups with a left inverse of 'Data.Semigroup.<>', satisfying the following law:--- +-- -- > isPrefixOf a b == isJust (stripPrefix a b) -- > maybe b (a <>) (stripPrefix a b) == b -- > a `isPrefixOf` (a <> b)--- +-- -- Every instance definition has to implement at least the 'stripPrefix' method. class Semigroup m => LeftReductive m where isPrefixOf :: m -> m -> Bool@@ -95,11 +97,11 @@ {-# MINIMAL stripPrefix #-} -- | Class of semigroups with a right inverse of 'Data.Semigroup.<>', satisfying the following law:--- +-- -- > isSuffixOf a b == isJust (stripSuffix a b) -- > maybe b (<> a) (stripSuffix a b) == b -- > b `isSuffixOf` (a <> b)--- +-- -- Every instance definition has to implement at least the 'stripSuffix' method. class Semigroup m => RightReductive m where isSuffixOf :: m -> m -> Bool@@ -248,27 +250,17 @@ -- Identity & Const instances -instance Reductive a => Reductive (Identity a) where- Identity a </> Identity b = Identity <$> (a </> b)-instance Reductive a => Reductive (Const a x) where- Const a </> Const b = Const <$> (a </> b)+deriving instance Reductive a => Reductive (Identity a)+deriving instance Reductive a => Reductive (Const a b) instance Cancellative a => Cancellative (Identity a) instance Cancellative a => Cancellative (Const a x) -instance LeftReductive a => LeftReductive (Identity a) where- stripPrefix (Identity a) (Identity b) = Identity <$> stripPrefix a b- isPrefixOf (Identity a) (Identity b) = isPrefixOf a b-instance LeftReductive a => LeftReductive (Const a x) where- stripPrefix (Const a) (Const b) = Const <$> stripPrefix a b- isPrefixOf (Const a) (Const b) = isPrefixOf a b+deriving instance LeftReductive a => LeftReductive (Identity a)+deriving instance LeftReductive a => LeftReductive (Const a b) -instance RightReductive a => RightReductive (Identity a) where- stripSuffix (Identity a) (Identity b) = Identity <$> stripSuffix a b- isSuffixOf (Identity a) (Identity b) = isSuffixOf a b-instance RightReductive a => RightReductive (Const a x) where- stripSuffix (Const a) (Const b) = Const <$> stripSuffix a b- isSuffixOf (Const a) (Const b) = isSuffixOf a b+deriving instance RightReductive a => RightReductive (Identity a)+deriving instance RightReductive a => RightReductive (Const a b) instance LeftCancellative a => LeftCancellative (Identity a) instance LeftCancellative a => LeftCancellative (Const a x)
src/Data/Semigroup/Factorial.hs view
@@ -1,13 +1,15 @@-{- +{- Copyright 2013-2019 Mario Blazevic License: BSD3 (see BSD3-LICENSE.txt file) -} -- | This module defines the 'Semigroup' => 'Factorial' => 'StableFactorial' classes and some of their instances.--- +-- {-# LANGUAGE Haskell2010, FlexibleInstances, Trustworthy #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-} module Data.Semigroup.Factorial ( -- * Classes@@ -18,6 +20,8 @@ where import qualified Control.Monad as Monad+import Data.Functor.Const (Const (Const))+import Data.Functor.Identity (Identity (Identity)) import Data.Semigroup -- (Semigroup (..), Dual(..), Sum(..), Product(..), Endo(Endo, appEndo)) import qualified Data.Foldable as Foldable import qualified Data.List as List@@ -50,9 +54,9 @@ -- Factors of a list are /not/ its elements but all its single-item sublists: -- -- prop> factors "abc" == ["a", "b", "c"]--- +-- -- The methods of this class satisfy the following laws:--- +-- -- > maybe id sconcat . nonEmpty . factors == id -- > List.all (\prime-> factors prime == [prime]) . factors -- > primePrefix s == foldr const s s@@ -117,6 +121,10 @@ length () = 0 reverse = id +deriving instance Factorial a => Factorial (Identity a)++deriving instance Factorial a => Factorial (Const a b)+ instance Factorial a => Factorial (Dual a) where factors (Dual a) = fmap Dual (reverse $ factors a) length (Dual a) = length a@@ -420,6 +428,8 @@ reverse = Vector.reverse instance StableFactorial ()+instance StableFactorial a => StableFactorial (Identity a)+instance StableFactorial a => StableFactorial (Const a b) instance StableFactorial a => StableFactorial (Dual a) instance StableFactorial [x] instance StableFactorial ByteString.ByteString