packages feed

monoid-subclasses (empty) → 0.1

raw patch · 9 files changed

+2120/−0 lines, 9 filesdep +QuickCheckdep +basedep +bytestringsetup-changed

Dependencies added: QuickCheck, base, bytestring, containers, primes, quickcheck-instances, test-framework, test-framework-quickcheck2, text, utf8-string, vector

Files

+ BSD3-LICENSE.txt view
@@ -0,0 +1,22 @@+Copyright (c) 2012-2013, Mario Blazevic+All rights reserved.++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the+following conditions are met:++Redistributions of source code must retain the above copyright notice, this list of conditions and the following+disclaimer.++Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following+disclaimer in the documentation and/or other materials provided with the distribution.++Neither the name of {{the ORGANIZATION nor the names of its contributors}} may be used to endorse or promote products+derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY {{THE COPYRIGHT HOLDERS AND CONTRIBUTORS}} "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL {{THE COPYRIGHT HOLDER OR CONTRIBUTORS}} BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Data/Monoid/Cancellative.hs view
@@ -0,0 +1,547 @@+{- +    Copyright 2011-2013 Mario Blazevic++    License: BSD3 (see BSD3-LICENSE.txt file)+-}++-- | This module defines the 'Monoid' => 'ReductiveMonoid' => ('CancellativeMonoid', 'GCDMonoid') class hierarchy. +--+-- The 'ReductiveMonoid' class introduces operation '</>' which is the inverse of '<>'. For the 'Sum' monoid, this+-- operation is subtraction; for 'Product' it is division and for 'Set' it's the set difference. A 'ReductiveMonoid' is+-- not a full group because '</>' may return 'Nothing'.+--+-- The 'CancellativeMonoid' subclass does not add any operation but it provides the additional guarantee that '<>' can+-- always be undone with '</>'. Thus 'Sum' is a 'CancellativeMonoid' but 'Product' is not because @(0*n)/0@ is not+-- defined.+--+-- The 'GCDMonoid' subclass adds the 'gcd' operation which takes two monoidal arguments and finds their greatest common+-- divisor, or (more generally) the greatest monoid that can be extracted with the '</>' operation from both.+--+-- All monoid subclasses listed above are for Abelian, /i.e./, commutative or symmetric monoids. Since most practical+-- monoids in Haskell are not Abelian, each of the these classes has two symmetric superclasses:+-- +-- * 'LeftReductiveMonoid' +-- +-- * 'LeftCancellativeMonoid' +-- +-- * 'LeftGCDMonoid' +-- +-- * 'RightReductiveMonoid' +-- +-- * 'RightCancellativeMonoid'+-- +-- * 'RightGCDMonoid'++{-# LANGUAGE Haskell2010 #-}++module Data.Monoid.Cancellative (+   -- * Symmetric monoid classes+   ReductiveMonoid(..), CancellativeMonoid(..), GCDMonoid(..),+   -- * Asymmetric monoid classes+   LeftReductiveMonoid(..), RightReductiveMonoid(..),+   LeftCancellativeMonoid(..), RightCancellativeMonoid(..),+   LeftGCDMonoid(..), RightGCDMonoid(..)+   )+where++import Prelude hiding (gcd)+import qualified Prelude++import Data.Monoid (Monoid (mappend), Dual(..), Sum(..), Product(..))+import qualified Data.List as List+import Data.Maybe (isJust)+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Lazy as LazyByteString+import qualified Data.Text as Text+import qualified Data.Text.Lazy as LazyText+import qualified Data.IntMap as IntMap+import qualified Data.IntSet as IntSet+import qualified Data.Map as Map+import qualified Data.Sequence as Sequence+import qualified Data.Set as Set+import Data.Sequence (ViewL((:<)), ViewR((:>)), (<|), (|>))+import qualified Data.Vector as Vector++-- | Class of Abelian monoids with a partial inverse for the Monoid '<>' operation. The inverse operation '</>' must+-- satisfy the following laws:+-- +-- > maybe a (b <>) (a </> b) == a+-- > maybe a (<> b) (a </> b) == a+class (LeftReductiveMonoid m, RightReductiveMonoid m) => ReductiveMonoid m where+   (</>) :: m -> m -> Maybe m++infix 5 </>++-- | Subclass of 'ReductiveMonoid' where '</>' is a complete inverse of the Monoid '<>' operation. The class instances+-- must satisfy the following additional laws:+--+-- > (a <> b) </> a == Just b+-- > (a <> b) </> b == Just a+class (LeftCancellativeMonoid m, RightCancellativeMonoid m, ReductiveMonoid m) => CancellativeMonoid m++-- | Class of Abelian monoids that allow the greatest common denominator to be found for any two given values. The+-- operations must satisfy the following laws:+--+-- > gcd a b == commonPrefix a b == commonSuffix a b+-- > Just a' = a </> p && Just b' = b </> p+-- >    where p = gcd a b+-- +-- If a 'GCDMonoid' happens to also be a 'CancellativeMonoid', it should additionally satisfy the following laws:+-- +-- > gcd (a <> b) (a <> c) == a <> gcd b c+-- > gcd (a <> c) (b <> c) == gcd a b <> c+class (ReductiveMonoid m, LeftGCDMonoid m, RightGCDMonoid m) => GCDMonoid m where+   gcd :: m -> m -> m++-- | Class of monoids with a left inverse of 'mappend', 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. Its complexity should be no worse+-- than linear in the length of the prefix argument.+class Monoid m => LeftReductiveMonoid m where+   isPrefixOf :: m -> m -> Bool+   stripPrefix :: m -> m -> Maybe m++   isPrefixOf a b = isJust (stripPrefix a b)++-- | Class of monoids with a right inverse of 'mappend', 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. Its complexity should be no worse+-- than linear in the length of the suffix argument.+class Monoid m => RightReductiveMonoid m where+   isSuffixOf :: m -> m -> Bool+   stripSuffix :: m -> m -> Maybe m++   isSuffixOf a b = isJust (stripSuffix a b)++-- | Subclass of 'LeftReductiveMonoid' where 'stripPrefix' is a complete inverse of '<>', satisfying the following+-- additional law:+--+-- > stripPrefix a (a <> b) == Just b+class LeftReductiveMonoid m => LeftCancellativeMonoid m++-- | Subclass of 'LeftReductiveMonoid' where 'stripPrefix' is a complete inverse of '<>', satisfying the following+-- additional law:+--+-- > stripSuffix b (a <> b) == Just a+class RightReductiveMonoid m => RightCancellativeMonoid m++-- | Class of monoids capable of finding the equivalent of greatest common divisor on the left side of two monoidal+-- values. The methods' complexity should be no worse than linear in the length of the common prefix. The following laws+-- must be respected:+-- +-- > stripCommonPrefix a b == (p, a', b')+-- >    where p = commonPrefix a b+-- >          Just a' = stripPrefix p a+-- >          Just b' = stripPrefix p b+-- > p == commonPrefix a b && p <> a' == a && p <> b' == b+-- >    where (p, a', b') = stripCommonPrefix a b+class LeftReductiveMonoid m => LeftGCDMonoid m where+   commonPrefix :: m -> m -> m+   stripCommonPrefix :: m -> m -> (m, m, m)++   commonPrefix x y = p+      where (p, _, _) = stripCommonPrefix x y+   stripCommonPrefix x y = (p, x', y')+      where p = commonPrefix x y+            Just x' = stripPrefix p x+            Just y' = stripPrefix p y++-- | Class of monoids capable of finding the equivalent of greatest common divisor on the right side of two monoidal+-- values. The methods' complexity must be no worse than linear in the length of the common suffix. The following laws+-- must be respected:+-- +-- > stripCommonSuffix a b == (a', b', s)+-- >    where s = commonSuffix a b+-- >          Just a' = stripSuffix p a+-- >          Just b' = stripSuffix p b+-- > s == commonSuffix a b && a' <> s == a && b' <> s == b+-- >    where (a', b', s) = stripCommonSuffix a b+class RightReductiveMonoid m => RightGCDMonoid m where+   commonSuffix :: m -> m -> m+   stripCommonSuffix :: m -> m -> (m, m, m)++   commonSuffix x y = s+      where (_, _, s) = stripCommonSuffix x y+   stripCommonSuffix x y = (x', y', s)+      where s = commonSuffix x y+            Just x' = stripSuffix s x+            Just y' = stripSuffix s y++-- Dual instances++instance ReductiveMonoid a => ReductiveMonoid (Dual a) where+   Dual a </> Dual b = fmap Dual (a </> b)++instance CancellativeMonoid a => CancellativeMonoid (Dual a)++instance GCDMonoid a => GCDMonoid (Dual a) where+   gcd (Dual a) (Dual b) = Dual (gcd a b)++instance LeftReductiveMonoid a => RightReductiveMonoid (Dual a) where+   stripSuffix (Dual a) (Dual b) = fmap Dual (stripPrefix a b)+   Dual a `isSuffixOf` Dual b = a `isPrefixOf` b++instance RightReductiveMonoid a => LeftReductiveMonoid (Dual a) where+   stripPrefix (Dual a) (Dual b) = fmap Dual (stripSuffix a b)+   Dual a `isPrefixOf` Dual b = a `isSuffixOf` b++instance LeftCancellativeMonoid a => RightCancellativeMonoid (Dual a)++instance RightCancellativeMonoid a => LeftCancellativeMonoid (Dual a)++instance LeftGCDMonoid a => RightGCDMonoid (Dual a) where+   commonSuffix (Dual a) (Dual b) = Dual (commonPrefix a b)++instance RightGCDMonoid a => LeftGCDMonoid (Dual a) where+   commonPrefix (Dual a) (Dual b) = Dual (commonSuffix a b)++-- Sum instances++instance Integral a => ReductiveMonoid (Sum a) where+   Sum a </> Sum b = Just $ Sum (a - b)++instance Integral a => CancellativeMonoid (Sum a)++instance (Integral a, Ord a) => GCDMonoid (Sum a) where+   gcd (Sum a) (Sum b) = Sum (min a b)++instance Integral a => LeftReductiveMonoid (Sum a) where+   stripPrefix a b = b </> a++instance Integral a => RightReductiveMonoid (Sum a) where+   stripSuffix a b = b </> a++instance Integral a => LeftCancellativeMonoid (Sum a)++instance Integral a => RightCancellativeMonoid (Sum a)++instance (Integral a, Ord a) => LeftGCDMonoid (Sum a) where+   commonPrefix a b = gcd a b++instance (Integral a, Ord a) => RightGCDMonoid (Sum a) where+   commonSuffix a b = gcd a b++-- Product instances++instance Integral a => ReductiveMonoid (Product a) where+   Product 0 </> Product 0 = Just (Product 0)+   Product a </> Product 0 = Nothing+   Product a </> Product b = if remainder == 0 then Just (Product quotient) else Nothing+      where (quotient, remainder) = quotRem a b++instance Integral a => GCDMonoid (Product a) where+   gcd (Product a) (Product b) = Product (Prelude.gcd a b)++instance Integral a => LeftReductiveMonoid (Product a) where+   stripPrefix a b = b </> a++instance Integral a => RightReductiveMonoid (Product a) where+   stripSuffix a b = b </> a++instance Integral a => LeftGCDMonoid (Product a) where+   commonPrefix a b = gcd a b++instance Integral a => RightGCDMonoid (Product a) where+   commonSuffix a b = gcd a b++-- Pair instances++instance (ReductiveMonoid a, ReductiveMonoid b) => ReductiveMonoid (a, b) where+   (a, b) </> (c, d) = case (a </> c, b </> d)+                       of (Just a', Just b') -> Just (a', b')+                          _ -> Nothing++instance (CancellativeMonoid a, CancellativeMonoid b) => CancellativeMonoid (a, b)++instance (GCDMonoid a, GCDMonoid b) => GCDMonoid (a, b) where+   gcd (a, b) (c, d) = (gcd a c, gcd b d)++instance (LeftReductiveMonoid a, LeftReductiveMonoid b) => LeftReductiveMonoid (a, b) where+   stripPrefix (a, b) (c, d) = case (stripPrefix a c, stripPrefix b d)+                               of (Just a', Just b') -> Just (a', b')+                                  _ -> Nothing+   isPrefixOf (a, b) (c, d) = isPrefixOf a c && isPrefixOf b d++instance (RightReductiveMonoid a, RightReductiveMonoid b) => RightReductiveMonoid (a, b) where+   stripSuffix (a, b) (c, d) = case (stripSuffix a c, stripSuffix b d)+                               of (Just a', Just b') -> Just (a', b')+                                  _ -> Nothing+   isSuffixOf (a, b) (c, d) = isSuffixOf a c && isSuffixOf b d++instance (LeftCancellativeMonoid a, LeftCancellativeMonoid b) => LeftCancellativeMonoid (a, b)++instance (RightCancellativeMonoid a, RightCancellativeMonoid b) => RightCancellativeMonoid (a, b)++instance (LeftGCDMonoid a, LeftGCDMonoid b) => LeftGCDMonoid (a, b) where+   commonPrefix (a, b) (c, d) = (commonPrefix a c, commonPrefix b d)++instance (RightGCDMonoid a, RightGCDMonoid b) => RightGCDMonoid (a, b) where+   commonSuffix (a, b) (c, d) = (commonSuffix a c, commonSuffix b d)++-- Set instances++instance Ord a => LeftReductiveMonoid (Set.Set a) where+   isPrefixOf = Set.isSubsetOf+   stripPrefix a b = b </> a++instance Ord a => RightReductiveMonoid (Set.Set a) where+   isSuffixOf = Set.isSubsetOf+   stripSuffix a b = b </> a++instance Ord a => ReductiveMonoid (Set.Set a) where+   a </> b | Set.isSubsetOf b a = Just (a Set.\\ b)+           | otherwise = Nothing++instance Ord a => LeftGCDMonoid (Set.Set a) where+   commonPrefix = Set.intersection++instance Ord a => RightGCDMonoid (Set.Set a) where+   commonSuffix = Set.intersection++instance Ord a => GCDMonoid (Set.Set a) where+   gcd = Set.intersection++-- IntSet instances++instance LeftReductiveMonoid IntSet.IntSet where+   isPrefixOf = IntSet.isSubsetOf+   stripPrefix a b = b </> a++instance RightReductiveMonoid IntSet.IntSet where+   isSuffixOf = IntSet.isSubsetOf+   stripSuffix a b = b </> a++instance ReductiveMonoid IntSet.IntSet where+   a </> b | IntSet.isSubsetOf b a = Just (a IntSet.\\ b)+           | otherwise = Nothing++instance LeftGCDMonoid IntSet.IntSet where+   commonPrefix = IntSet.intersection++instance RightGCDMonoid IntSet.IntSet where+   commonSuffix = IntSet.intersection++instance GCDMonoid IntSet.IntSet where+   gcd = IntSet.intersection++-- Map instances++instance Ord k => LeftReductiveMonoid (Map.Map k a) where+   isPrefixOf = Map.isSubmapOfBy (\_ _-> True)+   stripPrefix a b | Map.isSubmapOfBy (\_ _-> True) a b = Just (b Map.\\ a)+                   | otherwise = Nothing++instance (Ord k, Eq a) => LeftGCDMonoid (Map.Map k a) where+   commonPrefix = Map.mergeWithKey (\k a b -> if a == b then Just a else Nothing) (const Map.empty) (const Map.empty)++-- IntMap instances++instance LeftReductiveMonoid (IntMap.IntMap a) where+   isPrefixOf = IntMap.isSubmapOfBy (\_ _-> True)+   stripPrefix a b | IntMap.isSubmapOfBy (\_ _-> True) a b = Just (b IntMap.\\ a)+                   | otherwise = Nothing++instance Eq a => LeftGCDMonoid (IntMap.IntMap a) where+   commonPrefix = IntMap.mergeWithKey (\k a b -> if a == b then Just a else Nothing)+                                      (const IntMap.empty) (const IntMap.empty)++-- List instances++instance Eq x => LeftReductiveMonoid [x] where+   stripPrefix = List.stripPrefix+   isPrefixOf = List.isPrefixOf++instance Eq x => LeftCancellativeMonoid [x]++instance Eq x => LeftGCDMonoid [x] where+   commonPrefix (x:xs) (y:ys) | x == y = x : commonPrefix xs ys+   commonPrefix _ _ = []++   stripCommonPrefix x y = strip' id x y+      where strip' f (x:xs) (y:ys) | x == y = strip' (f . (x :)) xs ys+            strip' f x y = (f [], x, y)++-- Seq instances++instance Eq a => LeftReductiveMonoid (Sequence.Seq a) where+   stripPrefix p s | p == s1 = Just s2+                   | otherwise = Nothing+      where (s1, s2) = Sequence.splitAt (Sequence.length p) s++instance Eq a => RightReductiveMonoid (Sequence.Seq a) where+   stripSuffix p s | p == s2 = Just s1+                   | otherwise = Nothing+      where (s1, s2) = Sequence.splitAt (Sequence.length s - Sequence.length p) s++instance Eq a => LeftCancellativeMonoid (Sequence.Seq a)++instance Eq a => RightCancellativeMonoid (Sequence.Seq a)++instance Eq a => LeftGCDMonoid (Sequence.Seq a) where+   stripCommonPrefix = findCommonPrefix Sequence.empty+      where findCommonPrefix prefix a b = case (Sequence.viewl a, Sequence.viewl b)+                                          of (a1:<a', b1:<b') | a1 == b1 -> findCommonPrefix (prefix |> a1) a' b'+                                             _ -> (prefix, a, b)++instance Eq a => RightGCDMonoid (Sequence.Seq a) where+   stripCommonSuffix = findCommonSuffix Sequence.empty+      where findCommonSuffix suffix a b = case (Sequence.viewr a, Sequence.viewr b)+                                          of (a':>a1, b':>b1) | a1 == b1 -> findCommonSuffix (a1 <| suffix) a' b'+                                             _ -> (a, b, suffix)++-- Vector instances++instance Eq a => LeftReductiveMonoid (Vector.Vector a) where+   stripPrefix p l | prefixLength > Vector.length l = Nothing+                    | otherwise = strip 0+      where strip i | i == prefixLength = Just (Vector.drop prefixLength l)+                    | l Vector.! i == p Vector.! i = strip (succ i)+                    | otherwise = Nothing+            prefixLength = Vector.length p+   isPrefixOf p l | prefixLength > Vector.length l = False+                  | otherwise = test 0+      where test i | i == prefixLength = True+                   | l Vector.! i == p Vector.! i = test (succ i)+                   | otherwise = False+            prefixLength = Vector.length p++instance Eq a => RightReductiveMonoid (Vector.Vector a) where+   stripSuffix s l | suffixLength > Vector.length l = Nothing+                   | otherwise = strip (pred suffixLength)+      where strip i | i == -1 = Just (Vector.take lengthDifference l)+                    | l Vector.! (lengthDifference + i) == s Vector.! i = strip (pred i)+                    | otherwise = Nothing+            suffixLength = Vector.length s+            lengthDifference = Vector.length l - suffixLength+   isSuffixOf s l | suffixLength > Vector.length l = False+                  | otherwise = test (pred suffixLength)+      where test i | i == -1 = True+                   | l Vector.! (lengthDifference + i) == s Vector.! i = test (pred i)+                   | otherwise = False+            suffixLength = Vector.length s+            lengthDifference = Vector.length l - suffixLength++instance Eq a => LeftCancellativeMonoid (Vector.Vector a)++instance Eq a => RightCancellativeMonoid (Vector.Vector a)++instance Eq a => LeftGCDMonoid (Vector.Vector a) where+   stripCommonPrefix x y = (xp, xs, Vector.drop maxPrefixLength y)+      where maxPrefixLength = prefixLength 0 (Vector.length x `min` Vector.length y)+            prefixLength n len | n < len && x Vector.! n == y Vector.! n = prefixLength (succ n) len+            prefixLength n _ = n+            (xp, xs) = Vector.splitAt maxPrefixLength x++instance Eq a => RightGCDMonoid (Vector.Vector a) where+   stripCommonSuffix x y = findSuffix (Vector.length x - 1) (Vector.length y - 1)+      where findSuffix m n | m >= 0 && n >= 0 && x Vector.! m == y Vector.! n =+               findSuffix (pred m) (pred n)+            findSuffix m n = (Vector.take (succ m) x, yp, ys)+               where (yp, ys) = Vector.splitAt (succ n) y++-- ByteString instances++instance LeftReductiveMonoid ByteString.ByteString where+   stripPrefix p l = if ByteString.isPrefixOf p l+                     then Just (ByteString.drop (ByteString.length p) l)+                     else Nothing+   isPrefixOf = ByteString.isPrefixOf++instance RightReductiveMonoid ByteString.ByteString where+   stripSuffix s l = if ByteString.isSuffixOf s l+                     then Just (ByteString.take (ByteString.length l - ByteString.length s) l)+                     else Nothing+   isSuffixOf = ByteString.isSuffixOf++instance LeftCancellativeMonoid ByteString.ByteString++instance RightCancellativeMonoid ByteString.ByteString++instance LeftGCDMonoid ByteString.ByteString where+   stripCommonPrefix x y = (xp, xs, ByteString.drop maxPrefixLength y)+      where maxPrefixLength = prefixLength 0 (ByteString.length x `min` ByteString.length y)+            prefixLength n len | n < len && ByteString.index x n == ByteString.index y n = prefixLength (succ n) len+            prefixLength n _ = n+            (xp, xs) = ByteString.splitAt maxPrefixLength x++instance RightGCDMonoid ByteString.ByteString where+   stripCommonSuffix x y = findSuffix (ByteString.length x - 1) (ByteString.length y - 1)+      where findSuffix m n | m >= 0 && n >= 0 && ByteString.index x m == ByteString.index y n =+               findSuffix (pred m) (pred n)+            findSuffix m n = (ByteString.take (succ m) x, yp, ys)+               where (yp, ys) = ByteString.splitAt (succ n) y++-- Lazy ByteString instances++instance LeftReductiveMonoid LazyByteString.ByteString where+   stripPrefix p l = if LazyByteString.isPrefixOf p l+                     then Just (LazyByteString.drop (LazyByteString.length p) l)+                     else Nothing+   isPrefixOf = LazyByteString.isPrefixOf++instance RightReductiveMonoid LazyByteString.ByteString where+   stripSuffix s l = if LazyByteString.isSuffixOf s l+                     then Just (LazyByteString.take (LazyByteString.length l - LazyByteString.length s) l)+                     else Nothing+   isSuffixOf = LazyByteString.isSuffixOf++instance LeftCancellativeMonoid LazyByteString.ByteString++instance RightCancellativeMonoid LazyByteString.ByteString++instance LeftGCDMonoid LazyByteString.ByteString where+   stripCommonPrefix x y = (xp, xs, LazyByteString.drop maxPrefixLength y)+      where maxPrefixLength = prefixLength 0 (LazyByteString.length x `min` LazyByteString.length y)+            prefixLength n len | n < len && LazyByteString.index x n == LazyByteString.index y n = +               prefixLength (succ n) len+            prefixLength n _ = n+            (xp, xs) = LazyByteString.splitAt maxPrefixLength x++instance RightGCDMonoid LazyByteString.ByteString where+   stripCommonSuffix x y = findSuffix (LazyByteString.length x - 1) (LazyByteString.length y - 1)+      where findSuffix m n | m >= 0 && n >= 0 && LazyByteString.index x m == LazyByteString.index y n =+               findSuffix (pred m) (pred n)+            findSuffix m n = (LazyByteString.take (succ m) x, yp, ys)+               where (yp, ys) = LazyByteString.splitAt (succ n) y++-- Text instances++instance LeftReductiveMonoid Text.Text where+   stripPrefix = Text.stripPrefix+   isPrefixOf = Text.isPrefixOf++instance RightReductiveMonoid Text.Text where+   stripSuffix = Text.stripSuffix+   isSuffixOf = Text.isSuffixOf++instance LeftCancellativeMonoid Text.Text++instance RightCancellativeMonoid Text.Text++instance LeftGCDMonoid Text.Text where+   stripCommonPrefix x y = maybe (Text.empty, x, y) id (Text.commonPrefixes x y)++-- Lazy Text instances++instance LeftReductiveMonoid LazyText.Text where+   stripPrefix = LazyText.stripPrefix+   isPrefixOf = LazyText.isPrefixOf++instance RightReductiveMonoid LazyText.Text where+   stripSuffix = LazyText.stripSuffix+   isSuffixOf = LazyText.isSuffixOf++instance LeftCancellativeMonoid LazyText.Text++instance RightCancellativeMonoid LazyText.Text++instance LeftGCDMonoid LazyText.Text where+   stripCommonPrefix x y = maybe (LazyText.empty, x, y) id (LazyText.commonPrefixes x y)
+ Data/Monoid/Factorial.hs view
@@ -0,0 +1,455 @@+{- +    Copyright 2011-2013 Mario Blazevic++    License: BSD3 (see BSD3-LICENSE.txt file)+-}++-- | This module defines the 'FactorialMonoid' class and some of its instances.+-- ++{-# LANGUAGE Haskell2010 #-}++module Data.Monoid.Factorial (+   -- * Class+   FactorialMonoid(..),+   -- * Monad function equivalents+   mapM, mapM_+   )+where++import Prelude hiding (break, drop, dropWhile, foldl, foldr, length, map, mapM, mapM_, null,+                       reverse, span, splitAt, take, takeWhile)+   +import qualified Control.Monad as Monad+import Data.Monoid (Monoid (..), Dual(..), Sum(..), Product(..), Endo(Endo, appEndo))+import qualified Data.Foldable as Foldable+import qualified Data.List as List+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Lazy as LazyByteString+import qualified Data.Text as Text+import qualified Data.Text.Lazy as LazyText+import qualified Data.IntMap as IntMap+import qualified Data.IntSet as IntSet+import qualified Data.Map as Map+import qualified Data.Sequence as Sequence+import qualified Data.Set as Set+import qualified Data.Vector as Vector+import Data.Numbers.Primes (primeFactors)++import Data.Monoid.Null (MonoidNull(null))++-- | Class of monoids that can be split into irreducible (/i.e./, atomic or prime) 'factors' in a unique way. Factors of+-- a 'Product' are literally its prime factors:+--+-- prop> factors (Product 12) == [Product 2, Product 2, Product 3] +--+-- 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:+-- +-- > mconcat . factors == id+-- > null == List.null . factors+-- > List.all (\prime-> factors prime == [prime]) . factors+-- > factors == unfoldr splitPrimePrefix == List.reverse . unfoldr (fmap swap . splitPrimeSuffix)+-- > reverse == mconcat . List.reverse . factors+-- > primePrefix == maybe mempty fst . splitPrimePrefix+-- > primeSuffix == maybe mempty snd . splitPrimeSuffix+-- > foldl f a == List.foldl f a . factors+-- > foldl' f a == List.foldl' f a . factors+-- > foldr f a == List.foldr f a . factors+-- > span p m == (mconcat l, mconcat r) where (l, r) = List.span p (factors m)+-- > List.all (List.all (not . pred) . factors) . split pred+-- > mconcat . intersperse prime . split (== prime) == id+-- > splitAt i m == (mconcat l, mconcat r) where (l, r) = List.splitAt i (factors m)+--+-- It's worth noting that a class instance does /not/ need to satisfy this law:+--+-- > factors (a <> b) == factors a <> factors b+--+-- A minimal instance definition must implement 'factors' or 'splitPrimePrefix'. Other methods are provided and should+-- be implemented only for performance reasons.+class MonoidNull m => FactorialMonoid m where+   -- | Returns a list of all prime factors; inverse of mconcat.+   factors :: m -> [m]+   -- | The prime prefix, 'mempty' if none.+   primePrefix :: m -> m+   -- | The prime suffix, 'mempty' if none.+   primeSuffix :: m -> m+   -- | Splits the argument into its prime prefix and the remaining suffix. Returns 'Nothing' for 'mempty'.+   splitPrimePrefix :: m -> Maybe (m, m)+   -- | Splits the argument into its prime suffix and the remaining prefix. Returns 'Nothing' for 'mempty'.+   splitPrimeSuffix :: m -> Maybe (m, m)+   -- | Like 'List.foldl' from "Data.List" on the list of 'primes'.+   foldl :: (a -> m -> a) -> a -> m -> a+   -- | Like 'List.foldl'' from "Data.List" on the list of 'primes'.+   foldl' :: (a -> m -> a) -> a -> m -> a+   -- | Like 'List.foldr' from "Data.List" on the list of 'primes'.+   foldr :: (m -> a -> a) -> a -> m -> a+   -- | The 'length' of the list of 'primes'.+   length :: m -> Int+   -- | Equivalent to 'List.map' from "Data.List", except the argument function works on prime factors rather than list+   -- elements.+   map :: (FactorialMonoid m, Monoid n) => (m -> n) -> m -> n+   -- | Like 'List.span' from "Data.List" on the list of 'primes'.+   span :: (m -> Bool) -> m -> (m, m)+   -- | Equivalent to 'List.break' from "Data.List".+   break :: FactorialMonoid m => (m -> Bool) -> m -> (m, m)+   -- | Splits the monoid into components delimited by prime separators satisfying the given predicate. The primes+   -- satisfying the predicate are not a part of the result.+   split :: (m -> Bool) -> m -> [m]+   -- | Equivalent to 'List.takeWhile' from "Data.List".+   takeWhile :: FactorialMonoid m => (m -> Bool) -> m -> m+   -- | Equivalent to 'List.dropWhile' from "Data.List".+   dropWhile :: FactorialMonoid m => (m -> Bool) -> m -> m+   -- | Like 'List.splitAt' from "Data.List" on the list of 'primes'.+   splitAt :: Int -> m -> (m, m)+   -- | Equivalent to 'List.drop' from "Data.List".+   drop :: FactorialMonoid m => Int -> m -> m+   -- | Equivalent to 'List.take' from "Data.List".+   take :: FactorialMonoid m => Int -> m -> m+   -- | Equivalent to 'List.reverse' from "Data.List".+   reverse :: FactorialMonoid m => m -> m++   factors = List.unfoldr splitPrimePrefix+   primePrefix = maybe mempty fst . splitPrimePrefix+   primeSuffix = maybe mempty snd . splitPrimeSuffix+   splitPrimePrefix x = case factors x+                        of [] -> Nothing+                           prefix : rest -> Just (prefix, mconcat rest)+   splitPrimeSuffix x = case factors x+                        of [] -> Nothing+                           fs -> Just (mconcat (List.init fs), List.last fs)+   foldl f f0 = List.foldl f f0 . factors+   foldl' f f0 = List.foldl' f f0 . factors+   foldr f f0 = List.foldr f f0 . factors+   length = List.length . factors+   map f = foldr (mappend . f) mempty+   span p = foldr f (mempty, mempty)+      where f s (prefix, suffix) = if p s +                                   then (mappend s prefix, suffix) +                                   else (mempty, mappend s (mappend prefix suffix))+   break = span . (not .)+   split p m = foldr f [mempty] m+      where f prime s@(x:xs) | p prime = mempty : s +                             | otherwise = mappend prime x : xs+   takeWhile p = fst . span p+   dropWhile p = snd . span p+   splitAt n m | n <= 0 = (mempty, m)+                | otherwise = split n id m+      where split 0 f m = (f mempty, m)+            split n f m = case splitPrimePrefix m+                          of Nothing -> (f mempty, m)+                             Just (prime, rest) -> split (pred n) (f . mappend prime) rest+   drop n p = snd (splitAt n p)+   take n p = fst (splitAt n p)+   reverse = mconcat . List.reverse . factors++instance FactorialMonoid a => FactorialMonoid (Dual a) where+   factors (Dual a) = fmap Dual (reverse $ factors a)+   length (Dual a) = length a+   primePrefix (Dual a) = Dual (primeSuffix a)+   primeSuffix (Dual a) = Dual (primePrefix a)+   splitPrimePrefix (Dual a) = case splitPrimeSuffix a+                               of Nothing -> Nothing+                                  Just (p, s) -> Just (Dual s, Dual p)+   splitPrimeSuffix (Dual a) = case splitPrimePrefix a+                               of Nothing -> Nothing+                                  Just (p, s) -> Just (Dual s, Dual p)+   reverse (Dual a) = Dual (reverse a)++instance (Integral a, Eq a) => FactorialMonoid (Sum a) where+   primePrefix (Sum a) = Sum (signum a )+   primeSuffix = primePrefix+   splitPrimePrefix (Sum 0) = Nothing+   splitPrimePrefix (Sum a) = Just (Sum (signum a), Sum (a - signum a))+   splitPrimeSuffix (Sum 0) = Nothing+   splitPrimeSuffix (Sum a) = Just (Sum (a - signum a), Sum (signum a))+   length (Sum a) = abs (fromIntegral a)+   reverse = id++instance Integral a => FactorialMonoid (Product a) where+   factors (Product a) = List.map Product (primeFactors a)+   reverse = id++instance FactorialMonoid a => FactorialMonoid (Maybe a) where+   factors Nothing = []+   factors (Just a) | null a = [Just a]+                    | otherwise = List.map Just (factors a)+   length Nothing = 0+   length (Just a) | null a = 1+                   | otherwise = length a+   reverse = fmap reverse++instance (FactorialMonoid a, FactorialMonoid b) => FactorialMonoid (a, b) where+   factors (a, b) = List.map (\a-> (a, mempty)) (factors a) ++ List.map ((,) mempty) (factors b)+   length (a, b) = length a + length b+   reverse (a, b) = (reverse a, reverse b)++instance FactorialMonoid [x] where+   factors xs = List.map (:[]) xs+   primePrefix [] = []+   primePrefix (x:xs) = [x]+   primeSuffix [] = []+   primeSuffix xs = [List.last xs]+   splitPrimePrefix [] = Nothing+   splitPrimePrefix (x:xs) = Just ([x], xs)+   splitPrimeSuffix [] = Nothing+   splitPrimeSuffix xs = Just (split id xs)+      where split f last@[x] = (f [], last)+            split f (x:xs) = split (f . (x:)) xs+   foldl _ a [] = a+   foldl f a (x:xs) = foldl f (f a [x]) xs+   foldl' _ a [] = a+   foldl' f a (x:xs) = let a' = f a [x] in a' `seq` foldl' f a' xs+   foldr _ f0 [] = f0+   foldr f f0 (x:xs) = f [x] (foldr f f0 xs)+   length = List.length+   map f = mconcat . List.map (f . (:[]))+   break f = List.break (f . (:[]))+   span f = List.span (f . (:[]))+   dropWhile f = List.dropWhile (f . (:[]))+   takeWhile f = List.takeWhile (f . (:[]))+   splitAt = List.splitAt+   drop = List.drop+   take = List.take+   reverse = List.reverse++instance FactorialMonoid ByteString.ByteString where+   factors x = factorize (ByteString.length x) x+      where factorize 0 xs = []+            factorize n xs = x : factorize (pred n) xs'+              where (x, xs') = ByteString.splitAt 1 xs+   primePrefix = ByteString.take 1+   primeSuffix x = ByteString.drop (ByteString.length x - 1) x+   splitPrimePrefix x = if ByteString.null x then Nothing else Just (ByteString.splitAt 1 x)+   splitPrimeSuffix x = if ByteString.null x then Nothing else Just (ByteString.splitAt (ByteString.length x - 1) x)+   foldl f = ByteString.foldl f'+      where f' a byte = f a (ByteString.singleton byte)+   foldl' f = ByteString.foldl' f'+      where f' a byte = f a (ByteString.singleton byte)+   foldr f = ByteString.foldr (f . ByteString.singleton)+   break f = ByteString.break (f . ByteString.singleton)+   span f = ByteString.span (f . ByteString.singleton)+   dropWhile f = ByteString.dropWhile (f . ByteString.singleton)+   takeWhile f = ByteString.takeWhile (f . ByteString.singleton)+   length = ByteString.length+   split f = ByteString.splitWith f'+      where f' = f . ByteString.singleton+   splitAt = ByteString.splitAt+   drop = ByteString.drop+   take = ByteString.take+   reverse = ByteString.reverse++instance FactorialMonoid LazyByteString.ByteString where+   factors x = factorize (LazyByteString.length x) x+      where factorize 0 xs = []+            factorize n xs = x : factorize (pred n) xs'+              where (x, xs') = LazyByteString.splitAt 1 xs+   primePrefix = LazyByteString.take 1+   primeSuffix x = LazyByteString.drop (LazyByteString.length x - 1) x+   splitPrimePrefix x = if LazyByteString.null x then Nothing +                        else Just (LazyByteString.splitAt 1 x)+   splitPrimeSuffix x = if LazyByteString.null x then Nothing +                        else Just (LazyByteString.splitAt (LazyByteString.length x - 1) x)+   foldl f = LazyByteString.foldl f'+      where f' a byte = f a (LazyByteString.singleton byte)+   foldl' f = LazyByteString.foldl' f'+      where f' a byte = f a (LazyByteString.singleton byte)+   foldr f = LazyByteString.foldr f'+      where f' byte a = f (LazyByteString.singleton byte) a+   length = fromIntegral . LazyByteString.length+   break f = LazyByteString.break (f . LazyByteString.singleton)+   span f = LazyByteString.span (f . LazyByteString.singleton)+   dropWhile f = LazyByteString.dropWhile (f . LazyByteString.singleton)+   takeWhile f = LazyByteString.takeWhile (f . LazyByteString.singleton)+   split f = LazyByteString.splitWith f'+      where f' = f . LazyByteString.singleton+   splitAt = LazyByteString.splitAt . fromIntegral+   drop n = LazyByteString.drop (fromIntegral n)+   take n = LazyByteString.take (fromIntegral n)+   reverse = LazyByteString.reverse++instance FactorialMonoid Text.Text where+   factors = Text.chunksOf 1+   primePrefix = Text.take 1+   primeSuffix x = if Text.null x then Text.empty else Text.singleton (Text.last x)+   splitPrimePrefix = fmap (\(c, t)-> (Text.singleton c, t)) . Text.uncons+   splitPrimeSuffix x = if Text.null x then Nothing else Just (Text.splitAt (Text.length x - 1) x)+   foldl f = Text.foldl f'+      where f' a char = f a (Text.singleton char)+   foldl' f = Text.foldl' f'+      where f' a char = f a (Text.singleton char)+   foldr f = Text.foldr f'+      where f' char a = f (Text.singleton char) a+   length = Text.length+   span f = Text.span (f . Text.singleton)+   break f = Text.break (f . Text.singleton)+   dropWhile f = Text.dropWhile (f . Text.singleton)+   takeWhile f = Text.takeWhile (f . Text.singleton)+   split f = Text.split f'+      where f' = f . Text.singleton+   splitAt = Text.splitAt+   drop = Text.drop+   take = Text.take+   reverse = Text.reverse++instance FactorialMonoid LazyText.Text where+   factors = LazyText.chunksOf 1+   primePrefix = LazyText.take 1+   primeSuffix x = if LazyText.null x then LazyText.empty else LazyText.singleton (LazyText.last x)+   splitPrimePrefix = fmap (\(c, t)-> (LazyText.singleton c, t)) . LazyText.uncons+   splitPrimeSuffix x = if LazyText.null x then Nothing else Just (LazyText.splitAt (LazyText.length x - 1) x)+   foldl f = LazyText.foldl f'+      where f' a char = f a (LazyText.singleton char)+   foldl' f = LazyText.foldl' f'+      where f' a char = f a (LazyText.singleton char)+   foldr f = LazyText.foldr f'+      where f' char a = f (LazyText.singleton char) a+   length = fromIntegral . LazyText.length+   span f = LazyText.span (f . LazyText.singleton)+   break f = LazyText.break (f . LazyText.singleton)+   dropWhile f = LazyText.dropWhile (f . LazyText.singleton)+   takeWhile f = LazyText.takeWhile (f . LazyText.singleton)+   split f = LazyText.split f'+      where f' = f . LazyText.singleton+   splitAt = LazyText.splitAt . fromIntegral+   drop n = LazyText.drop (fromIntegral n)+   take n = LazyText.take (fromIntegral n)+   reverse = LazyText.reverse++instance Ord k => FactorialMonoid (Map.Map k v) where+   factors = List.map (uncurry Map.singleton) . Map.toAscList+   primePrefix map | Map.null map = map+                   | otherwise = uncurry Map.singleton $ Map.findMin map+   primeSuffix map | Map.null map = map+                   | otherwise = uncurry Map.singleton $ Map.findMax map+   splitPrimePrefix = fmap singularize . Map.minViewWithKey+      where singularize ((k, v), rest) = (Map.singleton k v, rest)+   splitPrimeSuffix = fmap singularize . Map.maxViewWithKey+      where singularize ((k, v), rest) = (rest, Map.singleton k v)+   foldl f = Map.foldlWithKey f'+      where f' a k v = f a (Map.singleton k v)+   foldl' f = Map.foldlWithKey' f'+      where f' a k v = f a (Map.singleton k v)+   foldr f = Map.foldrWithKey f'+      where f' k v a = f (Map.singleton k v) a+   length = Map.size+   reverse = id++instance FactorialMonoid (IntMap.IntMap a) where+   factors = List.map (uncurry IntMap.singleton) . IntMap.toAscList+   primePrefix map | IntMap.null map = map+                   | otherwise = uncurry IntMap.singleton $ IntMap.findMin map+   primeSuffix map | IntMap.null map = map+                   | otherwise = uncurry IntMap.singleton $ IntMap.findMax map+   splitPrimePrefix = fmap singularize . IntMap.minViewWithKey+      where singularize ((k, v), rest) = (IntMap.singleton k v, rest)+   splitPrimeSuffix = fmap singularize . IntMap.maxViewWithKey+      where singularize ((k, v), rest) = (rest, IntMap.singleton k v)+   foldl f = IntMap.foldlWithKey f'+      where f' a k v = f a (IntMap.singleton k v)+   foldl' f = IntMap.foldlWithKey' f'+      where f' a k v = f a (IntMap.singleton k v)+   foldr f = IntMap.foldrWithKey f'+      where f' k v a = f (IntMap.singleton k v) a+   length = IntMap.size+   reverse = id++instance FactorialMonoid IntSet.IntSet where+   factors = List.map IntSet.singleton . IntSet.toAscList+   primePrefix set | IntSet.null set = set+                   | otherwise = IntSet.singleton $ IntSet.findMin set+   primeSuffix set | IntSet.null set = set+                   | otherwise = IntSet.singleton $ IntSet.findMax set+   splitPrimePrefix = fmap singularize . IntSet.minView+      where singularize (min, rest) = (IntSet.singleton min, rest)+   splitPrimeSuffix = fmap singularize . IntSet.maxView+      where singularize (max, rest) = (rest, IntSet.singleton max)+   foldl f = IntSet.foldl f'+      where f' a b = f a (IntSet.singleton b)+   foldl' f = IntSet.foldl' f'+      where f' a b = f a (IntSet.singleton b)+   foldr f = IntSet.foldr f'+      where f' a b = f (IntSet.singleton a) b+   length = IntSet.size+   reverse = id++instance FactorialMonoid (Sequence.Seq a) where+   factors = List.map Sequence.singleton . Foldable.toList+   primePrefix = Sequence.take 1+   primeSuffix seq = Sequence.drop (Sequence.length seq - 1) seq+   splitPrimePrefix seq = case Sequence.viewl seq+                          of Sequence.EmptyL -> Nothing+                             first Sequence.:< rest -> Just (Sequence.singleton first, rest)+   splitPrimeSuffix seq = case Sequence.viewr seq+                          of Sequence.EmptyR -> Nothing+                             rest Sequence.:> last -> Just (rest, Sequence.singleton last)+   foldl f = Foldable.foldl f'+      where f' a b = f a (Sequence.singleton b)+   foldl' f = Foldable.foldl' f'+      where f' a b = f a (Sequence.singleton b)+   foldr f = Foldable.foldr f'+      where f' a b = f (Sequence.singleton a) b+   span f = Sequence.spanl (f . Sequence.singleton)+   break f = Sequence.breakl (f . Sequence.singleton)+   dropWhile f = Sequence.dropWhileL (f . Sequence.singleton)+   takeWhile f = Sequence.takeWhileL (f . Sequence.singleton)+   splitAt = Sequence.splitAt+   drop = Sequence.drop+   take = Sequence.take+   length = Sequence.length+   reverse = Sequence.reverse++instance Ord a => FactorialMonoid (Set.Set a) where+   factors = List.map Set.singleton . Set.toAscList+   primePrefix set | Set.null set = set+                   | otherwise = Set.singleton $ Set.findMin set+   primeSuffix set | Set.null set = set+                   | otherwise = Set.singleton $ Set.findMax set+   splitPrimePrefix = fmap singularize . Set.minView+      where singularize (min, rest) = (Set.singleton min, rest)+   splitPrimeSuffix = fmap singularize . Set.maxView+      where singularize (max, rest) = (rest, Set.singleton max)+   foldl f = Foldable.foldl f'+      where f' a b = f a (Set.singleton b)+   foldl' f = Foldable.foldl' f'+      where f' a b = f a (Set.singleton b)+   foldr f = Foldable.foldr f'+      where f' a b = f (Set.singleton a) b+   length = Set.size+   reverse = id++instance FactorialMonoid (Vector.Vector a) where+   factors x = factorize (Vector.length x) x+      where factorize 0 xs = []+            factorize n xs = x : factorize (pred n) xs'+              where (x, xs') = Vector.splitAt 1 xs+   primePrefix = Vector.take 1+   primeSuffix x = Vector.drop (Vector.length x - 1) x+   splitPrimePrefix x = if Vector.null x then Nothing else Just (Vector.splitAt 1 x)+   splitPrimeSuffix x = if Vector.null x then Nothing else Just (Vector.splitAt (Vector.length x - 1) x)+   foldl f = Vector.foldl f'+      where f' a byte = f a (Vector.singleton byte)+   foldl' f = Vector.foldl' f'+      where f' a byte = f a (Vector.singleton byte)+   foldr f = Vector.foldr f'+      where f' byte a = f (Vector.singleton byte) a+   break f = Vector.break (f . Vector.singleton)+   span f = Vector.span (f . Vector.singleton)+   dropWhile f = Vector.dropWhile (f . Vector.singleton)+   takeWhile f = Vector.takeWhile (f . Vector.singleton)+   splitAt = Vector.splitAt+   drop = Vector.drop+   take = Vector.take+   length = Vector.length+   reverse = Vector.reverse++-- | A 'Monad.mapM' equivalent.+mapM :: (FactorialMonoid a, Monoid b, Monad m) => (a -> m b) -> a -> m b+mapM f = ($ return mempty) . appEndo . map (Endo . Monad.liftM2 mappend . f)++-- | A 'Monad.mapM_' equivalent.+mapM_ :: (FactorialMonoid a, Monad m) => (a -> m b) -> a -> m ()+mapM_ f = foldr ((>>) . f) (return ())
+ Data/Monoid/Instances/ByteString/UTF8.hs view
@@ -0,0 +1,54 @@+{- +    Copyright 2013 Mario Blazevic++    License: BSD3 (see BSD3-LICENSE.txt file)+-}++-- | This module defines the 'ByteStringUTF8' newtype wrapper around 'ByteString', together with its 'TextualMonoid'+-- instance.+-- ++{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Data.Monoid.Instances.ByteString.UTF8 (+   ByteStringUTF8(..)+   )+where++import Prelude hiding (foldl, foldl1, foldr, foldr1, scanl, scanr, scanl1, scanr1, map, concatMap, break, span)++import Data.String (IsString(fromString))+import Data.ByteString (ByteString)+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.UTF8 as UTF8++import Data.Monoid (Monoid)+import Data.Monoid.Cancellative (LeftReductiveMonoid, LeftCancellativeMonoid, LeftGCDMonoid)+import Data.Monoid.Null (MonoidNull)+import Data.Monoid.Factorial (FactorialMonoid(..))+import Data.Monoid.Textual (TextualMonoid(..))++newtype ByteStringUTF8 = ByteStringUTF8 ByteString deriving (Eq, Show, Monoid, MonoidNull,+                                                             LeftReductiveMonoid, LeftCancellativeMonoid, LeftGCDMonoid)++instance IsString ByteStringUTF8 where+   fromString = ByteStringUTF8 . UTF8.fromString++instance FactorialMonoid ByteStringUTF8 where+   splitPrimePrefix (ByteStringUTF8 bs) = +      do (_, n) <- UTF8.decode bs+         let (bytes, rest) = ByteString.splitAt n bs+         return (ByteStringUTF8 bytes, ByteStringUTF8 rest)+   splitAt n (ByteStringUTF8 bs) = wrapPair (UTF8.splitAt n bs)+   take n (ByteStringUTF8 bs) = ByteStringUTF8 (UTF8.take n bs)+   drop n (ByteStringUTF8 bs) = ByteStringUTF8 (UTF8.drop n bs)+   length (ByteStringUTF8 bs) = UTF8.length bs++instance TextualMonoid ByteStringUTF8 where+   splitCharacterPrefix (ByteStringUTF8 bs) = do (c, rest) <- UTF8.uncons bs+                                                 if c == UTF8.replacement_char+                                                    then Nothing+                                                    else return (c, ByteStringUTF8 rest)+++wrapPair (bs1, bs2) = (ByteStringUTF8 bs1, ByteStringUTF8 bs2)
+ Data/Monoid/Null.hs view
@@ -0,0 +1,106 @@+{- +    Copyright 2011-2013 Mario Blazevic++    License: BSD3 (see BSD3-LICENSE.txt file)+-}++-- | This module defines the MonoidNull class and some of its instances.+-- ++{-# LANGUAGE Haskell2010 #-}++module Data.Monoid.Null (+   MonoidNull(..)+   )+where++import Prelude hiding (null)+   +import Data.Monoid (Monoid(mempty), First(..), Last(..), Dual(..), Sum(..), Product(..), All(getAll), Any(getAny))+import qualified Data.List as List+import Data.Ord (Ordering(EQ))+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Lazy as LazyByteString+import qualified Data.Text as Text+import qualified Data.Text.Lazy as LazyText+import qualified Data.IntMap as IntMap+import qualified Data.IntSet as IntSet+import qualified Data.Map as Map+import qualified Data.Sequence as Sequence+import qualified Data.Set as Set+import qualified Data.Vector as Vector++-- | Extension of 'Monoid' that allows testing a value for equality with 'mempty'. The following law must hold:+-- +-- prop> null x == (x == mempty)+class Monoid m => MonoidNull m where+   null :: m -> Bool++instance MonoidNull () where+   null () = True++instance MonoidNull Ordering where+   null = (== EQ)++instance MonoidNull All where+   null = getAll++instance MonoidNull Any where+   null = not . getAny++instance MonoidNull (First a) where+   null (First Nothing) = True+   null _ = False++instance MonoidNull (Last a) where+   null (Last Nothing) = True+   null _ = False++instance MonoidNull a => MonoidNull (Dual a) where+   null (Dual a) = null a++instance (Num a, Eq a) => MonoidNull (Sum a) where+   null (Sum a) = a == 0++instance (Num a, Eq a) => MonoidNull (Product a) where+   null (Product a) = a == 1++instance Monoid a => MonoidNull (Maybe a) where+   null Nothing = True+   null _ = False++instance (MonoidNull a, MonoidNull b) => MonoidNull (a, b) where+   null (a, b) = null a && null b++instance MonoidNull [x] where+   null = List.null++instance MonoidNull ByteString.ByteString where+   null = ByteString.null++instance MonoidNull LazyByteString.ByteString where+   null = LazyByteString.null++instance MonoidNull Text.Text where+   null = Text.null++instance MonoidNull LazyText.Text where+   null = LazyText.null++instance Ord k => MonoidNull (Map.Map k v) where+   null = Map.null++instance MonoidNull (IntMap.IntMap v) where+   null = IntMap.null++instance MonoidNull IntSet.IntSet where+   null = IntSet.null++instance MonoidNull (Sequence.Seq a) where+   null = Sequence.null++instance Ord a => MonoidNull (Set.Set a) where+   null = Set.null++instance MonoidNull (Vector.Vector a) where+   null = Vector.null
+ Data/Monoid/Textual.hs view
@@ -0,0 +1,281 @@+{- +    Copyright 2013 Mario Blazevic++    License: BSD3 (see BSD3-LICENSE.txt file)+-}++-- | This module defines the 'TextualMonoid' class and its most important instances for 'String' and 'Text'.+-- ++{-# LANGUAGE FlexibleInstances #-}++module Data.Monoid.Textual (+   TextualMonoid(..)+   )+where++import Prelude hiding (foldl, foldl1, foldr, foldr1, scanl, scanr, scanl1, scanr1, map, concatMap, break, span)++import Data.Maybe (fromJust)+import Data.Either (rights)+import qualified Data.List as List+import qualified Data.Text as Text+import qualified Data.Text.Lazy as LazyText+import Data.Text (Text)+import Data.Monoid (Monoid(mappend, mconcat, mempty))+import Data.String (IsString(fromString))++import Data.Monoid.Null (MonoidNull (null))+import Data.Monoid.Cancellative (LeftReductiveMonoid, LeftGCDMonoid)+import Data.Monoid.Factorial (FactorialMonoid)+import qualified Data.Monoid.Factorial as Factorial++-- | The 'TextualMonoid' class is an extension of 'FactorialMonoid' specialized for monoids that can contain+-- characters. Its methods are generally equivalent to their namesake functions from "Data.List" and "Data.Text", and+-- they satisfy the following laws:+-- +-- > splitCharacterPrefix (singleton c <> t) == Just (c, t)+-- > splitCharacterPrefix . primePrefix == fmap (\(c, t)-> (c, mempty)) . splitCharacterPrefix+-- >+-- > map f . fromString == fromString . List.map f+-- > concatMap (fromString . f) . fromString == fromString . List.concatMap f+-- >+-- > foldl  ft fc a . fromString == List.foldl  fc a+-- > foldr  ft fc a . fromString == List.foldr  fc a+-- > foldl' ft fc a . fromString == List.foldl' fc a+-- >+-- > scanl f c . fromString == fromString . List.scanl f c+-- > scanr f c . fromString == fromString . List.scanr f c+-- > mapAccumL f a . fromString == fmap fromString . List.mapAccumL f a+-- > mapAccumL f a . fromString == fmap fromString . List.mapAccumL f a+-- >+-- > takeWhile pt pc . fromString == fromString . takeWhile pc+-- > dropWhile pt pc . fromString == fromString . dropWhile pc+-- >+-- > mconcat . intersperse (singleton c) . split (== c) == id+-- > find p . fromString == List.find p+--+-- A 'TextualMonoid' may contain non-character data insterspersed between its characters. Every class method that+-- returns a modified 'TextualMonoid' instance generally preserves this non-character data. All of the following+-- expressions are identities:+--+-- > map id+-- > concatMap singleton+-- > foldl  (<>) (\a c-> a <> singleton c) mempty+-- > foldr  (<>) ((<>) . singleton) mempty+-- > foldl' (<>) (\a c-> a <> singleton c) mempty+-- > scanl1 (const id)+-- > scanr1 const+-- > uncurry (mapAccumL (,))+-- > uncurry (mapAccumR (,))+-- > takeWhile (const True) (const True)+-- > dropWhile (const False) (const False)+--+-- A minimal instance definition must implement 'splitCharacterPrefix'.++class (IsString t, LeftReductiveMonoid t, LeftGCDMonoid t, FactorialMonoid t) => TextualMonoid t where+   -- | Contructs a new data type instance Like 'fromString', but from a 'Text' input instead of 'String'.+   --+   -- > fromText == fromString . Text.unpack+   fromText :: Text -> t+   -- | Creates a prime monoid containing a single character.+   --+   -- > singleton c == fromString [c]+   singleton :: Char -> t+   -- | Specialized version of 'Factorial.splitPrimePrefix'. Every prime factor of a 'Textual' monoid must consist of a+   -- single character or no character at all.+   splitCharacterPrefix :: t -> Maybe (Char, t)+   -- | Extracts a single character that prefixes the monoid, if the monoid begins with a character. Otherwise returns+   -- 'Nothing'.+   --+   -- > characterPrefix == fmap fst . splitCharacterPrefix+   characterPrefix :: t -> Maybe Char+   -- | Equivalent to 'List.map' from "Data.List" with a @Char -> Char@ function. Preserves all non-character data.+   --+   -- > map f == concatMap (singleton . f)+   map :: (Char -> Char) -> t -> t+   -- | Equivalent to 'List.concatMap' from "Data.List" with a @Char -> String@ function. Preserves all non-character+   -- data.+   concatMap :: (Char -> t) -> t -> t+   -- | Equivalent to 'List.any' from "Data.List". Ignores all non-character data.+   any :: (Char -> Bool) -> t -> Bool+   -- | Equivalent to 'List.all' from "Data.List". Ignores all non-character data.+   all :: (Char -> Bool) -> t -> Bool++   -- | The first argument folds over the non-character prime factors, the second over characters. Otherwise equivalent+   -- to 'List.foldl' from "Data.List".+   foldl   :: (a -> t -> a) -> (a -> Char -> a) -> a -> t -> a+   -- | Strict version of 'foldl'.+   foldl'  :: (a -> t -> a) -> (a -> Char -> a) -> a -> t -> a+   -- | The first argument folds over the non-character prime factors, the second over characters. Otherwise equivalent+   -- to 'List.foldr' from "Data.List".+   foldr   :: (t -> a -> a) -> (Char -> a -> a) -> a -> t -> a++   -- | Equivalent to 'List.scanl' from "Data.List" when applied to a 'String', but preserves all non-character data.+   scanl :: (Char -> Char -> Char) -> Char -> t -> t+   -- | Equivalent to 'List.scanl1' from "Data.List" when applied to a 'String', but preserves all non-character data.+   --+   -- > scanl f c == scanl1 f . (singleton c <>)+   scanl1 :: (Char -> Char -> Char) -> t -> t+   -- | Equivalent to 'List.scanr' from "Data.List" when applied to a 'String', but preserves all non-character data.+   scanr :: (Char -> Char -> Char) -> Char -> t -> t+   -- | Equivalent to 'List.scanr1' from "Data.List" when applied to a 'String', but preserves all non-character data.+   --+   -- > scanr f c == scanr1 f . (<> singleton c)+   scanr1 :: (Char -> Char -> Char) -> t -> t+   -- | Equivalent to 'List.mapAccumL' from "Data.List" when applied to a 'String', but preserves all non-character+   -- data.+   mapAccumL :: (a -> Char -> (a, Char)) -> a -> t -> (a, t)+   -- | Equivalent to 'List.mapAccumR' from "Data.List" when applied to a 'String', but preserves all non-character+   -- data.+   mapAccumR :: (a -> Char -> (a, Char)) -> a -> t -> (a, t)++   -- | The first predicate tests the non-character data, the second one the characters. Otherwise equivalent to+   -- 'List.takeWhile' from "Data.List" when applied to a 'String'.+   takeWhile :: (t -> Bool) -> (Char -> Bool) -> t -> t+   -- | The first predicate tests the non-character data, the second one the characters. Otherwise equivalent to+   -- 'List.dropWhile' from "Data.List" when applied to a 'String'.+   dropWhile :: (t -> Bool) -> (Char -> Bool) -> t -> t+   -- | 'break pt pc' is equivalent to |span (not . pt) (not . pc)|.+   break :: (t -> Bool) -> (Char -> Bool) -> t -> (t, t)+   -- | 'span pt pc t' is equivalent to |(takeWhile pt pc t, dropWhile pt pc t)|.+   span :: (t -> Bool) -> (Char -> Bool) -> t -> (t, t)+   -- | Splits the monoid into components delimited by character separators satisfying the given predicate. The+   -- characters satisfying the predicate are not a part of the result.+   --+   -- > split p == Factorial.split (maybe False p . characterPrefix)+   split :: (Char -> Bool) -> t -> [t]+   -- | Like 'List.find' from "Data.List" when applied to a 'String'. Ignores non-character data.+   find :: (Char -> Bool) -> t -> Maybe Char++   fromText = fromString . Text.unpack+   singleton = fromString . (:[])++   characterPrefix = fmap fst . splitCharacterPrefix++   map f = concatMap (singleton . f)+   concatMap f = foldr mappend (mappend . f) mempty+   all p = foldr (const id) ((&&) . p) True+   any p = foldr (const id) ((||) . p) False++   foldl ft fc = Factorial.foldl (\a prime-> maybe (ft a prime) (fc a) (characterPrefix prime))+   foldr ft fc = Factorial.foldr (\prime-> maybe (ft prime) fc (characterPrefix prime))+   foldl' ft fc = Factorial.foldl' (\a prime-> maybe (ft a prime) (fc a) (characterPrefix prime))++   scanl f c = mappend (singleton c) . fst . foldl foldlOther (foldlChars f) (mempty, c)+   scanl1 f t = case (Factorial.splitPrimePrefix t, splitCharacterPrefix t)+                of (Nothing, _) -> t+                   (Just (prefix, suffix), Nothing) -> mappend prefix (scanl1 f suffix)+                   (Just _, Just (c, suffix)) -> scanl f c suffix+   scanr f c = fst . foldr foldrOther (foldrChars f) (singleton c, c)+   scanr1 f = fst . foldr foldrOther fc (mempty, Nothing)+      where fc c (t, Nothing) = (mappend (singleton c) t, Just c)+            fc c1 (t, Just c2) = (mappend (singleton c') t, Just c')+               where c' = f c1 c2+   mapAccumL f a0 = foldl ft fc (a0, mempty)+      where ft (a, t1) t2 = (a, mappend t1 t2)+            fc (a, t) c = (a', mappend t (singleton c'))+               where (a', c') = f a c+   mapAccumR f a0 = foldr ft fc (a0, mempty)+      where ft t1 (a, t2) = (a, mappend t1 t2)+            fc c (a, t) = (a', mappend (singleton c') t)+               where (a', c') = f a c++   takeWhile pt pc = fst . span pt pc+   dropWhile pt pc = snd . span pt pc+   span pt pc = Factorial.span (\prime-> maybe (pt prime) pc (characterPrefix prime))+   break pt pc = Factorial.break (\prime-> maybe (pt prime) pc (characterPrefix prime))+   split f = Factorial.split (maybe False f . characterPrefix)+   find f = foldr (const id) (\c r-> if f c then Just c else r) Nothing++foldlChars f (t, c1) c2 = (mappend t (singleton c'), c')+   where c' = f c1 c2+foldlOther (t1, c) t2 = (mappend t1 t2, c)+foldrChars f c1 (t, c2) = (mappend (singleton c') t, c')+   where c' = f c1 c2+foldrOther t1 (t2, c) = (mappend t1 t2, c)++instance TextualMonoid String where+   fromText = Text.unpack+   singleton c = [c]+   splitCharacterPrefix (c:rest) = Just (c, rest)+   splitCharacterPrefix [] = Nothing+   characterPrefix (c:_) = Just c+   characterPrefix [] = Nothing+   map = List.map+   concatMap = List.concatMap+   any = List.any+   all = List.all++   foldl   = const List.foldl+   foldl'  = const List.foldl'+   foldr   = const List.foldr++   scanl = List.scanl+   scanl1 = List.scanl1+   scanr = List.scanr+   scanr1 = List.scanr1 +   mapAccumL = List.mapAccumL+   mapAccumR = List.mapAccumR++   takeWhile _ = List.takeWhile+   dropWhile _ = List.dropWhile+   break _ = List.break+   span _ = List.span+   find = List.find++instance TextualMonoid Text where+   fromText = id+   singleton = Text.singleton+   splitCharacterPrefix = Text.uncons+   characterPrefix t = if Text.null t then Nothing else Just (Text.head t)+   map = Text.map+   concatMap = Text.concatMap+   any = Text.any+   all = Text.all++   foldl   = const Text.foldl+   foldl'  = const Text.foldl'+   foldr   = const Text.foldr++   scanl = Text.scanl+   scanl1 = Text.scanl1+   scanr = Text.scanr+   scanr1 = Text.scanr1 +   mapAccumL = Text.mapAccumL+   mapAccumR = Text.mapAccumR++   takeWhile _ = Text.takeWhile+   dropWhile _ = Text.dropWhile+   break _ = Text.break+   span _ = Text.span+   split = Text.split+   find = Text.find++instance TextualMonoid LazyText.Text where+   fromText = LazyText.fromStrict+   singleton = LazyText.singleton+   splitCharacterPrefix = LazyText.uncons+   characterPrefix t = if LazyText.null t then Nothing else Just (LazyText.head t)+   map = LazyText.map+   concatMap = LazyText.concatMap+   any = LazyText.any+   all = LazyText.all++   foldl   = const LazyText.foldl+   foldl'  = const LazyText.foldl'+   foldr   = const LazyText.foldr++   scanl = LazyText.scanl+   scanl1 = LazyText.scanl1+   scanr = LazyText.scanr+   scanr1 = LazyText.scanr1+   mapAccumL = LazyText.mapAccumL+   mapAccumR = LazyText.mapAccumR++   takeWhile _ = LazyText.takeWhile+   dropWhile _ = LazyText.dropWhile+   break _ = LazyText.break+   span _ = LazyText.span+   split = LazyText.split+   find = LazyText.find
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell+ +> import Distribution.Simple+> main = defaultMain
+ Test/TestMonoidSubclasses.hs view
@@ -0,0 +1,612 @@+{- +    Copyright 2013 Mario Blazevic++    License: BSD3 (see BSD3-LICENSE.txt file)+-}++{-# LANGUAGE Rank2Types, ScopedTypeVariables, FlexibleInstances, GeneralizedNewtypeDeriving #-}++module Main where++import Prelude hiding (foldl, foldr, gcd, length, null, reverse, span, splitAt, takeWhile)++import Test.QuickCheck (Arbitrary, CoArbitrary, Property, Gen,+                        quickCheck, arbitrary, coarbitrary, property, label, forAll, variant, whenFail, (.&&.))+import Test.QuickCheck.Instances ()++import Data.Int (Int8, Int32)+import Data.Foldable (toList)+import Data.List (intersperse, unfoldr)+import qualified Data.List as List+import Data.Maybe (isJust)+import Data.Either (lefts, rights)+import Data.Tuple (swap)+import Data.String (IsString, fromString)+import Data.Char (isLetter)++import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as Lazy (ByteString)+import Data.Text (Text)+import qualified Data.Text.Lazy as Lazy (Text)+import qualified Data.Text as Text+import Data.IntMap (IntMap)+import Data.IntSet (IntSet)+import Data.Map (Map)+import Data.Sequence (Seq)+import Data.Set (Set)+import Data.Vector (Vector, fromList)++import Data.Monoid.Instances.ByteString.UTF8 (ByteStringUTF8(ByteStringUTF8))++import Data.Monoid (Monoid, mempty, (<>), mconcat, All(All), Any(Any), Dual(Dual),+                    First(First), Last(Last), Sum(Sum), Product(Product))+import Data.Monoid.Null (MonoidNull, null)+import Data.Monoid.Factorial (FactorialMonoid, factors, splitPrimePrefix, splitPrimeSuffix, primePrefix, primeSuffix,+                              foldl, foldl', foldr, length, reverse, span, split, splitAt)+import Data.Monoid.Cancellative (ReductiveMonoid, LeftReductiveMonoid, RightReductiveMonoid,+                                 CancellativeMonoid, LeftCancellativeMonoid, RightCancellativeMonoid,+                                 GCDMonoid, LeftGCDMonoid, RightGCDMonoid,+                                 (</>), gcd,+                                 isPrefixOf, stripPrefix, commonPrefix, stripCommonPrefix,+                                 isSuffixOf, stripSuffix, commonSuffix, stripCommonSuffix)+import Data.Monoid.Textual (TextualMonoid)+import qualified Data.Monoid.Textual as Textual++data Test = NullTest (forall a. (Arbitrary a, Show a, Eq a, MonoidNull a) => a -> Property)+          | FactorialTest (forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property)+          | TextualTest (forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property)+          | LeftReductiveTest (forall a. (Arbitrary a, Show a, Eq a, LeftReductiveMonoid a) => a -> Property)+          | RightReductiveTest (forall a. (Arbitrary a, Show a, Eq a, RightReductiveMonoid a) => a -> Property)+          | ReductiveTest (forall a. (Arbitrary a, Show a, Eq a, ReductiveMonoid a) => a -> Property)+          | LeftCancellativeTest (forall a. (Arbitrary a, Show a, Eq a, LeftCancellativeMonoid a) => a -> Property)+          | RightCancellativeTest (forall a. (Arbitrary a, Show a, Eq a, RightCancellativeMonoid a) => a -> Property)+          | CancellativeTest (forall a. (Arbitrary a, Show a, Eq a, CancellativeMonoid a) => a -> Property)+          | LeftGCDTest (forall a. (Arbitrary a, Show a, Eq a, LeftGCDMonoid a) => a -> Property)+          | RightGCDTest (forall a. (Arbitrary a, Show a, Eq a, RightGCDMonoid a) => a -> Property)+          | GCDTest (forall a. (Arbitrary a, Show a, Eq a, GCDMonoid a) => a -> Property)+          | CancellativeGCDTest (forall a. (Arbitrary a, Show a, Eq a, CancellativeMonoid a, GCDMonoid a) +                                 => a -> Property)++main = mapM_ (quickCheck . uncurry checkInstances) tests++checkInstances :: String -> Test -> Property+checkInstances name (NullTest checkType) = label name (checkType ()+                                                       .&&. checkType (mempty :: Ordering)+                                                       .&&. checkType (mempty :: All)+                                                       .&&. checkType (mempty :: Any)+                                                       .&&. checkType (mempty :: String)+                                                       .&&. checkType (mempty :: ByteString)+                                                       .&&. checkType (mempty :: Lazy.ByteString)+                                                       .&&. checkType (mempty :: Text)+                                                       .&&. checkType (mempty :: Lazy.Text)+                                                       .&&. checkType (mempty :: Dual String)+                                                       .&&. checkType (mempty :: Sum Float)+                                                       .&&. checkType (mempty :: Product Int)+                                                       .&&. checkType (mempty :: First Int)+                                                       .&&. checkType (mempty :: Last Int)+                                                       .&&. checkType (mempty :: Maybe String)+                                                       .&&. checkType (mempty :: (Text, String))+                                                       .&&. checkType (mempty :: IntMap Int)+                                                       .&&. checkType (mempty :: IntSet)+                                                       .&&. checkType (mempty :: Map String Int)+                                                       .&&. checkType (mempty :: Seq Int)+                                                       .&&. checkType (mempty :: Set String)+                                                       .&&. checkType (mempty :: Vector Int))+checkInstances name (FactorialTest checkType) = label name (checkType (mempty :: TestString)+                                                            .&&. checkType (mempty :: String)+                                                            .&&. checkType (mempty :: ByteString)+                                                            .&&. checkType (mempty :: Lazy.ByteString)+                                                            .&&. checkType (mempty :: ByteStringUTF8)+                                                            .&&. checkType (mempty :: Text)+                                                            .&&. checkType (mempty :: Lazy.Text)+                                                            .&&. checkType (mempty :: Dual String)+                                                            .&&. checkType (mempty :: Sum Int8)+                                                            .&&. checkType (mempty :: Product Int32)+                                                            .&&. checkType (mempty :: Maybe String)+                                                            .&&. checkType (mempty :: (Text, String))+                                                            .&&. checkType (mempty :: IntMap Int)+                                                            .&&. checkType (mempty :: IntSet)+                                                            .&&. checkType (mempty :: Map String Int)+                                                            .&&. checkType (mempty :: Seq Int)+                                                            .&&. checkType (mempty :: Set String)+                                                            .&&. checkType (mempty :: Vector Int))+checkInstances name (TextualTest checkType) = label name (checkType (mempty :: TestString)+                                                          .&&. checkType (mempty :: String)+                                                          .&&. checkType (mempty :: ByteStringUTF8)+                                                          .&&. checkType (mempty :: Text)+                                                          .&&. checkType (mempty :: Lazy.Text))+checkInstances name (LeftReductiveTest checkType) = label name (checkType (mempty :: String)+                                                                .&&. checkType (mempty :: ByteString)+                                                                .&&. checkType (mempty :: Lazy.ByteString)+                                                                .&&. checkType (mempty :: Text)+                                                                .&&. checkType (mempty :: Lazy.Text)+                                                                .&&. checkType (mempty :: Dual Text)+                                                                .&&. checkType (mempty :: Sum Integer)+                                                                .&&. checkType (mempty :: Product Integer)+                                                                .&&. checkType (mempty :: (Text, String))+                                                                .&&. checkType (mempty :: IntSet)+                                                                .&&. checkType (mempty :: Seq String)+                                                                .&&. checkType (mempty :: Set Integer)+                                                                .&&. checkType (mempty :: Vector Int))+checkInstances name (RightReductiveTest checkType) = label name (checkType (mempty :: ByteString)+                                                                 .&&. checkType (mempty :: Lazy.ByteString)+                                                                 .&&. checkType (mempty :: Text)+                                                                 .&&. checkType (mempty :: Lazy.Text)+                                                                 .&&. checkType (mempty :: Dual String)+                                                                 .&&. checkType (mempty :: Sum Integer)+                                                                 .&&. checkType (mempty :: Product Integer)+                                                                 .&&. checkType (mempty :: (Text, ByteString))+                                                                 .&&. checkType (mempty :: IntSet)+                                                                 .&&. checkType (mempty :: Seq Int)+                                                                 .&&. checkType (mempty :: Set String)+                                                                 .&&. checkType (mempty :: Vector Int))+checkInstances name (ReductiveTest checkType) = label name (checkType (mempty :: Sum Integer)+                                                            .&&. checkType (mempty :: Product Integer)+                                                            .&&. checkType (mempty :: Dual (Sum Integer))+                                                            .&&. checkType (mempty :: (Sum Integer, Sum Int))+                                                            .&&. checkType (mempty :: IntSet)+                                                            .&&. checkType (mempty :: Set Integer))+checkInstances name (LeftCancellativeTest checkType) = label name (checkType (mempty :: String)+                                                                   .&&. checkType (mempty :: ByteString)+                                                                   .&&. checkType (mempty :: Lazy.ByteString)+                                                                   .&&. checkType (mempty :: Text)+                                                                   .&&. checkType (mempty :: Lazy.Text)+                                                                   .&&. checkType (mempty :: Dual Text)+                                                                   .&&. checkType (mempty :: Sum Integer)+                                                                   .&&. checkType (mempty :: (Text, String))+                                                                   .&&. checkType (mempty :: Seq Int)+                                                                   .&&. checkType (mempty :: Vector Int))+checkInstances name (RightCancellativeTest checkType) = label name (checkType (mempty :: ByteString)+                                                                    .&&. checkType (mempty :: Lazy.ByteString)+                                                                    .&&. checkType (mempty :: Text)+                                                                    .&&. checkType (mempty :: Lazy.Text)+                                                                    .&&. checkType (mempty :: Dual String)+                                                                    .&&. checkType (mempty :: Sum Integer)+                                                                    .&&. checkType (mempty :: (Text, ByteString))+                                                                    .&&. checkType (mempty :: Seq Int)+                                                                    .&&. checkType (mempty :: Vector Int))+checkInstances name (CancellativeTest checkType) = label name (checkType (mempty :: Sum Integer)+                                                               .&&. checkType (mempty :: Dual (Sum Integer))+                                                               .&&. checkType (mempty :: (Sum Integer, Sum Int)))+checkInstances name (LeftGCDTest checkType) = label name (checkType (mempty :: String)+                                                          .&&. checkType (mempty :: ByteString)+                                                          .&&. checkType (mempty :: Lazy.ByteString)+                                                          .&&. checkType (mempty :: Text)+                                                          .&&. checkType (mempty :: Lazy.Text)+                                                          .&&. checkType (mempty :: Dual ByteString)+                                                          .&&. checkType (mempty :: Sum Integer)+                                                          .&&. checkType (mempty :: Product Integer)+                                                          .&&. checkType (mempty :: (Text, String))+                                                          .&&. checkType (mempty :: IntMap Int)+                                                          .&&. checkType (mempty :: IntSet)+                                                          .&&. checkType (mempty :: Map String Int)+                                                          .&&. checkType (mempty :: Seq Int)+                                                          .&&. checkType (mempty :: Set String)+                                                          .&&. checkType (mempty :: Vector Int))+checkInstances name (RightGCDTest checkType) = label name (checkType (mempty :: ByteString)+                                                           .&&. checkType (mempty :: Lazy.ByteString)+                                                           .&&. checkType (mempty :: Dual String)+                                                           .&&. checkType (mempty :: Sum Integer)+                                                           .&&. checkType (mempty :: Product Integer)+                                                           .&&. checkType (mempty :: (Seq Int, ByteString))+                                                           .&&. checkType (mempty :: IntSet)+                                                           .&&. checkType (mempty :: Seq Int)+                                                           .&&. checkType (mempty :: Set String)+                                                           .&&. checkType (mempty :: Vector Int))+checkInstances name (GCDTest checkType) = label name (checkType (mempty :: Sum Integer)+                                                      .&&. checkType (mempty :: Product Integer)+                                                      .&&. checkType (mempty :: Dual (Product Integer))+                                                      .&&. checkType (mempty :: (Sum Integer, Sum Int))+                                                      .&&. checkType (mempty :: IntSet)+                                                      .&&. checkType (mempty :: Set String))+checkInstances name (CancellativeGCDTest checkType) = label name (checkType (mempty :: Sum Integer)+                                                                  .&&. checkType (mempty :: Dual (Sum Integer))+                                                                  .&&. checkType (mempty :: (Sum Integer, Sum Int)))++tests :: [(String, Test)]+tests = [("MonoidNull", NullTest checkNull),+         ("mconcat . factors == id", FactorialTest checkConcatFactors),+         ("all factors . factors", FactorialTest checkFactorsOfFactors),+         ("splitPrimePrefix", FactorialTest checkSplitPrimePrefix),+         ("splitPrimeSuffix", FactorialTest checkSplitPrimeSuffix),+         ("primePrefix", FactorialTest checkPrimePrefix),+         ("primeSuffix", FactorialTest checkPrimeSuffix),+         ("foldl", FactorialTest checkLeftFold),+         ("foldl'", FactorialTest checkLeftFold'),+         ("foldr", FactorialTest checkRightFold),+         ("length", FactorialTest checkLength),+         ("span", FactorialTest checkSpan),+         ("split", FactorialTest checkSplit),+         ("splitAt", FactorialTest checkSplitAt),+         ("reverse", FactorialTest checkReverse),+         ("fromText", TextualTest checkFromText),+         ("singleton", TextualTest checkSingleton),+         ("Textual.splitCharacterPrefix", TextualTest checkSplitCharacterPrefix),+         ("Textual.characterPrefix", TextualTest checkCharacterPrefix),+         ("Textual factors", TextualTest checkTextualFactors),+         ("Textual.unfoldr", TextualTest checkUnfoldrToFactors),+         ("factors . fromString", TextualTest checkFactorsFromString),+         ("Textual.map", TextualTest checkTextualMap),+         ("Textual.concatMap", TextualTest checkConcatMap),+         ("Textual.any", TextualTest checkAny),+         ("Textual.all", TextualTest checkAll),+         ("Textual.foldl", TextualTest checkTextualFoldl),+         ("Textual.foldr", TextualTest checkTextualFoldr),+         ("Textual.foldl'", TextualTest checkTextualFoldl'),+         ("Textual.scanl", TextualTest checkTextualScanl),+         ("Textual.scanr", TextualTest checkTextualScanr),+         ("Textual.scanl1", TextualTest checkTextualScanl1),+         ("Textual.scanr1", TextualTest checkTextualScanr1),+         ("Textual.mapAccumL", TextualTest checkTextualMapAccumL),+         ("Textual.mapAccumR", TextualTest checkTextualMapAccumR),+         ("Textual.mapAccumR", TextualTest checkTextualMapAccumR),+         ("Textual.takeWhile", TextualTest checkTextualTakeWhile),+         ("Textual.dropWhile", TextualTest checkTextualDropWhile),+         ("Textual.span", TextualTest checkTextualSpan),+         ("Textual.break", TextualTest checkTextualBreak),+         ("Textual.split", TextualTest checkTextualSplit),+         ("Textual.find", TextualTest checkTextualFind),+         ("stripPrefix", LeftReductiveTest checkStripPrefix),+         ("isPrefixOf", LeftReductiveTest checkIsPrefixOf),+         ("stripSuffix", RightReductiveTest checkStripSuffix),+         ("isSuffixOf", RightReductiveTest checkIsSuffixOf),+         ("</>", ReductiveTest checkUnAppend),+         ("cancellative stripPrefix", LeftCancellativeTest checkStripPrefix'),+         ("cancellative stripSuffix", RightCancellativeTest checkStripSuffix'),+         ("cancellative </>", CancellativeTest checkUnAppend'),+         ("stripCommonPrefix 1", LeftGCDTest checkStripCommonPrefix1),+         ("stripCommonPrefix 2", LeftGCDTest checkStripCommonPrefix2),+         ("stripCommonSuffix 1", RightGCDTest checkStripCommonSuffix1),+         ("stripCommonSuffix 2", RightGCDTest checkStripCommonSuffix2),+         ("gcd", GCDTest checkGCD),+         ("cancellative gcd", CancellativeGCDTest checkCancellativeGCD)+        ]++checkNull :: forall a. (Arbitrary a, Show a, Eq a, MonoidNull a) => a -> Property+checkNull e = null e .&&. forAll (arbitrary :: Gen a) (\a-> null a == (a == mempty))++checkConcatFactors :: forall a. (Arbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property+checkConcatFactors e = null (factors e) .&&. forAll (arbitrary :: Gen a) check+   where check a = mconcat (factors a) == a++checkFactorsOfFactors :: forall a. (Arbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property+checkFactorsOfFactors _ = forAll (arbitrary :: Gen a) (all singleton . factors)+   where singleton prime = factors prime == [prime]++checkSplitPrimePrefix :: forall a. (Arbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property+checkSplitPrimePrefix _ = forAll (arbitrary :: Gen a) (\a-> factors a == unfoldr splitPrimePrefix a)++checkSplitPrimeSuffix :: forall a. (Arbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property+checkSplitPrimeSuffix _ = forAll (arbitrary :: Gen a) check+   where check a = factors a == reverse (unfoldr (fmap swap . splitPrimeSuffix) a)++checkPrimePrefix :: forall a. (Arbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property+checkPrimePrefix _ = forAll (arbitrary :: Gen a) (\a-> primePrefix a == maybe mempty fst (splitPrimePrefix a))++checkPrimeSuffix :: forall a. (Arbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property+checkPrimeSuffix _ = forAll (arbitrary :: Gen a) (\a-> primeSuffix a == maybe mempty snd (splitPrimeSuffix a))++checkLeftFold :: forall a. (Arbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property+checkLeftFold _ = forAll (arbitrary :: Gen a) (\a-> foldl (flip (:)) [] a == List.foldl (flip (:)) [] (factors a))++checkLeftFold' :: forall a. (Arbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property+checkLeftFold' _ = forAll (arbitrary :: Gen a) (\a-> foldl' (flip (:)) [] a == List.foldl' (flip (:)) [] (factors a))++checkRightFold :: forall a. (Arbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property+checkRightFold _ = forAll (arbitrary :: Gen a) (\a-> foldr (:) [] a == List.foldr (:) [] (factors a))++checkLength :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property+checkLength _ = forAll (arbitrary :: Gen a) (\a-> length a == List.length (factors a))++checkSpan :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property+checkSpan _ = property $ \p-> forAll (arbitrary :: Gen a) (check p)+   where check p a = span p a == (mconcat l, mconcat r)+            where (l, r) = List.span p (factors a)++checkSplit :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property+checkSplit _ = forAll (arbitrary :: Gen a) check+   where check a = property (\pred-> all (all (not . pred) . factors) (split pred a))+                   .&&. property (\prime-> mconcat (intersperse prime $ split (== prime) a) == a)++checkSplitAt :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property+checkSplitAt _ = property $ \i-> forAll (arbitrary :: Gen a) (check i)+   where check i a = splitAt i a == (mconcat l, mconcat r)+            where (l, r) = List.splitAt i (factors a)++checkReverse :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property+checkReverse _ = property $ forAll (arbitrary :: Gen a) (\a-> reverse a == mconcat (List.reverse $ factors a))++checkFromText :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkFromText _ = forAll (arbitrary :: Gen Text) (\t-> Textual.fromText t == (fromString (Text.unpack t) :: a))++checkSingleton :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkSingleton _ = forAll (arbitrary :: Gen Char) (\c-> Textual.singleton c == (fromString [c] :: a))++checkSplitCharacterPrefix :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkSplitCharacterPrefix _ = forAll (arbitrary :: Gen (Char, a)) check+   where check p@(c, t) = Textual.splitCharacterPrefix (Textual.singleton c <> t) == Just p+                          && Textual.splitCharacterPrefix (primePrefix t)+                             == fmap (\(c, t)-> (c, mempty)) (Textual.splitCharacterPrefix t)++checkCharacterPrefix :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkCharacterPrefix _ = forAll (arbitrary :: Gen a) check+   where check t = Textual.characterPrefix t == fmap fst (Textual.splitCharacterPrefix t)++checkTextualFactors :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkTextualFactors _ = forAll (arbitrary :: Gen a) check+   where check a = all (maybe True (null . snd) . Textual.splitCharacterPrefix) (factors a)++checkUnfoldrToFactors :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkUnfoldrToFactors _ = forAll (arbitrary :: Gen a) check+   where check a = factors a == unfoldr splitPrimePrefix a++checkFactorsFromString :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkFactorsFromString _ = forAll (arbitrary :: Gen String) check+   where check s = unfoldr Textual.splitCharacterPrefix (fromString s :: a) == s++checkTextualMap :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkTextualMap _ = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2+   where check1 a = Textual.map succ a == Textual.concatMap (Textual.singleton . succ) a+                    && Textual.map id a == a+         check2 s = Textual.map succ (fromString s :: a) == fromString (List.map succ s)++checkConcatMap :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkConcatMap _ = 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+         check2 s = Textual.concatMap (fromString . f) (fromString s :: a) == fromString (List.concatMap f s)+         f = replicate 3+         apply prime = maybe prime (fromString . f) (Textual.characterPrefix prime)++checkAll :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkAll _ = forAll (arbitrary :: Gen a) check+   where check a = Textual.all isLetter a == Textual.foldr (const id) ((&&) . isLetter) True a++checkAny :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkAny _ = forAll (arbitrary :: Gen a) check+   where check a = Textual.any isLetter a == Textual.foldr (const id) ((||) . isLetter) False a++checkTextualFoldl :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkTextualFoldl _ = 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 :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkTextualFoldr _ = 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 (:) [] s == s++checkTextualFoldl' :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkTextualFoldl' _ = 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++checkTextualScanl :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkTextualScanl _ = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2+   where check1 a = (rights . textualFactors . Textual.scanl f 'Z') a == (List.scanl f 'Z' . rights . textualFactors) a+                    && (lefts . textualFactors . Textual.scanl f 'Y') a == (lefts . textualFactors) a+                    && Textual.scanl f 'W' a == Textual.scanl1 f (Textual.singleton 'W' <> a)+         check2 s = Textual.scanl f 'X' (fromString s :: a) == fromString (List.scanl f 'X' s)+         f c1 c2 = succ (max c1 c2)++checkTextualScanr :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkTextualScanr _ = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2+   where check1 a = (rights . textualFactors . Textual.scanr f 'Z') a == (List.scanr f 'Z' . rights . textualFactors) a+                    && (lefts . textualFactors . Textual.scanr f 'Y') a == (lefts . textualFactors) a+                    && Textual.scanr f 'W' a == Textual.scanr1 f (a <> Textual.singleton 'W')+         check2 s = Textual.scanr f 'X' (fromString s :: a) == fromString (List.scanr f 'X' s)+         f c1 c2 = succ (max c1 c2)++checkTextualScanl1 :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkTextualScanl1 _ = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2+   where check1 a = Textual.scanl1 (const id) a == a+         check2 s = Textual.scanl1 f (fromString s :: a) == fromString (List.scanl1 f s)+         f c1 c2 = succ (max c1 c2)++checkTextualScanr1 :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkTextualScanr1 _ = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2+   where check1 a = Textual.scanr1 const a == a+         check2 s = Textual.scanr1 f (fromString s :: a) == fromString (List.scanr1 f s)+         f c1 c2 = succ (max c1 c2)++checkTextualMapAccumL :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkTextualMapAccumL _ = 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 :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkTextualMapAccumR _ = 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 :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkTextualTakeWhile _ = 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 :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkTextualDropWhile _ = 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)+                    && Textual.dropWhile (const False) (const False) a == a+         check2 s = Textual.dropWhile undefined isLetter (fromString s :: a)+                    == fromString (List.dropWhile isLetter s)++checkTextualSpan :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkTextualSpan _ = forAll (arbitrary :: Gen a) check+   where check a = Textual.span pt pc a == (Textual.takeWhile pt pc a, Textual.dropWhile pt pc a)+            where pt = (== primePrefix a)+         pc = isLetter++checkTextualBreak :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkTextualBreak _ = forAll (arbitrary :: Gen a) check+   where check a = Textual.break pt pc a == Textual.span (not . pt) (not . pc) a+            where pt = (/= primePrefix a)+         pc = isLetter++checkTextualSplit :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkTextualSplit _ = forAll (arbitrary :: Gen a) check+   where check a = List.all (List.all isLetter . rights . textualFactors) (Textual.split (not . isLetter) a)+                   && (mconcat . intersperse (fromString " ") . Textual.split (== ' ')) a == a++checkTextualFind :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property+checkTextualFind _ = 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++checkStripPrefix :: forall a. (Arbitrary a, Show a, Eq a, LeftReductiveMonoid a) => a -> Property+checkStripPrefix _ = forAll (arbitrary :: Gen (a, a)) check+   where check (a, b) = maybe b (a <>) (stripPrefix a b) == b++checkIsPrefixOf :: forall a. (Arbitrary a, Show a, Eq a, LeftReductiveMonoid a) => a -> Property+checkIsPrefixOf _ = forAll (arbitrary :: Gen (a, a)) check+   where check (a, b) = isPrefixOf a b == isJust (stripPrefix a b)+                        && a `isPrefixOf` (a <> b)++checkStripSuffix :: forall a. (Arbitrary a, Show a, Eq a, RightReductiveMonoid a) => a -> Property+checkStripSuffix _ = forAll (arbitrary :: Gen (a, a)) check+   where check (a, b) = maybe b (<> a) (stripSuffix a b) == b++checkIsSuffixOf :: forall a. (Arbitrary a, Show a, Eq a, RightReductiveMonoid a) => a -> Property+checkIsSuffixOf _ = forAll (arbitrary :: Gen (a, a)) check+   where check (a, b) = isSuffixOf a b == isJust (stripSuffix a b)+                        && b `isSuffixOf` (a <> b)++checkUnAppend :: forall a. (Arbitrary a, Show a, Eq a, ReductiveMonoid a) => a -> Property+checkUnAppend _ = forAll (arbitrary :: Gen (a, a)) check+   where check (a, b) = maybe a (b <>) (a </> b) == a+                        && maybe a (<> b) (a </> b) == a++checkStripPrefix' :: forall a. (Arbitrary a, Show a, Eq a, LeftCancellativeMonoid a) => a -> Property+checkStripPrefix' _ = forAll (arbitrary :: Gen (a, a)) check+   where check (a, b) = stripPrefix a (a <> b) == Just b++checkStripSuffix' :: forall a. (Arbitrary a, Show a, Eq a, RightCancellativeMonoid a) => a -> Property+checkStripSuffix' _ = forAll (arbitrary :: Gen (a, a)) check+   where check (a, b) = stripSuffix b (a <> b) == Just a++checkUnAppend' :: forall a. (Arbitrary a, Show a, Eq a, CancellativeMonoid a) => a -> Property+checkUnAppend' _ = forAll (arbitrary :: Gen (a, a)) check+   where check (a, b) = a <> b </> a == Just b+                        && a <> b </> b == Just a++checkStripCommonPrefix1 :: forall a. (Arbitrary a, Show a, Eq a, LeftGCDMonoid a) => a -> Property+checkStripCommonPrefix1 _ = forAll (arbitrary :: Gen (a, a)) check+   where check (a, b) = stripCommonPrefix a b == (p, a', b')+            where p = commonPrefix a b+                  Just a' = stripPrefix p a+                  Just b' = stripPrefix p b++checkStripCommonPrefix2 :: forall a. (Arbitrary a, Show a, Eq a, LeftGCDMonoid a) => a -> Property+checkStripCommonPrefix2 _ = forAll (arbitrary :: Gen (a, a)) check+   where check (a, b) = p == commonPrefix a b && p <> a' == a && p <> b' == b+            where (p, a', b') = stripCommonPrefix a b++checkStripCommonSuffix1 :: forall a. (Arbitrary a, Show a, Eq a, RightGCDMonoid a) => a -> Property+checkStripCommonSuffix1 _ = forAll (arbitrary :: Gen (a, a)) check+   where check (a, b) = stripCommonSuffix a b == (a', b', s)+            where s = commonSuffix a b+                  Just a' = stripSuffix s a+                  Just b' = stripSuffix s b++checkStripCommonSuffix2 :: forall a. (Arbitrary a, Show a, Eq a, RightGCDMonoid a) => a -> Property+checkStripCommonSuffix2 _ = forAll (arbitrary :: Gen (a, a)) check+   where check (a, b) = s == commonSuffix a b && a' <> s == a && b' <> s == b+            where (a', b', s) = stripCommonSuffix a b++checkGCD :: forall a. (Arbitrary a, Show a, Eq a, GCDMonoid a) => a -> Property+checkGCD _ = forAll (arbitrary :: Gen (a, a)) check+   where check (a, b) = d == commonPrefix a b+                        && d == commonSuffix a b+                        && isJust (a </> d)+                        && isJust (b </> d)+            where d = gcd a b++checkCancellativeGCD :: forall a. (Arbitrary a, Show a, Eq a, CancellativeMonoid a, GCDMonoid a) => a -> Property+checkCancellativeGCD _ = forAll (arbitrary :: Gen (a, a, a)) check+   where check (a, b, c) = commonPrefix (a <> b) (a <> c) == a <> (commonPrefix b c)+                           && commonSuffix (a <> c) (b <> c) == (commonSuffix a b) <> c+                           && gcd (a <> b) (a <> c) == a <> gcd b c+                           && gcd (a <> c) (b <> c) == gcd a b <> c++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, +                                                 Monoid, LeftReductiveMonoid, LeftCancellativeMonoid, LeftGCDMonoid,+                                                 MonoidNull, IsString)++instance FactorialMonoid TestString where+   splitPrimePrefix (TestString []) = Nothing+   splitPrimePrefix (TestString (x:xs)) = Just (TestString [x], TestString xs)++instance TextualMonoid TestString where+   splitCharacterPrefix (TestString []) = Nothing+   splitCharacterPrefix (TestString (x:xs)) = Just (x, TestString xs)++instance Show a => Show (a -> Bool) where+   show _ = "predicate"++instance Arbitrary All where+   arbitrary = fmap All arbitrary++instance Arbitrary Any where+   arbitrary = fmap Any arbitrary++instance Arbitrary a => Arbitrary (Dual a) where+   arbitrary = fmap Dual arbitrary++instance Arbitrary a => Arbitrary (First a) where+   arbitrary = fmap First arbitrary++instance Arbitrary a => Arbitrary (Last a) where+   arbitrary = fmap Last arbitrary++instance Arbitrary a => Arbitrary (Product a) where+   arbitrary = fmap Product arbitrary++instance Arbitrary a => Arbitrary (Sum a) where+   arbitrary = fmap Sum arbitrary++instance Arbitrary a => Arbitrary (Vector a) where+   arbitrary = fmap fromList arbitrary++instance Arbitrary ByteStringUTF8 where+   arbitrary = fmap ByteStringUTF8 arbitrary++instance CoArbitrary All where+   coarbitrary (All p) = coarbitrary p++instance CoArbitrary Any where+   coarbitrary (Any p) = coarbitrary p++instance CoArbitrary a => CoArbitrary (Dual a) where+   coarbitrary (Dual a) = coarbitrary a++instance CoArbitrary a => CoArbitrary (First a) where+   coarbitrary (First a) = coarbitrary a++instance CoArbitrary a => CoArbitrary (Last a) where+   coarbitrary (Last a) = coarbitrary a++instance CoArbitrary a => CoArbitrary (Product a) where+   coarbitrary (Product a) = coarbitrary a++instance CoArbitrary a => CoArbitrary (Sum a) where+   coarbitrary (Sum a) = coarbitrary a++instance CoArbitrary a => CoArbitrary (Vector a) where+   coarbitrary = coarbitrary . toList++instance CoArbitrary ByteStringUTF8 where+   coarbitrary (ByteStringUTF8 bs) = coarbitrary bs
+ monoid-subclasses.cabal view
@@ -0,0 +1,39 @@+Name:                monoid-subclasses+Version:             0.1+Cabal-Version:       >= 1.10+Build-Type:          Simple+Synopsis:            Subclasses of Monoid+Category:            Data+Tested-with:         GHC+Description:+  This package defines 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 Mario Blazevic+Author:              Mario Blazevic+Maintainer:          blamario@yahoo.com+Homepage:            https://github.com/blamario/monoid-subclasses/+Source-repository head+  type:              darcs+  location:          http://code.haskell.org/SCC/++Library+  Exposed-Modules:   Data.Monoid.Cancellative, Data.Monoid.Factorial, Data.Monoid.Null, Data.Monoid.Textual,+                     Data.Monoid.Instances.ByteString.UTF8+  Build-Depends:     base < 5, bytestring >= 0.9 && < 1.0, containers == 0.5.*, text == 0.11.*, primes == 0.2.*,+                     utf8-string == 0.3.*, vector == 0.10.*+  GHC-prof-options:  -auto-all+  if impl(ghc >= 7.0.0)+     default-language: Haskell2010++test-suite Main+  Type:              exitcode-stdio-1.0+  x-uses-tf:         true+  Build-Depends:     base < 5, bytestring >= 0.9 && < 1.0, containers == 0.5.*, text == 0.11.*, primes == 0.2.*,+                     utf8-string == 0.3.*, vector == 0.10.*, QuickCheck == 2.*, quickcheck-instances == 0.3.*,+                     test-framework >= 0.4.1, test-framework-quickcheck2+  Main-is:           Test/TestMonoidSubclasses.hs+  Other-Modules:     Data.Monoid.Cancellative, Data.Monoid.Factorial, Data.Monoid.Null+  default-language:  Haskell2010