monoid-subclasses 0.3 → 0.3.1

raw patch · 7 files changed

+379/−23 lines, 7 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Data/Monoid/Cancellative.hs +28/−0
• Data/Monoid/Factorial.hs +17/−6
• Data/Monoid/Instances/ByteString/UTF8.hs +3/−1
• Data/Monoid/Instances/Concat.hs +217/−0
• Data/Monoid/Null.hs +32/−1
• Test/TestMonoidSubclasses.hs +80/−13
• monoid-subclasses.cabal +2/−2

@@ -328,6 +328,34 @@ instance (RightGCDMonoid a, RightGCDMonoid b) => RightGCDMonoid (a, b) where    commonSuffix (a, b) (c, d) = (commonSuffix a c, commonSuffix b d) +-- Maybe instances++instance LeftReductiveMonoid x => LeftReductiveMonoid (Maybe x) where+   stripPrefix Nothing y = Just y+   stripPrefix Just{} Nothing = Nothing+   stripPrefix (Just x) (Just y) = fmap Just $ stripPrefix x y++instance LeftGCDMonoid x => LeftGCDMonoid (Maybe x) where+   commonPrefix (Just x) (Just y) = Just (commonPrefix x y)+   commonPrefix _ _ = Nothing++   stripCommonPrefix (Just x) (Just y) = (Just p, Just x', Just y')+      where (p, x', y') = stripCommonPrefix x y+   stripCommonPrefix x y = (Nothing, x, y)++instance RightReductiveMonoid x => RightReductiveMonoid (Maybe x) where+   stripSuffix Nothing y = Just y+   stripSuffix Just{} Nothing = Nothing+   stripSuffix (Just x) (Just y) = fmap Just $ stripSuffix x y++instance RightGCDMonoid x => RightGCDMonoid (Maybe x) where+   commonSuffix (Just x) (Just y) = Just (commonSuffix x y)+   commonSuffix _ _ = Nothing++   stripCommonSuffix (Just x) (Just y) = (Just x', Just y', Just s)+      where (x', y', s) = stripCommonSuffix x y+   stripCommonSuffix x y = (x, y, Nothing)+ -- Set instances  instance Ord a => CommutativeMonoid (Set.Set a)

@@ -10,8 +10,8 @@ {-# LANGUAGE Haskell2010 #-}  module Data.Monoid.Factorial (-   -- * Class-   FactorialMonoid(..),+   -- * Classes+   FactorialMonoid(..), StableFactorialMonoid,    -- * Monad function equivalents    mapM, mapM_    )@@ -65,10 +65,6 @@ -- > 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@@ -149,6 +145,11 @@    take n p = fst (splitAt n p)    reverse = mconcat . List.reverse . factors +-- | A subclass of 'FactorialMonoid' whose instances satisfy this additional law:+--+-- > factors (a <> b) == factors a <> factors b+class FactorialMonoid m => StableFactorialMonoid m+ instance FactorialMonoid () where    factors () = []    primePrefix () = ()@@ -459,6 +460,16 @@    take = Vector.take    length = Vector.length    reverse = Vector.reverse++instance StableFactorialMonoid ()+instance StableFactorialMonoid a => StableFactorialMonoid (Dual a)+instance StableFactorialMonoid [x]+instance StableFactorialMonoid ByteString.ByteString+instance StableFactorialMonoid LazyByteString.ByteString+instance StableFactorialMonoid Text.Text+instance StableFactorialMonoid LazyText.Text+instance StableFactorialMonoid (Sequence.Seq a)+instance StableFactorialMonoid (Vector.Vector a)  -- | A 'Monad.mapM' equivalent. mapM :: (FactorialMonoid a, Monoid b, Monad m) => (a -> m b) -> a -> m b

@@ -26,7 +26,7 @@  import Data.Monoid (Monoid) import Data.Monoid.Cancellative (LeftReductiveMonoid, LeftCancellativeMonoid, LeftGCDMonoid)-import Data.Monoid.Null (MonoidNull)+import Data.Monoid.Null (MonoidNull, PositiveMonoid) import Data.Monoid.Factorial (FactorialMonoid(..)) import Data.Monoid.Textual (TextualMonoid(..)) import qualified Data.Monoid.Factorial as Factorial (FactorialMonoid(..))@@ -40,6 +40,8 @@  instance IsString ByteStringUTF8 where    fromString = ByteStringUTF8 . UTF8.fromString++instance PositiveMonoid ByteStringUTF8  instance FactorialMonoid ByteStringUTF8 where    splitPrimePrefix (ByteStringUTF8 bs) = 

@@ -0,0 +1,217 @@+{- +    Copyright 2011-2013 Mario Blazevic++    License: BSD3 (see BSD3-LICENSE.txt file)+-}++-- | This module defines the monoid transformer data type 'Concat'.+-- ++{-# LANGUAGE Haskell2010 #-}++module Data.Monoid.Instances.Concat (+   Concat, inject, extract +   )+where++import Prelude hiding (all, any, break, filter, foldl, foldl1, foldr, foldr1, map, concatMap, +                       length, null, reverse, scanl, scanr, scanl1, scanr1, span, splitAt)+import Control.Applicative (Applicative(..))+import Data.Foldable (Foldable)+import Data.Traversable (Traversable, traverse)+import qualified Data.Foldable as Foldable+import qualified Data.Traversable as Traversable+import Data.Maybe (fromMaybe)+import Data.String (IsString(..))+import Data.Monoid (Monoid(..), First(..), Sum(..))+import Data.Monoid.Cancellative (LeftReductiveMonoid(..), RightReductiveMonoid(..),+                                 LeftGCDMonoid(..), RightGCDMonoid(..))+import Data.Monoid.Null (MonoidNull(null), PositiveMonoid)+import Data.Monoid.Factorial (FactorialMonoid(..), StableFactorialMonoid)+import Data.Monoid.Textual (TextualMonoid(..))+import qualified Data.Monoid.Factorial as Factorial+import qualified Data.Monoid.Textual as Textual+import Data.Sequence (Seq, empty, filter, (<|), (|>), ViewL((:<)), ViewR((:>)))+import qualified Data.Sequence as Seq++-- | @'Concat' a@ is a @newtype@ wrapper around @'Seq' a@. The behaviour of the @'Concat' a@ instances of monoid+-- subclasses is identical to the behaviour of their @a@ instances, up to the @'inject' . 'singleton'@ isomorphism.+--+-- The only purpose of 'Concat' then is to change the performance characteristics of various operations. Most+-- importantly, injecting a monoid into a 'Concat' has the effect of making 'mappend' a constant-time operation.+--+newtype Concat a = Concat {extract :: Seq a} deriving Show++instance (Eq a, Monoid a) => Eq (Concat a) where+   Concat x == Concat y = Foldable.foldMap id x == Foldable.foldMap id y++instance (Ord a, Monoid a) => Ord (Concat a) where+   compare (Concat x) (Concat y) = compare (Foldable.foldMap id x) (Foldable.foldMap id y)++instance Monoid (Concat a) where+   mempty = Concat Seq.empty+   mappend (Concat a) (Concat b) = Concat (mappend a b)++instance MonoidNull (Concat a) where+   null (Concat x) = Seq.null x++instance PositiveMonoid (Concat a)++instance (LeftReductiveMonoid a, MonoidNull a, StableFactorialMonoid a) => LeftReductiveMonoid (Concat a) where+   stripPrefix (Concat x) (Concat y) = fmap Concat $ strip1 x y+      where strip1 x y = strip2 (Seq.viewl x) y+            strip2 Seq.EmptyL y = Just y+            strip2 (xp :< xs) y = strip3 xp xs (Seq.viewl y)+            strip3 _ _ Seq.EmptyL = Nothing+            strip3 xp xs (yp :< ys) =+               case (stripPrefix xp yp, stripPrefix yp xp)+               of (Just yps, _) -> strip1 xs (if null yps then ys else yps <| ys)+                  (Nothing, Nothing) -> Nothing+                  (Nothing, Just xps) -> strip3 xps xs (Seq.viewl ys)++instance (MonoidNull a, RightReductiveMonoid a, StableFactorialMonoid a) => RightReductiveMonoid (Concat a) where+   stripSuffix (Concat x) (Concat y) = fmap Concat $ strip1 x y+      where strip1 x y = strip2 (Seq.viewr x) y+            strip2 Seq.EmptyR y = Just y+            strip2 (xp :> xs) y = strip3 xp xs (Seq.viewr y)+            strip3 _ _ Seq.EmptyR = Nothing+            strip3 xp xs (yp :> ys) =+               case (stripSuffix xs ys, stripSuffix ys xs)+               of (Just ysp, _) -> strip1 xp (if null ysp then yp else yp |> ysp)+                  (Nothing, Nothing) -> Nothing+                  (Nothing, Just xsp) -> strip3 xp xsp (Seq.viewr yp)++instance (Eq a, LeftGCDMonoid a, MonoidNull a, StableFactorialMonoid a) => LeftGCDMonoid (Concat a) where+   stripCommonPrefix (Concat x) (Concat y) = strip cp1 xs1 ys1+      where (cp1, xs1, ys1) = stripCommonPrefix x y+            strip cp xs ys =+               case (Seq.viewl xs, Seq.viewl ys)+               of (Seq.EmptyL, _) -> (Concat cp, mempty, Concat ys)+                  (_, Seq.EmptyL) -> (Concat cp, Concat xs, mempty)+                  (xsp :< xss, ysp :< yss) ->+                     let (cs, xsps, ysps) = stripCommonPrefix xsp ysp+                         cp' = cp |> cs+                         prepend p s = if null p then s else p <| s+                     in if null cs+                        then (Concat cp, Concat xs, Concat ys)+                        else if null xsps && null ysps+                             then strip cp' xss yss+                             else (Concat cp', Concat $ prepend xsps xss, Concat $ prepend ysps yss)++instance (Eq a, RightGCDMonoid a, MonoidNull a, StableFactorialMonoid a) => RightGCDMonoid (Concat a) where+   stripCommonSuffix (Concat x) (Concat y) = strip xp1 yp1 cs1+      where (xp1, yp1, cs1) = stripCommonSuffix x y+            strip xp yp cs =+               case (Seq.viewr xp, Seq.viewr yp)+               of (Seq.EmptyR, _) -> (mempty, Concat yp, Concat cs)+                  (_, Seq.EmptyR) -> (Concat xp, mempty, Concat cs)+                  (xpp :> xps, ypp :> yps) ->+                     let (xpsp, ypsp, cp) = stripCommonSuffix xps yps+                         cs' = cp <| cs+                         append p s = if null s then p else p |> s+                     in if null cp+                        then (Concat xp, Concat yp, Concat cs)+                        else if null xpsp && null ypsp+                             then strip xpp ypp cs'+                             else (Concat $ append xpp xpsp, Concat $ append ypp ypsp, Concat cs')++instance FactorialMonoid a => FactorialMonoid (Concat a) where+   factors (Concat x) = Foldable.foldMap (fmap (Concat . Seq.singleton) . factors) x+   primePrefix (Concat x) = Concat (fmap primePrefix $ primePrefix x)+   primeSuffix (Concat x) = Concat (fmap primeSuffix $ primeSuffix x)+   splitPrimePrefix (Concat x) =+      case Seq.viewl x+           of Seq.EmptyL -> Nothing+              xp :< xs -> Just (Concat $ Seq.singleton xpp, Concat xs')+                 where Just (xpp, xps) = splitPrimePrefix xp+                       xs' = if null xps then xs else xps <| xs+   splitPrimeSuffix (Concat x) =+      case Seq.viewr x+           of Seq.EmptyR -> Nothing+              xp :> xs -> Just (Concat xp', Concat $ Seq.singleton xss)+                 where Just (xsp, xss) = splitPrimeSuffix xs+                       xp' = if null xsp then xp else xp |> xsp+   foldl f a (Concat x) = Foldable.foldl g a x+      where g = Factorial.foldl (\a-> f a . Concat . Seq.singleton)+   foldl' f a (Concat x) = Foldable.foldl' g a x+      where g = Factorial.foldl' (\a-> f a . Concat . Seq.singleton)+   foldr f a (Concat x) = Foldable.foldr g a x+      where g a b = Factorial.foldr (f . Concat . Seq.singleton) b a+   length (Concat x) = getSum $ Foldable.foldMap (Sum . length) x+   foldMap f (Concat x) = Foldable.foldMap (foldMap (f . Concat . Seq.singleton)) x+   span p (Concat x) =+      case Seq.viewl x+      of Seq.EmptyL -> (mempty, mempty)+         xp :< xs | null xps -> (Concat (xp <| xsp), xss)+                  | null xpp -> (mempty, Concat x)+                  | otherwise -> (Concat $ Seq.singleton xpp, Concat (xps <| xs))+            where (xpp, xps) = Factorial.span (p . Concat . Seq.singleton) xp+                  (Concat xsp, xss) = Factorial.span p (Concat xs)+   splitAt 0 c = (mempty, c)+   splitAt n (Concat x) =+      case Seq.viewl x+      of Seq.EmptyL -> (mempty, mempty)+         xp :< xs | k < n -> (Concat (xp <| xsp), xss)+                  | otherwise -> (Concat $ Seq.singleton xpp, Concat (if null xps then xs else xps <| xs))+            where k = length xp+                  (Concat xsp, xss) = splitAt (n - k) (Concat xs) +                  (xpp, xps) = splitAt n xp+   reverse (Concat x) = Concat (fmap reverse $ reverse x)+++instance (IsString a) => IsString (Concat a) where+   fromString "" = Concat empty+   fromString s = Concat (Seq.singleton $ fromString s)++instance (Eq a, TextualMonoid a, StableFactorialMonoid a) => TextualMonoid (Concat a) where+   fromText t | null t = Concat empty+              | otherwise = Concat (Seq.singleton $ fromText t)+   singleton = Concat . Seq.singleton . singleton+   splitCharacterPrefix (Concat x) =+      case Seq.viewl x+      of Seq.EmptyL -> Nothing+         xp :< xs -> case splitCharacterPrefix xp+                     of Just (c, xps) -> Just (c, Concat $ if null xps then xs else xps <| xs)+                        Nothing -> Nothing+   characterPrefix (Concat x) =+      case Seq.viewl x+      of Seq.EmptyL -> Nothing+         xp :< _ -> characterPrefix xp+   map f (Concat x) = Concat (fmap (map f) x)+   any p (Concat x) = Foldable.any (any p) x+   all p (Concat x) = Foldable.all (all p) x++   foldl ft fc a (Concat x) = Foldable.foldl g a x+      where g = Textual.foldl (\a-> ft a . Concat . Seq.singleton) fc+   foldl' ft fc a (Concat x) = Foldable.foldl' g a x+      where g = Textual.foldl' (\a-> ft a . Concat . Seq.singleton) fc+   foldr ft fc a (Concat x) = Foldable.foldr g a x+      where g a b = Textual.foldr (ft . Concat . Seq.singleton) fc b a++   span pt pc (Concat x) =+      case Seq.viewl x+      of Seq.EmptyL -> (mempty, mempty)+         xp :< xs | null xps -> (Concat (xp <| xsp), xss)+                  | null xpp -> (mempty, Concat x)+                  | otherwise -> (Concat $ Seq.singleton xpp, Concat (xps <| xs))+            where (xpp, xps) = Textual.span (pt . Concat . Seq.singleton) pc xp+                  (Concat xsp, xss) = Textual.span pt pc (Concat xs)+   break pt pc = Textual.span (not . pt) (not . pc)++   find p (Concat x) = getFirst $ Foldable.foldMap (First . find p) x++newtype Pair a = Pair (a, a)++instance Functor Pair where+   fmap f (Pair (x, y)) = Pair (f x, f y)++instance Applicative Pair where+   pure x = Pair (x, x)+   Pair (f, g) <*> Pair (x, y) = Pair (f x, g y)++inject :: (MonoidNull a, PositiveMonoid a) => Seq a -> Concat a+inject = Concat . filter (not . null)++injectSingleton :: (MonoidNull a, PositiveMonoid a) => a -> Concat a+injectSingleton a | null a = mempty+                  | otherwise = Concat (Seq.singleton a)

@@ -10,7 +10,7 @@ {-# LANGUAGE Haskell2010 #-}  module Data.Monoid.Null (-   MonoidNull(..)+   MonoidNull(..), PositiveMonoid    ) where @@ -38,6 +38,12 @@ class Monoid m => MonoidNull m where    null :: m -> Bool +-- | Subclass of 'Monoid' for types whose values have no inverse, with the exception of 'mempty'. More formally, the+-- class instances must satisfy the following law:+-- +-- prop> null (x <> y) == (null x && null y)+class MonoidNull m => PositiveMonoid m+ instance MonoidNull () where    null () = True @@ -106,3 +112,28 @@  instance MonoidNull (Vector.Vector a) where    null = Vector.null++instance PositiveMonoid ()+instance PositiveMonoid Ordering+instance PositiveMonoid All+instance PositiveMonoid Any+instance PositiveMonoid ByteString.ByteString+instance PositiveMonoid LazyByteString.ByteString+instance PositiveMonoid Text.Text+instance PositiveMonoid LazyText.Text+instance Monoid a => PositiveMonoid (Maybe a)+instance PositiveMonoid (First a)+instance PositiveMonoid (Last a)+instance PositiveMonoid a => PositiveMonoid (Dual a)+instance PositiveMonoid [x]+instance Ord k => PositiveMonoid (Map.Map k v)+instance PositiveMonoid (IntMap.IntMap v)+instance PositiveMonoid IntSet.IntSet+instance PositiveMonoid (Sequence.Seq a)+instance Ord a => PositiveMonoid (Set.Set a)+instance PositiveMonoid (Vector.Vector a)++-- Both instances are not allowed, so we leave the choice to the user.+--+-- instance (PositiveMonoid a, Monoid b) => PositiveMonoid (a, b)+-- instance (Monoid a, PositiveMonoid b) => PositiveMonoid (a, b)

@@ -4,7 +4,7 @@     License: BSD3 (see BSD3-LICENSE.txt file) -} -{-# LANGUAGE Rank2Types, ScopedTypeVariables, FlexibleInstances, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE CPP, Rank2Types, ScopedTypeVariables, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving #-}  module Main where @@ -14,8 +14,11 @@                         quickCheck, arbitrary, coarbitrary, property, label, forAll, variant, whenFail, (.&&.)) import Test.QuickCheck.Instances () +import Control.Applicative (Applicative(..)) import Data.Int (Int8, Int32) import Data.Foldable (toList)+import qualified Data.Foldable as Foldable+import Data.Traversable (Traversable) import Data.List (intersperse, unfoldr) import qualified Data.List as List import Data.Maybe (isJust)@@ -23,12 +26,15 @@ import Data.Tuple (swap) import Data.String (IsString, fromString) import Data.Char (isLetter)+import Data.Int (Int16)+import Data.Word (Word, Word8)  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 qualified Data.Sequence as Sequence import Data.IntMap (IntMap) import Data.IntSet (IntSet) import Data.Map (Map)@@ -37,11 +43,13 @@ import Data.Vector (Vector, fromList)  import Data.Monoid.Instances.ByteString.UTF8 (ByteStringUTF8(ByteStringUTF8))+import Data.Monoid.Instances.Concat (Concat, extract, inject)  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,+import Data.Monoid.Null (MonoidNull, PositiveMonoid, null)+import Data.Monoid.Factorial (FactorialMonoid, StableFactorialMonoid, +                              factors, splitPrimePrefix, splitPrimeSuffix, primePrefix, primeSuffix,                               foldl, foldl', foldr, length, reverse, span, split, splitAt) import Data.Monoid.Cancellative (CommutativeMonoid, ReductiveMonoid, LeftReductiveMonoid, RightReductiveMonoid,                                  CancellativeMonoid, LeftCancellativeMonoid, RightCancellativeMonoid,@@ -99,7 +107,17 @@                                                        .&&. checkType (mempty :: Map String Int)                                                        .&&. checkType (mempty :: Seq Int)                                                        .&&. checkType (mempty :: Set String)-                                                       .&&. checkType (mempty :: Vector Int))+                                                       .&&. checkType (mempty :: Vector Int)+                                                       .&&. checkType (mempty :: Concat Any)+                                                       .&&. checkType (mempty :: Concat String)+                                                       .&&. checkType (mempty :: Concat ByteString)+                                                       .&&. checkType (mempty :: Concat Text)+                                                       .&&. checkType (mempty :: Concat Lazy.Text)+                                                       .&&. checkType (mempty :: Concat (Dual String))+                                                       .&&. checkType (mempty :: Concat (Maybe String))+                                                       .&&. checkType (mempty :: Concat (Text, String))+                                                       .&&. checkType (mempty :: Concat (IntMap Int))+                                                       .&&. checkType (mempty :: Concat (Map String Int))) checkInstances name (FactorialTest checkType) = label name (checkType ()                                                             .&&. checkType (mempty :: TestString)                                                             .&&. checkType (mempty :: String)@@ -118,14 +136,26 @@                                                             .&&. checkType (mempty :: Map String Int)                                                             .&&. checkType (mempty :: Seq Int)                                                             .&&. checkType (mempty :: Set String)-                                                            .&&. checkType (mempty :: Vector Int))+                                                            .&&. checkType (mempty :: Vector Int)+                                                            .&&. checkType (mempty :: Concat String)+                                                            .&&. checkType (mempty :: Concat ByteString)+                                                            .&&. checkType (mempty :: Concat Text)+                                                            .&&. checkType (mempty :: Concat Lazy.Text)+                                                            .&&. checkType (mempty :: Concat (Dual String))+                                                            .&&. checkType (mempty :: Concat (Maybe String))+                                                            .&&. checkType (mempty :: Concat (Text, String))+                                                            .&&. checkType (mempty :: Concat (IntMap Int))+                                                            .&&. checkType (mempty :: Concat (Map String Int))) checkInstances name (TextualTest checkType) = label name (checkType (mempty :: TestString)                                                           .&&. checkType (mempty :: String)                                                           .&&. checkType (mempty :: ByteStringUTF8)                                                           .&&. checkType (mempty :: Text)                                                           .&&. checkType (mempty :: Lazy.Text)                                                           .&&. checkType (mempty :: Seq Char)-                                                          .&&. checkType (mempty :: Vector Char))+                                                          .&&. checkType (mempty :: Vector Char)+                                                          .&&. checkType (mempty :: Concat String)+                                                          .&&. checkType (mempty :: Concat Text)+                                                          .&&. checkType (mempty :: Concat Lazy.Text)) checkInstances name (LeftReductiveTest checkType) = label name (checkType ()                                                                 .&&. checkType (mempty :: String)                                                                 .&&. checkType (mempty :: ByteString)@@ -139,7 +169,13 @@                                                                 .&&. checkType (mempty :: IntSet)                                                                 .&&. checkType (mempty :: Seq String)                                                                 .&&. checkType (mempty :: Set Integer)-                                                                .&&. checkType (mempty :: Vector Int))+                                                                .&&. checkType (mempty :: Vector Int)+                                                                .&&. checkType (mempty :: Concat String)+                                                                .&&. checkType (mempty :: Concat ByteString)+                                                                .&&. checkType (mempty :: Concat Lazy.ByteString)+                                                                .&&. checkType (mempty :: Concat Text)+                                                                .&&. checkType (mempty :: Concat Lazy.Text)+                                                                .&&. checkType (mempty :: Concat (Dual Text))) checkInstances name (RightReductiveTest checkType) = label name (checkType ()                                                                  .&&. checkType (mempty :: ByteString)                                                                  .&&. checkType (mempty :: Lazy.ByteString)@@ -152,7 +188,12 @@                                                                  .&&. checkType (mempty :: IntSet)                                                                  .&&. checkType (mempty :: Seq Int)                                                                  .&&. checkType (mempty :: Set String)-                                                                 .&&. checkType (mempty :: Vector Int))+                                                                 .&&. checkType (mempty :: Vector Int)+                                                                 .&&. checkType (mempty :: Concat ByteString)+                                                                 .&&. checkType (mempty :: Concat Lazy.ByteString)+                                                                 .&&. checkType (mempty :: Concat Text)+                                                                 .&&. checkType (mempty :: Concat Lazy.Text)+                                                                 .&&. checkType (mempty :: Concat (Dual Text))) checkInstances name (ReductiveTest checkType) = label name (checkType ()                                                             .&&. checkType (mempty :: Sum Integer)                                                             .&&. checkType (mempty :: Product Integer)@@ -200,7 +241,13 @@                                                           .&&. checkType (mempty :: Map String Int)                                                           .&&. checkType (mempty :: Seq Int)                                                           .&&. checkType (mempty :: Set String)-                                                          .&&. checkType (mempty :: Vector Int))+                                                          .&&. checkType (mempty :: Vector Int)+                                                          .&&. checkType (mempty :: Concat String)+                                                          .&&. checkType (mempty :: Concat ByteString)+                                                          .&&. checkType (mempty :: Concat Lazy.ByteString)+                                                          .&&. checkType (mempty :: Concat Text)+                                                          .&&. checkType (mempty :: Concat Lazy.Text)+                                                          .&&. checkType (mempty :: Concat (Dual ByteString))) checkInstances name (RightGCDTest checkType) = label name (checkType ()                                                            .&&. checkType (mempty :: ByteString)                                                            .&&. checkType (mempty :: Lazy.ByteString)@@ -211,7 +258,10 @@                                                            .&&. checkType (mempty :: IntSet)                                                            .&&. checkType (mempty :: Seq Int)                                                            .&&. checkType (mempty :: Set String)-                                                           .&&. checkType (mempty :: Vector Int))+                                                           .&&. checkType (mempty :: Vector Int)+                                                           .&&. checkType (mempty :: Concat ByteString)+                                                           .&&. checkType (mempty :: Concat Lazy.ByteString)+                                                           .&&. checkType (mempty :: Concat (Dual Text))) checkInstances name (GCDTest checkType) = label name (checkType ()                                                       .&&. checkType (mempty :: Sum Integer)                                                       .&&. checkType (mempty :: Product Integer)@@ -579,9 +629,6 @@    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 @@ -609,6 +656,9 @@ instance Arbitrary ByteStringUTF8 where    arbitrary = fmap ByteStringUTF8 arbitrary +instance (Arbitrary a, MonoidNull a, PositiveMonoid a) => Arbitrary (Concat a) where+   arbitrary = fmap inject arbitrary+ instance CoArbitrary All where    coarbitrary (All p) = coarbitrary p @@ -635,3 +685,20 @@  instance CoArbitrary ByteStringUTF8 where    coarbitrary (ByteStringUTF8 bs) = coarbitrary bs++instance CoArbitrary a => CoArbitrary (Concat a) where+   coarbitrary = coarbitrary . extract++instance Show a => Show (a -> Bool) where+   show _ = "predicate"++instance (PositiveMonoid a, MonoidNull b) => PositiveMonoid (a, b)++#if MIN_VERSION_containers(0,5,2)+#else+instance Applicative Seq where+   pure = Sequence.singleton+   fs <*> xs = Foldable.foldl' add mempty fs+      where add ys f = ys <> fmap f xs++#endif

@@ -1,5 +1,5 @@ Name:                monoid-subclasses-Version:             0.3+Version:             0.3.1 Cabal-Version:       >= 1.10 Build-Type:          Simple Synopsis:            Subclasses of Monoid@@ -21,7 +21,7 @@  Library   Exposed-Modules:   Data.Monoid.Cancellative, Data.Monoid.Factorial, Data.Monoid.Null, Data.Monoid.Textual,-                     Data.Monoid.Instances.ByteString.UTF8+                     Data.Monoid.Instances.ByteString.UTF8, Data.Monoid.Instances.Concat   Build-Depends:     base < 5, bytestring >= 0.9 && < 1.0, containers == 0.5.*, text == 0.11.*, primes == 0.2.*,                      utf8-string == 0.3.*, vector >= 0.9 && < 0.11   GHC-prof-options:  -auto-all