packages feed

monoids 0.1.2 → 0.1.5

raw patch · 49 files changed

+1232/−753 lines, 49 filesdep +arraydep +parsec

Dependencies added: array, parsec

Files

Data/Group.hs view
@@ -1,23 +1,40 @@+----------------------------------------------------------------------------+-- |+-- Module     : Data.Group+-- Copyright  : 2007-2009 Edward Kmett+-- License    : BSD+--+-- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Stability   : experimental+-- Portability : portable+--+-- Extends 'Monoid' to support 'Group' operations+-----------------------------------------------------------------------------+ module Data.Group      ( module Data.Monoid.Additive     , Group     , gnegate+    , gsubtract     , minus     ) where  import Data.Monoid.Additive-import Data.Monoid.Monad.Identity+import Data.Monoid.Self import Data.Monoid.FromString  infixl 6 `minus` +-- | Minimal complete definition: 'gnegate' or 'minus' class Monoid a => Group a where     -- additive inverse     gnegate :: a -> a--    -- right cancellation     minus :: a -> a -> a+    gsubtract :: a -> a -> a ++    gnegate = minus zero     a `minus` b = a `plus` gnegate b +    a `gsubtract` b = gnegate a `plus` b  instance Num a => Group (Sum a) where     gnegate = Sum . negate . getSum@@ -30,9 +47,9 @@ instance Group a => Group (Dual a) where     gnegate = Dual . gnegate . getDual -instance Group a => Group (Identity a) where-    gnegate = Identity . gnegate . runIdentity-    Identity a `minus` Identity b = Identity (a `minus` b)+instance Group a => Group (Self a) where+    gnegate = Self . gnegate . getSelf+    Self a `minus` Self b = Self (a `minus` b)  instance Group a => Group (FromString a) where     gnegate = FromString . gnegate . getFromString
+ Data/Group/Combinators.hs view
@@ -0,0 +1,43 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Group.Combinators+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- Utilities for working with Groups that conflict with names from the "Prelude".+--+-- Intended to be imported qualified.+--+-- > import Data.Group.Combinators as Group (replicate)+--+-----------------------------------------------------------------------------++module Data.Group.Combinators+    ( module Data.Group+    , replicate+    ) where++import Prelude hiding (replicate)+import Data.Group++-- shamelessly stolen from Lennart Augustsson's post: +-- http://augustss.blogspot.com/2008/07/lost-and-found-if-i-write-108-in.html+-- adapted to groups, which can permit negative exponents+replicate :: (Group m, Integral n) =>  m -> n -> m+replicate x0 y0 +    | y0 < 0 = f (gnegate x0) (negate y0)+    | y0 == 0 = mempty+    | otherwise = f x0 y0+    where+        f x y +            | even y = f (x `mappend` x) (y `quot` 2)+            | y == 1 = x+            | otherwise = g (x `mappend` x) ((y - 1) `quot` 2) x+        g x y z +            | even y = g (x `mappend` x) (y `quot` 2) z+            | y == 1 = x `mappend` z+            | otherwise = g (x `mappend` x) ((y - 1) `quot` 2) (x `mappend` z)+
Data/Group/Sugar.hs view
@@ -1,13 +1,30 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Group.Sugar+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- Syntactic sugar for working with groups that conflicts with names from the "Prelude".+--+-- > import Prelude hiding ((-), (+), negate, subtract)+-- > import Data.Group.Sugar+--+-----------------------------------------------------------------------------+ module Data.Group.Sugar      ( module Data.Monoid.Additive.Sugar     , module Data.Group     , (-)     , negate+    , subtract     ) where  import Data.Monoid.Additive.Sugar import Data.Group-import Prelude hiding ((-), negate)+import Prelude hiding ((-), negate, subtract)  infixl 7 - @@ -16,3 +33,6 @@  negate :: Group g => g -> g negate = gnegate++subtract :: Group g => g -> g -> g+subtract = gsubtract
Data/Monoid/Additive.hs view
@@ -1,3 +1,18 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid.Additive+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- More easily understood aliases for "mappend" and "mempty" +--+-- > import Data.Monoid.Additive+--+-----------------------------------------------------------------------------+ module Data.Monoid.Additive     ( module Data.Monoid      , plus
Data/Monoid/Additive/Sugar.hs view
@@ -1,3 +1,19 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid.Additive.Sugar+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- Syntactic sugar for working with a 'Monoid' that conflicts with names from the "Prelude".+--+-- > import Prelude hiding ((+))+-- > import Data.Monoid.Additive.Sugar+--+-----------------------------------------------------------------------------+ module Data.Monoid.Additive.Sugar      ( module Data.Monoid.Additive     , (+)
Data/Monoid/Applicative.hs view
@@ -1,16 +1,34 @@ {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid.Applicative+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs)+--+-- Monoids for working with an 'Applicative' 'Functor'.+--+-----------------------------------------------------------------------------+ module Data.Monoid.Applicative -    ( module Control.Applicative-    , module Data.Monoid.Reducer+    ( module Data.Monoid.Reducer+    , module Data.Ring.Semi.Near     , Traversal(Traversal,getTraversal)-    , Alternate(Alternate,getAlternate)-    , TraversalWith(TraversalWith,getTraversalWith)+    , WrappedApplicative(WrappedApplicative,getWrappedApplicative)+    , snocTraversal     ) where -import Control.Functor.Pointed (Pointed, point)-import Control.Applicative (Applicative, (*>), pure, Alternative, empty, (<|>), liftA2)+import Control.Applicative import Data.Monoid.Reducer+import Data.Ring.Semi.Near+import Control.Functor.Pointed +-- | A 'Traversal' uses an glues together 'Applicative' actions with (*>)+--   in the manner of 'traverse_' from "Data.Foldable". Any values returned by +--   reduced actions are discarded. newtype Traversal f = Traversal { getTraversal :: f () }   instance Applicative f => Monoid (Traversal f) where@@ -22,38 +40,32 @@     a `cons` Traversal b = Traversal (a *> b)     Traversal a `snoc` b = Traversal (a *> b *> pure ()) - {-# RULES "unitTraversal" unit = Traversal #-} {-# RULES "snocTraversal" snoc = snocTraversal #-}++-- | Efficiently avoid needlessly rebinding when using 'snoc' on an action that already returns ()+--   A rewrite rule automatically applies this when possible snocTraversal :: Reducer (f ()) (Traversal f) => Traversal f -> f () -> Traversal f snocTraversal a = mappend a . Traversal -newtype Alternate f a = Alternate { getAlternate :: f a } -    deriving (Eq,Ord,Show,Read,Functor,Applicative,Alternative) -instance Alternative f => Monoid (Alternate f a) where-    mempty = empty -    Alternate a `mappend` Alternate b = Alternate (a <|> b) --instance Alternative f => Reducer (f a) (Alternate f a) where-    unit = Alternate-    a `cons` Alternate b = Alternate (a <|> b) -    Alternate a `snoc` b = Alternate (a <|> b)--instance Pointed f => Pointed (Alternate f) where-    point = Alternate . point+-- | A 'WrappedApplicative' turns any 'Alternative' instance into a 'Monoid'.+--   It also provides a 'Multiplicative' instance for an 'Applicative' functor wrapped around a 'Monoid'+--   and asserts that any 'Alternative' applied to a 'Monoid' forms a 'LeftSemiNearRing' +--   under these operations. -newtype TraversalWith f n = TraversalWith { getTraversalWith :: f n }+newtype WrappedApplicative f a = WrappedApplicative { getWrappedApplicative :: f a } +    deriving (Eq,Ord,Show,Read,Functor,Pointed,Applicative,Alternative,Copointed) -instance (Applicative f, Monoid n) => Monoid (TraversalWith f n) where-    mempty = TraversalWith (pure mempty)-    TraversalWith a `mappend` TraversalWith b = TraversalWith (liftA2 mappend a b)+instance Alternative f => Monoid (WrappedApplicative f a) where+    mempty = empty +    WrappedApplicative a `mappend` WrappedApplicative b = WrappedApplicative (a <|> b)  -instance (Applicative f, Monoid n) => Reducer (f n) (TraversalWith f n) where-    unit = TraversalWith+instance (Alternative f, Monoid a) => Multiplicative (WrappedApplicative f a) where+    one = pure mempty+    times = liftA2 mappend -instance Functor f => Functor (TraversalWith f) where-    fmap f = TraversalWith . fmap f . getTraversalWith+instance (Alternative f, c `Reducer` a) => Reducer c (WrappedApplicative f a) where+    unit = WrappedApplicative . pure . unit -instance Pointed f => Pointed (TraversalWith f) where-    point = TraversalWith . point+instance (Alternative f, Monoid a) => LeftSemiNearRing (WrappedApplicative f a)
Data/Monoid/Categorical.hs view
@@ -1,29 +1,52 @@-{-# LANGUAGE GADTs #-}+{-# LANGUAGE GADTs, FlexibleInstances, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid.Categorical+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-----------------------------------------------------------------------------+ module Data.Monoid.Categorical-    ( module Data.Monoid-    , Endo(Endo, getEndo)+    ( module Data.Monoid.Reducer+    , module Control.Category+    -- * Generalized Endo+    , GEndo(GEndo, getGEndo)+    -- * Monoids as Categories     , Mon(Mon)-    , runMon+    , getMon     ) where  import Prelude hiding ((.),id)-import Data.Monoid (Monoid, mempty, mappend) +import Data.Monoid.Reducer import Control.Category --- | The 'Monoid' of endomorphisms over some object in an arbitrary 'Category'-data Endo k a = Endo { getEndo :: k a a } +-- | The 'Monoid' of the endomorphisms over some object in an arbitrary 'Category'.+data GEndo k a = GEndo { getGEndo :: k a a }  -instance Category k =>  Monoid (Endo k a) where-    mempty = Endo id-    Endo f `mappend` Endo g = Endo (f . g)+instance Category k =>  Monoid (GEndo k a) where+    mempty = GEndo id+    GEndo f `mappend` GEndo g = GEndo (f . g)  -- | A 'Monoid' is just a 'Category' with one object.  data Mon m n o where     Mon :: Monoid m => m -> Mon m a a -runMon :: Mon m m m -> m -runMon (Mon m) = m+-- | Extract the 'Monoid' from its representation as a 'Category'+getMon :: Mon m m m -> m +getMon (Mon m) = m  instance Monoid m => Category (Mon m) where     id = Mon mempty     Mon a . Mon b = Mon (a `mappend` b)++instance Monoid m => Monoid (Mon m m m) where+    mempty = id+    mappend = (.)++instance (c `Reducer` m) => Reducer c (Mon m m m) where+    unit = Mon . unit
+ Data/Monoid/Combinators.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid.Combinators+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable (type families, MPTCs)+--+-- Utilities for working with Monoids that conflict with names from the "Prelude",+-- "Data.Foldable", "Control.Monad" or elsewhere. Intended to be imported qualified.+--+-- > import Data.Group.Combinators as Monoid +--+-----------------------------------------------------------------------------++module Data.Monoid.Combinators+    ( module Data.Monoid.Generator+    -- * Monadic Reduction+    , mapM_+    , forM_+    -- * Applicative Reduction+    , traverse_+    , for_+    -- * Logical Reduction+    , and+    , or+    , any+    , all+    -- * Monoidal Reduction+    , foldMap+    , fold+    -- * List-Like Reduction+    , concatMap+    , elem+    , filter+    , find+    , sum+    , product+    , notElem+    -- * List-Like Monoid Generation+    , repeat+    , replicate+    , cycle+    ) where++import Prelude hiding (mapM_, any, elem, filter, concatMap, and, or, all, sum, product, notElem, replicate, cycle, repeat)+import Control.Applicative+import Data.Monoid.Generator+import Data.Monoid.Applicative+import Data.Monoid.Self+import Data.Monoid.Monad++-- | Efficiently 'mapReduce' a 'Generator' using the 'Traversal' monoid. A specialized version of its namesake in "Data.Foldable"+traverse_ :: (Generator c, Applicative f) => (Elem c -> f b) -> c -> f ()+traverse_ f = getTraversal . mapReduce f+    +-- | flipped 'traverse_' as in "Data.Foldable"+for_ :: (Generator c, Applicative f) => c -> (Elem c -> f b) -> f ()+for_ = flip traverse_++-- | Efficiently 'mapReduce' a 'Generator' using the 'Action' monoid. A specialized version of its namesake from "Data.Foldable" and "Control.Monad"+mapM_ :: (Generator c, Monad m) => (Elem c -> m b) -> c -> m ()+mapM_ f = getAction . mapReduce f++-- | flipped 'mapM_' as in "Data.Foldable" and "Control.Monad"+forM_ :: (Generator c, Monad m) => c -> (Elem c -> m b) -> m ()+forM_ = flip mapM_++-- | Efficiently 'mapReduce' a 'Generator' using the 'Self' monoid. A specialized version of its namesake from "Data.Foldable"+foldMap :: (Monoid m, Generator c) => (Elem c -> m) -> c -> m+foldMap f = getSelf . mapReduce f++-- | Efficiently 'reduce' a 'Generator' using the 'Self' monoid. A specialized version of its namesake from "Data.Foldable"+fold :: (Monoid m, Generator c, Elem c ~ m) => c -> m+fold = getSelf . reduce++-- | A further specialization of "foldMap"+concatMap :: Generator c => (Elem c -> [b]) -> c -> [b]+concatMap = foldMap++-- | Efficiently 'reduce' a 'Generator' that contains values of type 'Bool'+and :: (Generator c, Elem c ~ Bool) => c -> Bool+and = getAll . reduce++-- | Efficiently 'reduce' a 'Generator' that contains values of type 'Bool'+or :: (Generator c, Elem c ~ Bool) => c -> Bool+or = getAny . reduce++-- | Efficiently 'mapReduce' any 'Generator' checking to see if any of its values match the supplied predicate+any :: Generator c => (Elem c -> Bool) -> c -> Bool+any f = getAny . mapReduce f++-- | Efficiently 'mapReduce' any 'Generator' checking to see if all of its values match the supplied predicate+all :: Generator c => (Elem c -> Bool) -> c -> Bool+all f = getAll . mapReduce f++-- | Efficiently 'mapReduce' any 'Generator' using the 'Sum' 'Monoid'+sum :: (Generator c, Num (Elem c)) => c -> Elem c+sum = getSum . reduce++-- | Efficiently 'mapReduce' any 'Generator' using the 'Product' 'Monoid'+product :: (Generator c, Num (Elem c)) => c -> Elem c+product = getProduct . reduce++-- | Check to see if 'any' member of the 'Generator' matches the supplied value+elem :: (Generator c, Eq (Elem c)) => Elem c -> c -> Bool+elem = any . (==)++-- | Check to make sure that the supplied value is not a member of the 'Generator'+notElem :: (Generator c, Eq (Elem c)) => Elem c -> c -> Bool+notElem x = not . elem x++-- | Efficiently 'mapReduce' a subset of the elements in a 'Generator'+filter :: (Generator c, Elem c `Reducer` m) => (Elem c -> Bool) -> c -> m+filter p = foldMap f where+    f x | p x = unit x+        | otherwise = mempty++-- | A specialization of 'filter' using the 'First' 'Monoid', analogous to 'Data.List.find'+find :: Generator c => (Elem c -> Bool) -> c -> Maybe (Elem c)+find p = getFirst . filter p++-- | A generalization of 'Data.List.replicate' to an arbitrary 'Monoid'. Adapted from +-- <http://augustss.blogspot.com/2008/07/lost-and-found-if-i-write-108-in.html>+replicate :: (Monoid m, Integral n) => m -> n -> m+replicate x0 y0 +    | y0 < 0 = mempty -- error "negative length"+    | y0 == 0 = mempty+    | otherwise = f x0 y0+    where+        f x y +            | even y = f (x `mappend` x) (y `quot` 2)+            | y == 1 = x+            | otherwise = g (x `mappend` x) ((y - 1) `quot` 2) x+        g x y z +            | even y = g (x `mappend` x) (y `quot` 2) z+            | y == 1 = x `mappend` z+            | otherwise = g (x `mappend` x) ((y - 1) `quot` 2) (x `mappend` z)++-- | A generalization of 'Data.List.cycle' to an arbitrary 'Monoid'. May fail to terminate for some values in some monoids.+cycle :: Monoid m => m -> m+cycle xs = xs' where xs' = xs `mappend` xs'++-- | A generalization of 'Data.List.repeat' to an arbitrary 'Monoid'. May fail to terminate for some values in some monoids.+repeat :: (e `Reducer` m) => e -> m +repeat x = xs where xs = cons x xs
Data/Monoid/FromString.hs view
@@ -1,11 +1,28 @@ {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid.Additive+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable (overloaded strings, MPTCs)+--+-- Transform any 'Char' 'Reducer' into an 'IsString' instance so it can be+-- used directly with overloaded string literals.+--+-----------------------------------------------------------------------------+ module Data.Monoid.FromString -    ( FromString(FromString,getFromString)+    ( module Data.Monoid.Reducer+    , FromString(FromString,getFromString)     ) where  import Control.Functor.Pointed import Data.Monoid.Generator import Data.Monoid.Reducer+import Data.Monoid.Instances () import GHC.Exts  data FromString m = FromString { getFromString :: m } @@ -14,10 +31,10 @@     mempty = FromString mempty     FromString a `mappend` FromString b = FromString (a `mappend` b) -instance Reducer Char m => Reducer Char (FromString m) where+instance (Char `Reducer` m) => Reducer Char (FromString m) where     unit = FromString . unit -instance Reducer Char m => IsString (FromString m) where+instance (Char `Reducer` m) => IsString (FromString m) where     fromString = FromString . reduce  instance Pointed FromString where
Data/Monoid/Generator.hs view
@@ -1,4 +1,23 @@ {-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid.Generator+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- A 'Generator' @c@ is a possibly-specialized container, which contains values of +-- type 'Elem' @c@, and which knows how to efficiently apply a 'Reducer' to extract+-- an answer.+--+-- Since a 'Generator' is not polymorphic in its contents, it is more specialized+-- than "Data.Foldable.Foldable", and a 'Reducer' may supply efficient left-to-right+-- and right-to-left reduction strategies that a 'Generator' may avail itself of.+-----------------------------------------------------------------------------+ module Data.Monoid.Generator     ( module Data.Monoid.Reducer     , Generator@@ -12,6 +31,7 @@     , Char8(Char8, getChar8)     ) where +import Data.Array  import Data.Word (Word8) import Data.Text (Text) import Data.Foldable (fold,foldMap)@@ -35,7 +55,7 @@ import Control.Parallel.Strategies import Data.Monoid.Reducer --- minimal definition mapReduce or affixMapReduce+-- | minimal definition 'mapReduce' or 'mapTo' class Generator c where     type Elem c :: *      mapReduce :: (e `Reducer` m) => (Elem c -> e) -> c -> m@@ -54,16 +74,6 @@     type Elem Lazy.ByteString = Word8     mapReduce f = fold . parMap rwhnf (mapReduce f) . Lazy.toChunks -newtype Char8 c = Char8 { getChar8 :: c } --instance Generator (Char8 Strict.ByteString) where-    type Elem (Char8 Strict.ByteString) = Char-    mapTo f m = Strict8.foldl' (\a -> snoc a . f) m . getChar8--instance Generator (Char8 Lazy.ByteString) where-    type Elem (Char8 Lazy.ByteString) = Char-    mapReduce f = fold . parMap rwhnf (mapReduce f . Char8) . Lazy8.toChunks . getChar8- instance Generator Text where     type Elem Text = Char     mapTo f = Text.foldl' (\a -> snoc a . f)@@ -96,6 +106,11 @@     type Elem (Map k v) = (k,v)      mapReduce f = mapReduce f . Map.toList +instance Ix i => Generator (Array i e) where+    type Elem (Array i e) = (i,e)+    mapReduce f = mapReduce f . assocs++-- | a 'Generator' transformer that asks only for the keys of an indexed container newtype Keys c = Keys { getKeys :: c }   instance Generator (Keys (IntMap v)) where@@ -106,6 +121,11 @@     type Elem (Keys (Map k v)) = k     mapReduce f = mapReduce f . Map.keys . getKeys +instance Ix i => Generator (Keys (Array i e)) where+    type Elem (Keys (Array i e)) = i+    mapReduce f = mapReduce f . range . bounds . getKeys++-- | a 'Generator' transformer that asks only for the values contained in an indexed container newtype Values c = Values { getValues :: c }   instance Generator (Values (IntMap v)) where@@ -116,6 +136,22 @@     type Elem (Values (Map k v)) = v     mapReduce f = mapReduce f . Map.elems . getValues +instance Ix i => Generator (Values (Array i e)) where+    type Elem (Values (Array i e)) = e+    mapReduce f = mapReduce f . elems . getValues++-- | a 'Generator' transformer that treats 'Word8' as 'Char'+-- This lets you use a 'ByteString' as a 'Char' source without going through a 'Monoid' transformer like 'UTF8'+newtype Char8 c = Char8 { getChar8 :: c } ++instance Generator (Char8 Strict.ByteString) where+    type Elem (Char8 Strict.ByteString) = Char+    mapTo f m = Strict8.foldl' (\a -> snoc a . f) m . getChar8++instance Generator (Char8 Lazy.ByteString) where+    type Elem (Char8 Lazy.ByteString) = Char+    mapReduce f = fold . parMap rwhnf (mapReduce f . Char8) . Lazy8.toChunks . getChar8+ {-# SPECIALIZE reduce :: (Word8 `Reducer` m) => Strict.ByteString -> m #-} {-# SPECIALIZE reduce :: (Word8 `Reducer` m) => Lazy.ByteString -> m #-} {-# SPECIALIZE reduce :: (Char `Reducer` m) => Char8 Strict.ByteString -> m #-}@@ -132,5 +168,6 @@ {-# SPECIALIZE reduce :: (k `Reducer` m) => Keys (Map k v) -> m #-} {-# SPECIALIZE reduce :: (v `Reducer` m) => Values (IntMap v) -> m #-} {-# SPECIALIZE reduce :: (v `Reducer` m) => Values (Map k v) -> m #-}+-- | Apply a 'Reducer' directly to the elements of a 'Generator' reduce :: (Generator c, Elem c `Reducer` m) => c -> m reduce = mapReduce id
− Data/Monoid/Generator/Combinators.hs 
@@ -1,76 +0,0 @@-{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeFamilies, ScopedTypeVariables #-}-module Data.Monoid.Generator.Combinators-    ( module Data.Monoid.Generator-    , traverse_-    , for_-    , mapM_-    , forM_-    , foldMap'-    , concatMap-    , and-    , or-    , any-    , all-    , sum-    , product-    , elem-    , notElem-    , filter-    , find-    ) where--import Prelude hiding (mapM_, any, elem, filter, concatMap, and, or, all, sum, product, notElem)-import Data.Monoid.Generator-import Data.Monoid.Applicative-import Data.Monoid.Monad-import Data.Monoid.Monad.Identity hiding (mapM_, forM_)--traverse_ :: (Generator c, Applicative f) => (Elem c -> f b) -> c -> f ()-traverse_ f = getTraversal . mapReduce f-    -for_ :: (Generator c, Applicative f) => c -> (Elem c -> f b) -> f ()-for_ = flip traverse_--mapM_ :: (Generator c, Monad m) => (Elem c -> m b) -> c -> m ()-mapM_ f = getAction . mapReduce f--forM_ :: (Generator c, Monad m) => c -> (Elem c -> m b) -> m ()-forM_ = flip mapM_--foldMap' :: (Monoid m, Generator c) => (Elem c -> m) -> c -> m-foldMap' f = runIdentity . mapReduce f--concatMap :: Generator c => (Elem c -> [b]) -> c -> [b]-concatMap = foldMap'--and :: (Generator c, Elem c ~ Bool) => c -> Bool-and = getAll . reduce--or :: (Generator c, Elem c ~ Bool) => c -> Bool-or = getAny . reduce--any :: Generator c => (Elem c -> Bool) -> c -> Bool-any f = getAny . mapReduce f--all :: Generator c => (Elem c -> Bool) -> c -> Bool-all f = getAll . mapReduce f--sum :: (Generator c, Num (Elem c)) => c -> Elem c-sum = getSum . reduce--product :: (Generator c, Num (Elem c)) => c -> Elem c-product = getProduct . reduce--elem :: (Generator c, Eq (Elem c)) => Elem c -> c -> Bool-elem = any . (==)--notElem :: (Generator c, Eq (Elem c)) => Elem c -> c -> Bool-notElem x = not . elem x--filter :: (Generator c, Elem c `Reducer` m) => (Elem c -> Bool) -> c -> m-filter p = foldMap' f where-    f x | p x = unit x-        | otherwise = mempty--find :: Generator c => (Elem c -> Bool) -> c -> Maybe (Elem c)-find p = getFirst . filter p
− Data/Monoid/IntMap.hs 
@@ -1,17 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-module Data.Monoid.IntMap -    ( module Data.Monoid.Reducer-    , UnionWith(getUnionWith)-    ) where--import Data.Monoid.Reducer (Reducer, unit, cons, snoc, Monoid, mappend, mempty)-import Data.IntMap--newtype UnionWith m = UnionWith { getUnionWith :: IntMap m } --instance Monoid m => Monoid (UnionWith m) where-    mempty = UnionWith empty-    UnionWith a `mappend` UnionWith b = UnionWith (unionWith mappend a b)--instance Monoid m => Reducer (IntMap m) (UnionWith m) where-    unit = UnionWith
+ Data/Monoid/Lexical/RunLengthEncoding.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid.Lexical.RunLengthEncoding+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs)+--+-- A simple 'Monoid' transformer that turns any monoidal 'Reducer' into a+-- a reducer that expects to be supplied both a run length @n@ with each item+-- and which efficiently exponentiates the result of 'unit' @n@ times through +-- 'replicate'.+--+-----------------------------------------------------------------------------++module Data.Monoid.Lexical.RunLengthEncoding +    ( module Data.Monoid.Reducer+    , RLE(RLE,getRLE) +    ) where++import Prelude hiding (replicate)+import Data.Monoid.Reducer+import Data.Monoid.Combinators (replicate)++newtype RLE n m = RLE { getRLE :: m } ++instance (Integral n, Monoid m) => Monoid (RLE n m) where+    mempty = RLE mempty+    RLE a `mappend` RLE b = RLE (a `mappend` b)++instance (Integral n, Reducer c m) => Reducer (n,c) (RLE n m) where+    unit ~(n,c) = RLE $ replicate (unit c) n
Data/Monoid/Lexical/SourcePosition.hs view
@@ -1,6 +1,26 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid.Lexical.SourcePosition+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs, OverloadedStrings)+--+-- Incrementally determine locations in a source file through local information+-- This allows for efficient recomputation of line #s and token locations+-- while the file is being interactively updated by storing this as a supplemental+-- measure on a 'FingerTree'.+--+-- The general idea is to use this as part of a measure in a 'FingerTree' so you can+-- use `mappend` to prepend a 'startOfFile' with the file information.+-----------------------------------------------------------------------------+ module Data.Monoid.Lexical.SourcePosition     ( module Data.Monoid.Reducer.Char+    , nextTab     , SourcePosition     , SourceLine     , SourceColumn@@ -14,16 +34,22 @@ import Control.Functor.Extras import Control.Functor.Pointed import Data.Monoid.Reducer.Char+import Data.Monoid.Generator+import Data.String  type SourceLine = Int type SourceColumn = Int -data SourcePosition file = Pos file {-# UNPACK #-} !SourceLine !SourceColumn-         | Lines {-# UNPACK #-} !SourceLine !SourceColumn-         | Columns {-# UNPACK #-} !SourceColumn-         | Tab {-# UNPACK #-} !SourceColumn !SourceColumn -- cols before and after an unresolved tab+-- | A 'Monoid' of partial information about locations in a source file.+--   This is polymorphic in the kind of information you want to maintain about each source file.+data SourcePosition file +        = Pos file {-# UNPACK #-} !SourceLine !SourceColumn -- ^ An absolute position in a file is known, or an overriding #line directive has been seen+        | Lines {-# UNPACK #-} !SourceLine !SourceColumn    -- ^ We've seen some carriage returns.+        | Columns {-# UNPACK #-} !SourceColumn              -- ^ We've only seen part of a line.+        | Tab {-# UNPACK #-} !SourceColumn !SourceColumn    -- ^ We have an unhandled tab to deal with.     deriving (Read,Show,Eq) +-- | Compute the location of the next standard 8-column aligned tab nextTab :: Int -> Int nextTab x = x + (8 - (x-1) `mod` 8) @@ -42,6 +68,10 @@ instance FunctorPlus SourcePosition where     fplus = mappend +instance IsString (SourcePosition file) where+    fromString = reduce++-- accumulate partial information instance Monoid (SourcePosition file) where     mempty = Columns 0 @@ -63,20 +93,25 @@     unit '\t' = Tab 0 0      unit _    = Columns 1 +-- Indicate that we ignore invalid characters to the UTF8 parser instance CharReducer (SourcePosition file)     +-- | lift information about a source file into a starting 'SourcePosition' for that file startOfFile :: f -> SourcePosition f startOfFile = point +-- | extract partial information about the current column, even in the absence of knowledge of the source file sourceColumn :: SourcePosition f -> Maybe SourceColumn sourceColumn (Pos _ _ c) = Just c sourceColumn (Lines _ c) = Just c sourceColumn _ = Nothing +-- | extract partial information about the current line number if possible sourceLine :: SourcePosition f -> Maybe SourceLine sourceLine (Pos _ l _) = Just l sourceLine _ = Nothing +-- | extract the standard format for an absolute source position showSourcePosition :: SourcePosition String -> String showSourcePosition pos = showSourcePosition' (point "-" `mappend` pos) where     showSourcePosition' (Pos f l c) = f ++ ":" ++ show l ++ ":" ++ show c
Data/Monoid/Lexical/UTF8/Decoder.hs view
@@ -1,4 +1,43 @@ {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid.Lexical.UTF8.Decoder+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs)+--+-- UTF8 encoded unicode characters can be parsed both forwards and backwards,+-- since the start of each 'Char' is clearly marked. This 'Monoid' accumulates+-- information about the characters represented and reduces that information+-- using a 'CharReducer', which is just a 'Reducer' 'Monoid' that knows what +-- it wants to do about an 'invalidChar' -- a  string of 'Word8' values that +-- don't form a valid UTF8 character.+--+-- As this monoid parses chars it just feeds them upstream to the underlying+-- CharReducer. Efficient left-to-right and right-to-left traversals are +-- supplied so that a lazy 'ByteString' can be parsed efficiently by +-- chunking it into strict chunks, and batching the traversals over each+-- before stitching the edges together.+--+-- Because this needs to be a 'Monoid' and should return the exact same result+-- regardless of forward or backwards parsing, it chooses to parse only +-- canonical UTF8 unlike most Haskell UTF8 parsers, which will blissfully +-- accept illegal alternative long encodings of a character. +--+-- This actually fixes a potential class of security issues in some scenarios:+--+-- <http://prowebdevelopmentblog.com/content/big-overhaul-java-utf-8-charset>+--+-- NB: Due to naive use of a list to track the tail of an unfinished character +-- this may exhibit @O(n^2)@ behavior parsing backwards along an invalid sequence +-- of a large number of bytes that all claim to be in the tail of a character.+--+-----------------------------------------------------------------------------++ module Data.Monoid.Lexical.UTF8.Decoder      ( module Data.Monoid.Reducer.Char     , UTF8@@ -7,6 +46,7 @@      import Data.Bits (shiftL,(.&.),(.|.)) import Data.Word (Word8)+  import Control.Functor.Pointed
Data/Monoid/Lexical/Words.hs view
@@ -1,26 +1,47 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, GeneralizedNewtypeDeriving, ParallelListComp, TypeFamilies #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, GeneralizedNewtypeDeriving, ParallelListComp, TypeFamilies, OverloadedStrings, UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid.Lexical.Words+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs, OverloadedStrings)+--+-- A simple demonstration of tokenizing a 'Generator' into distinct words +-- and/or lines using a word-parsing 'Monoid' that accumulates partial +-- information about words and then builds up a token stream.+--+-----------------------------------------------------------------------------+ module Data.Monoid.Lexical.Words      ( module Data.Monoid.Reducer.Char+    -- * Words     , Words     , runWords+    , Unspaced(runUnspaced)+    , wordsFrom+    -- * Lines     , Lines     , runLines-    , Unspaced(runUnspaced)     , Unlined(runUnlined)-    , wordsFrom     , linesFrom     ) where +import Data.String import Data.Char (isSpace) import Data.Maybe (maybeToList) import Data.Monoid.Reducer.Char import Data.Monoid.Generator import Control.Functor.Pointed +-- | A 'CharReducer' transformer that breaks a 'Char' 'Generator' into distinct words, feeding a 'Char' 'Reducer' each line in turn data Words m = Chunk (Maybe m)              | Segment (Maybe m) [m] (Maybe m)     deriving (Show,Read) +-- | Extract the matched words from the 'Words' 'Monoid' runWords :: Words m -> [m] runWords (Chunk m) = maybeToList m runWords (Segment l m r) = maybeToList l ++ m ++ maybeToList r@@ -40,17 +61,30 @@     fmap f (Chunk m) = Chunk (fmap f m)     fmap f (Segment m ms m') = Segment (fmap f m) (fmap f ms) (fmap f m') --- abuse the same machinery to handle lines as well+instance (CharReducer m) => CharReducer (Words m) where+    invalidChar xs = Segment (Just (invalidChar xs)) [] mempty +instance Reducer Char m => IsString (Words m) where+    fromString = reduce++-- | A 'CharReducer' transformer that breaks a 'Char' 'Generator' into distinct lines, feeding a 'Char' 'Reducer' each line in turn. newtype Lines m = Lines (Words m) deriving (Show,Read,Monoid,Functor)  instance Reducer Char m => Reducer Char (Lines m) where     unit '\n' = Lines $ Segment (Just (unit '\n')) [] mempty     unit c = Lines $ Chunk (Just (unit c)) +instance (CharReducer m) => CharReducer (Lines m) where+    invalidChar xs = Lines $ Segment (Just (invalidChar xs)) [] mempty++instance Reducer Char m => IsString (Lines m) where+    fromString = reduce++-- | Extract the matched lines from the 'Lines' 'Monoid' runLines :: Lines m -> [m] runLines (Lines x) = runWords x +-- | A 'CharReducer' transformer that strips out any character matched by `isSpace` newtype Unspaced m = Unspaced { runUnspaced :: m }  deriving (Eq,Ord,Show,Read,Monoid)  instance Reducer Char m => Reducer Char (Unspaced m) where@@ -69,6 +103,10 @@ instance Copointed Unspaced where     extract = runUnspaced +instance Reducer Char m => IsString (Unspaced m) where+    fromString = reduce++-- | A 'CharReducer' transformer that strips out newlines newtype Unlined m = Unlined { runUnlined :: m }  deriving (Eq,Ord,Show,Read,Monoid)  instance Reducer Char m => Reducer Char (Unlined m) where@@ -87,12 +125,15 @@ instance Copointed Unlined where     extract = runUnlined --- accumulator, inside-word, and until-next-word monoids+instance Reducer Char m => IsString (Unlined m) where+    fromString = reduce++-- | Utility function to extract words using accumulator, inside-word, and until-next-word monoids wordsFrom :: (Generator c, Elem c ~ Char, Char `Reducer` m, Char `Reducer` n, Char `Reducer` o) => m -> c -> [(m,n,o)] wordsFrom s c = [(x,runUnlined y,z) | x <- scanl mappend s ls | (y,z) <- rs ] where     (ls,rs) = unzip (runWords (mapReduce id c)) --- accumulator, inside-line, and until-next-line monoids+-- | Utility function to extract lines using accumulator, inside-line, and until-next-line monoids linesFrom :: (Generator c, Elem c ~ Char, Char `Reducer` m, Char `Reducer` n, Char `Reducer` o) => m -> c -> [(m,n,o)] linesFrom s c = [(x,runUnlined y,z) | x <- scanl mappend s ls | (y,z) <- rs ] where     (ls,rs) = unzip (runLines (mapReduce id c))
− Data/Monoid/Map.hs 
@@ -1,20 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-module Data.Monoid.Map -    ( module Data.Monoid.Reducer-    , UnionWith(getUnionWith)-    ) where--import Prelude (Ord)-import Data.Monoid.Reducer (Reducer, unit, cons, snoc, Monoid, mempty, mappend)-import Data.Map---- only needs m to be a semigroup, but Haskell doesn't have a semigroup class--newtype UnionWith k m = UnionWith { getUnionWith :: Map k m } --instance (Ord k, Monoid m) => Monoid (UnionWith k m) where-    mempty = UnionWith empty-    UnionWith a `mappend` UnionWith b = UnionWith (unionWith mappend a b)--instance (Ord k, Monoid m) => Reducer (Map k m) (UnionWith k m) where-    unit = UnionWith
Data/Monoid/Monad.hs view
@@ -1,15 +1,36 @@ {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid.Applicative+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs)+--+-- 'Monoid' instances for working with a 'Monad'+--+-----------------------------------------------------------------------------+ module Data.Monoid.Monad -    ( module Control.Monad-    , module Data.Monoid.Reducer+    ( module Data.Monoid.Reducer+    , module Data.Ring.Semi.Near+    -- * Actions     , Action(Action,getAction)-    , MonadSum(MonadSum,getMonadSum)-    , ActionWith(ActionWith,getActionWith)+    , snocAction+    -- * Wrapped Monads+    , WrappedMonad(WrappedMonad, getWrappedMonad)     ) where +import Control.Functor.Pointed import Data.Monoid.Reducer-import Control.Monad (MonadPlus, mplus, mzero, (>=>), liftM2)+import Data.Ring.Semi.Near+import Control.Monad +-- | An 'Action' uses glues together 'Monad' actions with (>>)+--   in the manner of 'mapM_' from "Data.Foldable". Any values returned by +--   reduced actions are discarded. newtype Action m = Action { getAction :: m () }   instance Monad m => Monoid (Action m) where@@ -23,24 +44,29 @@  {-# RULES "unitAction" unit = Action #-} {-# RULES "snocAction" snoc = snocAction #-} ++-- | Efficiently avoid needlessly rebinding when using 'snoc' on an action that already returns ()+--   A rewrite rule automatically applies this when possible snocAction :: Reducer (m ()) (Action m) => Action m -> m () -> Action m snocAction a = mappend a . Action -newtype MonadSum m a = MonadSum { getMonadSum :: m a } -    deriving (Eq,Ord,Show,Read,Functor,Monad,MonadPlus)--instance MonadPlus m => Monoid (MonadSum m a) where-    mempty = MonadSum mzero-    MonadSum a `mappend` MonadSum b = MonadSum (a `mplus` b)+-- | A 'WrappedMonad' turns any 'MonadPlus' instance into a 'Monoid'.+--   It also provides a 'Multiplicative' instance for a 'Monad' wrapped around a 'Monoid'+--   and asserts that any 'MonadPlus' applied to a 'Monoid' forms a 'LeftSemiNearRing' +--   under these operations. -instance MonadPlus m => Reducer (m a) (MonadSum m a) where-    unit = MonadSum+newtype WrappedMonad m a = WrappedMonad { getWrappedMonad :: m a } +    deriving (Eq,Ord,Show,Read,Functor,Pointed, Monad,MonadPlus) -newtype ActionWith m n = ActionWith { getActionWith :: m n }+instance (Monad m, Monoid a) => Multiplicative (WrappedMonad m a) where+    one = WrappedMonad (return mempty)+    WrappedMonad m `times` WrappedMonad n = WrappedMonad (liftM2 mappend m n)+    +instance (MonadPlus m) => Monoid (WrappedMonad m a) where+    mempty = mzero+    mappend = mplus -instance (Monad m, Monoid n) => Monoid (ActionWith m n) where-    mempty = ActionWith (return mempty)-    ActionWith a `mappend` ActionWith b = ActionWith (liftM2 mappend a b)+instance (MonadPlus m, c `Reducer` a) => Reducer c (WrappedMonad m a) where+    unit = WrappedMonad . return . unit -instance (Monad m, Monoid n) => Reducer (m n) (ActionWith m n) where-    unit = ActionWith+instance (MonadPlus m, Monoid a) => LeftSemiNearRing (WrappedMonad m a)
− Data/Monoid/Monad/Cont.hs 
@@ -1,27 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}--module Data.Monoid.Monad.Cont-    ( module Control.Monad.Cont-    , module Data.Monoid.Reducer-    )  where--import Control.Monad.Cont-import Data.Monoid.Reducer--instance (Monoid m) => Monoid (Cont r m) where-    mempty = return mempty-    mappend = liftM2 mappend--instance (Monad m, Monoid n) => Monoid (ContT r m n) where-    mempty = return mempty -    mappend = liftM2 mappend--instance Monoid m => Reducer m (Cont r m) where-    unit = return--instance (Monad m, Monoid n) => Reducer n (ContT r m n) where-    unit = return--instance (Monad m, Monoid n) => Reducer (m n) (ContT r m n) where-    unit = lift
− Data/Monoid/Monad/Either.hs 
@@ -1,36 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}--module Data.Monoid.Monad.Either-    ( module Control.Monad.Either -- from category extras-    , module Data.Monoid.Reducer-    )  where--import Control.Monad.Either-import Data.Monoid.Reducer--instance Monoid m => Monoid (Either e m) where-    mempty = return mempty-    x `mappend` y = do -        x' <- x-        y' <- y-        return (x' `mappend` y')--instance Monoid m => Reducer m (Either e m) where-    unit = return--instance (Monad m, Monoid n) => Monoid (EitherT e m n) where-    mempty = return mempty -    x `mappend` y = do-        x' <- x-        y' <- y-        return (x' `mappend` y')--instance (Monad m, Monoid n) => Reducer n (EitherT e m n) where-    unit = return--instance (Monad m, Monoid n) => Reducer (m n) (EitherT e m n) where-    unit = EitherT . liftM return--liftM :: Monad m => (a -> b) -> m a -> m b-liftM f x = do x' <- x; return (f x')
− Data/Monoid/Monad/IO.hs 
@@ -1,28 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}---module Data.Monoid.Monad.IO-    ( module System.IO-    , module Data.Monoid.Reducer-    , module Control.Monad-    )  where--import System.IO-import Data.Monoid.Reducer-import Control.Monad-import Control.Monad.ST-import Control.Concurrent.STM--instance Monoid m => Monoid (IO m) where-    mempty = return mempty-    mappend = liftM2 mappend--instance Monoid m => Reducer m (IO m) where-    unit = return--instance Monoid m => Reducer (ST RealWorld m) (IO m) where-    unit = stToIO--instance Monoid m => Reducer (STM m) (IO m) where-    unit = atomically
− Data/Monoid/Monad/Identity.hs 
@@ -1,17 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}--module Data.Monoid.Monad.Identity-    ( module Control.Monad.Identity-    , module Data.Monoid.Reducer-    )  where--import Control.Monad.Identity-import Data.Monoid.Reducer--instance Monoid m => Monoid (Identity m) where-    mempty = return mempty-    mappend = liftM2 mappend--instance Monoid m => Reducer m (Identity m) where-    unit = Identity
− Data/Monoid/Monad/RWS/Lazy.hs 
@@ -1,27 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}--module Data.Monoid.Monad.RWS.Lazy-    ( module Control.Monad.RWS.Lazy-    , module Data.Monoid.Reducer-    )  where--import Control.Monad.RWS.Lazy-import Data.Monoid.Reducer--instance (Monoid w, Monoid m) => Monoid (RWS r w s m) where-    mempty = return mempty-    mappend = liftM2 mappend--instance (Monad m, Monoid w, Monoid n) => Monoid (RWST r w s m n) where-    mempty = return mempty -    mappend = liftM2 mappend--instance (Monoid w, Monoid m) => Reducer m (RWS r w s m) where-    unit = return--instance (Monad m, Monoid w, Monoid n) => Reducer n (RWST r w s m n) where-    unit = return--instance (Monad m, Monoid w, Monoid n) => Reducer (m n) (RWST r w s m n) where-    unit = lift
− Data/Monoid/Monad/RWS/Strict.hs 
@@ -1,28 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}---module Data.Monoid.Monad.RWS.Strict-    ( module Control.Monad.RWS.Strict-    , module Data.Monoid.Reducer-    )  where--import Control.Monad.RWS.Strict-import Data.Monoid.Reducer--instance (Monoid w, Monoid m) => Monoid (RWS r w s m) where-    mempty = return mempty-    mappend = liftM2 mappend--instance (Monad m, Monoid w, Monoid n) => Monoid (RWST r w s m n) where-    mempty = return mempty -    mappend = liftM2 mappend--instance (Monoid w, Monoid m) => Reducer m (RWS r w s m) where-    unit = return--instance (Monad m, Monoid w, Monoid n) => Reducer n (RWST r w s m n) where-    unit = return--instance (Monad m, Monoid w, Monoid n) => Reducer (m n) (RWST r w s m n) where-    unit = lift
− Data/Monoid/Monad/Reader.hs 
@@ -1,27 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}--module Data.Monoid.Monad.Reader-    ( module Control.Monad.Reader-    , module Data.Monoid.Reducer-    )  where--import Control.Monad.Reader-import Data.Monoid.Reducer--instance Monoid m => Monoid (Reader e m) where-    mempty = return mempty-    mappend = liftM2 mappend--instance Monoid m => Reducer m (Reader e m) where-    unit = return--instance (Monad m, Monoid n) => Monoid (ReaderT e m n) where-    mempty = return mempty-    mappend = liftM2 mappend--instance (Monad m, Monoid n) => Reducer n (ReaderT e m n) where-    unit = return--instance (Monad m, Monoid n) => Reducer (m n) (ReaderT e m n) where-    unit = lift
− Data/Monoid/Monad/ST/Lazy.hs 
@@ -1,21 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}--module Data.Monoid.Monad.ST.Lazy-    ( module Control.Monad.ST.Lazy-    , module Control.Monad-    , module Data.Monoid.Reducer-    )  where--import Control.Monad-import Control.Monad.ST.Lazy-import Data.Monoid.Reducer--instance Monoid m => Monoid (ST s m) where-    mempty = return mempty-    mappend = liftM2 mappend--instance Monoid m => Reducer m (ST s m) where-    unit = return--
− Data/Monoid/Monad/ST/Strict.hs 
@@ -1,21 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}--module Data.Monoid.Monad.ST.Strict-    ( module Control.Monad.ST.Strict-    , module Control.Monad-    , module Data.Monoid.Reducer-    )  where--import Control.Monad-import Control.Monad.ST.Strict-import Data.Monoid.Reducer--instance Monoid m => Monoid (ST s m) where-    mempty = return mempty-    mappend = liftM2 mappend--instance Monoid m => Reducer m (ST s m) where-    unit = return--
− Data/Monoid/Monad/STM.hs 
@@ -1,19 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}--module Data.Monoid.Monad.STM-    ( module Control.Concurrent.STM-    , module Control.Monad-    , module Data.Monoid.Reducer-    )  where--import Control.Monad-import Control.Concurrent.STM-import Data.Monoid.Reducer--instance Monoid m => Monoid (STM m) where-    mempty = return mempty-    mappend = liftM2 mappend--instance Monoid m => Reducer m (STM m) where-    unit = return
− Data/Monoid/Monad/State/Lazy.hs 
@@ -1,27 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}--module Data.Monoid.Monad.State.Lazy-    ( module Control.Monad.State.Lazy-    , module Data.Monoid.Reducer-    )  where--import Control.Monad.State.Lazy-import Data.Monoid.Reducer--instance Monoid m => Monoid (State s m) where-    mempty = return mempty-    mappend = liftM2 mappend--instance (Monad m, Monoid n) => Monoid (StateT s m n) where-    mempty = return mempty-    mappend = liftM2 mappend--instance Monoid m => Reducer m (State s m) where-    unit = return--instance (Monad m, Monoid n) => Reducer n (StateT s m n) where-    unit = return--instance (Monad m, Monoid n) => Reducer (m n) (StateT s m n) where-    unit = lift
− Data/Monoid/Monad/State/Strict.hs 
@@ -1,27 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}--module Data.Monoid.Monad.State.Strict-    ( module Control.Monad.State.Strict-    , module Data.Monoid.Reducer-    )  where--import Control.Monad.State.Strict-import Data.Monoid.Reducer--instance Monoid m => Monoid (State s m) where-    mempty = return mempty-    mappend = liftM2 mappend--instance (Monad m, Monoid n) => Monoid (StateT s m n) where-    mempty = return mempty-    mappend = liftM2 mappend--instance Monoid m => Reducer m (State s m) where-    unit = return--instance (Monad m, Monoid n) => Reducer n (StateT s m n) where-    unit = return--instance (Monad m, Monoid n) => Reducer (m n) (StateT s m n) where-    unit = lift
− Data/Monoid/Monad/Writer/Lazy.hs 
@@ -1,27 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}--module Data.Monoid.Monad.Writer.Lazy-    ( module Control.Monad.Writer.Lazy-    , module Data.Monoid.Reducer-    )  where--import Control.Monad.Writer.Lazy-import Data.Monoid.Reducer--instance (Monoid w, Monoid m) => Monoid (Writer w m) where-    mempty = return mempty-    mappend = liftM2 mappend--instance (Monad m, Monoid w, Monoid n) => Monoid (WriterT w m n) where-    mempty = return mempty -    mappend = liftM2 mappend--instance (Monoid w, Monoid m) => Reducer m (Writer w m) where-    unit = return--instance (Monad m, Monoid w, Monoid n) => Reducer n (WriterT w m n) where-    unit = return--instance (Monad m, Monoid w, Monoid n) => Reducer (m n) (WriterT w m n) where-    unit = lift
− Data/Monoid/Monad/Writer/Strict.hs 
@@ -1,27 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}--module Data.Monoid.Monad.Writer.Strict-    ( module Control.Monad.Writer.Strict-    , module Data.Monoid.Reducer-    )  where--import Control.Monad.Writer.Strict-import Data.Monoid.Reducer--instance (Monoid w, Monoid m) => Monoid (Writer w m) where-    mempty = return mempty-    mappend = liftM2 mappend--instance (Monad m, Monoid w, Monoid n) => Monoid (WriterT w m n) where-    mempty = return mempty -    mappend = liftM2 mappend--instance (Monoid w, Monoid m) => Reducer m (Writer w m) where-    unit = return--instance (Monad m, Monoid w, Monoid n) => Reducer n (WriterT w m n) where-    unit = return--instance (Monad m, Monoid w, Monoid n) => Reducer (m n) (WriterT w m n) where-    unit = lift
Data/Monoid/Multiplicative.hs view
@@ -1,37 +1,222 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid.Multiplicative+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable (but instances use MPTCs)+--+-- When dealing with a 'Ring' or other structure, you often need a pair of +-- 'Monoid' instances that are closely related. Making a @newtype@ for one+-- is unsatisfying and yields an unnatural programming style. +--+-- A 'Multiplicative' is a 'Monoid' that is intended for use in a scenario+-- that can be extended to have another 'Monoid' slot in for addition. This+-- enables one to use common notation.+--+-- Any 'Multiplicative' can be turned into a 'Monoid' using the 'Log' wrapper.+--+-- Any 'Monoid' can be turned into a 'Multiplicative' using the 'Exp' wrapper.+--+-- Instances are supplied for common Monads of Monoids, in a fashion +-- which can be extended if the 'Monad' is a 'MonadPlus' to yield a 'LeftSemiNearRing'+--+-- Instances are also supplied for common Applicatives of Monoids, in a+-- fashion which can be extended if the 'Applicative' is 'Alternative' to+-- yield a 'LeftSemiNearRing'+-----------------------------------------------------------------------------+ module Data.Monoid.Multiplicative      ( module Data.Monoid.Additive-    , MultiplicativeMonoid+    -- * Multiplicative Monoids+    , Multiplicative     , one, times+    -- * Multiplicative to Monoid+    , Log(Log, getLog)+    -- * Monoid to Multiplicative+    , Exp(Exp, getExp)     ) where -import Data.Monoid.Additive+import Control.Applicative++import Control.Concurrent.STM++import Control.Monad.Cont+import Control.Monad.Identity++import Control.Monad.Reader++import qualified Control.Monad.RWS.Lazy as LRWS+import qualified Control.Monad.RWS.Strict as SRWS++import qualified Control.Monad.State.Lazy as LState+import qualified Control.Monad.State.Strict as SState++import qualified Control.Monad.Writer.Lazy as LWriter+import qualified Control.Monad.Writer.Strict as SWriter++import qualified Control.Monad.ST.Lazy as LST+import qualified Control.Monad.ST.Strict as SST+ import Data.FingerTree++import Data.Monoid.Additive import Data.Monoid.FromString-import Data.Monoid.Monad.Identity import Data.Monoid.Generator+import Data.Monoid.Instances ()+import Data.Monoid.Self+ import qualified Data.Sequence as Seq import Data.Sequence (Seq) -class MultiplicativeMonoid m where+import Text.Parsec.Prim++class Multiplicative m where     one :: m     times :: m -> m -> m -instance Monoid m => MultiplicativeMonoid [m] where-    one = [mempty]-    xss `times` yss = [ xs `mappend` ys | xs <- xss, ys <- yss ]+-- | Convert a 'Multiplicative' into a 'Monoid'. Mnemonic: @Log a + Log b = Log (a * b)@+data Log m = Log { getLog :: m } -instance (Measured v m, Monoid m) => MultiplicativeMonoid (FingerTree v m) where-    one = singleton mempty-    xss `times` yss = runIdentity $ mapReduce (flip fmap' yss . mappend) xss+instance Multiplicative m => Monoid (Log m) where+    mempty = Log one+    Log a `mappend` Log b = Log (a `times` b) -instance (Monoid m) => MultiplicativeMonoid (Seq m) where-    one = Seq.singleton mempty-    xss `times` yss = runIdentity $ mapReduce (flip fmap yss . mappend) xss+-- | Convert a 'Monoid' into a 'Multiplicative'. Mnemonic: @Exp a * Exp b = Exp (a + b)@+data Exp m = Exp { getExp :: m } -instance MultiplicativeMonoid m => MultiplicativeMonoid (Identity m) where-    one = Identity one-    Identity a `times` Identity b = Identity (a `times` b)+instance Monoid m => Multiplicative (Exp m) where+    one = Exp mempty+    Exp a `times` Exp b = Exp (a `mappend` b) -instance MultiplicativeMonoid m => MultiplicativeMonoid (FromString m) where+-- simple monoid transformer instances+instance Multiplicative m => Multiplicative (Self m) where+    one = Self one  +    Self a `times` Self b = Self (a `times` b)++instance Multiplicative m => Multiplicative (FromString m) where     one = FromString one     FromString a `times` FromString b = FromString (a `times` b)++-- the goal of this is that I can make left seminearrings out of any 'Alternative' wrapped around a monoid+-- in particular its useful for containers++instance Monoid m => Multiplicative [m] where+    one = return mempty+    times = liftM2 mappend++instance Monoid m => Multiplicative (Seq m) where+    one = return mempty+    times = liftM2 mappend++-- and things that can't quite be a Monad in Haskell+instance (Measured v m, Monoid m) => Multiplicative (FingerTree v m) where+    one = singleton mempty+    xss `times` yss = getSelf $ mapReduce (flip fmap' yss . mappend) xss++-- but it can at least serve as a canonical multiplication for any monad. +instance Monoid m => Multiplicative (Maybe m) where+    one = return mempty+    times = liftM2 mappend++instance Monoid m => Multiplicative (Identity m) where+    one = return mempty+    times = liftM2 mappend++instance (Monoid m) => Multiplicative (Cont r m) where+    one = return mempty+    times = liftM2 mappend++instance (Monoid w, Monoid m) => Multiplicative (SRWS.RWS r w s m) where+    one = return mempty+    times = liftM2 mappend++instance (Monoid w, Monoid m) => Multiplicative (LRWS.RWS r w s m) where+    one = return mempty+    times = liftM2 mappend++instance Monoid m => Multiplicative (SState.State s m) where+    one = return mempty+    times = liftM2 mappend++instance Monoid m => Multiplicative (LState.State s m) where+    one = return mempty+    times = liftM2 mappend++instance Monoid m => Multiplicative (Reader e m) where+    one = return mempty+    times = liftM2 mappend++instance (Monoid w, Monoid m) => Multiplicative (SWriter.Writer w m) where+    one = return mempty+    times = liftM2 mappend++instance (Monoid w, Monoid m) => Multiplicative (LWriter.Writer w m) where+    one = return mempty+    times = liftM2 mappend++instance (Monad m, Monoid n) => Multiplicative (ContT r m n) where+    one = return mempty +    times = liftM2 mappend++instance (Monad m, Monoid w, Monoid n) => Multiplicative (SRWS.RWST r w s m n) where +    one = return mempty +    times = liftM2 mappend++instance (Monad m, Monoid w, Monoid n) => Multiplicative (LRWS.RWST r w s m n) where +    one = return mempty +    times = liftM2 mappend++instance (Monad m, Monoid n) => Multiplicative (SState.StateT s m n) where+    one = return mempty+    times = liftM2 mappend++instance (Monad m, Monoid n) => Multiplicative (LState.StateT s m n) where+    one = return mempty+    times = liftM2 mappend++instance (Monad m, Monoid n) => Multiplicative (ReaderT e m n) where+    one = return mempty+    times = liftM2 mappend++instance (Monad m, Monoid w, Monoid n) => Multiplicative (SWriter.WriterT w m n) where+    one = return mempty +    times = liftM2 mappend++instance (Monad m, Monoid w, Monoid n) => Multiplicative (LWriter.WriterT w m n) where+    one = return mempty +    times = liftM2 mappend++instance Monoid n => Multiplicative (IO n) where+    one = return mempty+    times = liftM2 mappend++instance Monoid n => Multiplicative (SST.ST s n) where+    one = return mempty+    times = liftM2 mappend++instance Monoid n => Multiplicative (LST.ST s n) where+    one = return mempty+    times = liftM2 mappend++instance Monoid n => Multiplicative (STM n) where+    one = return mempty+    times = liftM2 mappend++instance (Stream s m t, Monoid n) => Multiplicative (ParsecT s u m n) where+    one = return mempty+    times = liftM2 mappend++-- Applicative instances++instance Monoid n => Multiplicative (ZipList n) where+    one = pure mempty+    times = liftA2 mappend++instance Monoid m => Multiplicative (Const m a) where+    one = pure undefined+    times = liftA2 undefined+
Data/Monoid/Multiplicative/Sugar.hs view
@@ -1,3 +1,19 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid.Multiplicative.Sugar+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- Syntactic sugar for working with a 'Multiplicative' monoids that conflicts with names from the "Prelude".+--+-- > import Prelude hiding ((+),(*))+-- > import Data.Monoid.Multiplicative.Sugar+--+-----------------------------------------------------------------------------+ module Data.Monoid.Multiplicative.Sugar     ( module Data.Monoid.Additive.Sugar     , module Data.Monoid.Multiplicative@@ -10,5 +26,5 @@  infixl 7 * -(*) :: MultiplicativeMonoid r => r -> r -> r+(*) :: Multiplicative r => r -> r -> r (*) = times
− Data/Monoid/Multiplicative/Transformer.hs 
@@ -1,19 +0,0 @@-module Data.Monoid.Multiplicative.Transformer-    ( module Data.Monoid.Multiplicative-    , Log(Log, getLog)-    , Exp(Exp, getExp) -    ) where--import Data.Monoid.Multiplicative--data Log m = Log { getLog :: m }--instance MultiplicativeMonoid m => Monoid (Log m) where-    mempty = Log one-    Log a `mappend` Log b = Log (a `times` b)--data Exp m = Exp { getExp :: m }--instance Monoid m => MultiplicativeMonoid (Exp m) where-    one = Exp mempty-    Exp a `times` Exp b = Exp (a `mappend` b)
Data/Monoid/Reducer.hs view
@@ -1,5 +1,20 @@-{-# LANGUAGE UndecidableInstances , FlexibleContexts , MultiParamTypeClasses , FlexibleInstances , GeneralizedNewtypeDeriving , FunctionalDependencies #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE UndecidableInstances , FlexibleContexts , MultiParamTypeClasses , FlexibleInstances , GeneralizedNewtypeDeriving #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid.Reducer+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs)+--+-- A @c@-'Reducer' is a 'Monoid' with a canonical mapping from @c@ to the Monoid.+-- This 'unit' acts in many ways like 'return' for a 'Monad' but is limited+-- to a single type.+--+-----------------------------------------------------------------------------+ module Data.Monoid.Reducer     ( module Data.Monoid     , Reducer@@ -9,6 +24,7 @@     ) where  import Data.Monoid+import Data.Monoid.Instances () import Data.Foldable import Data.FingerTree import qualified Data.Sequence as Seq@@ -21,22 +37,45 @@ import Data.IntMap (IntMap) import qualified Data.Map as Map import Data.Map (Map)+import Text.Parsec.Prim+import Control.Monad  --import qualified Data.BitSet as BitSet --import Data.BitSet (BitSet) --- minimal definition unit or snoc++-- | This type may be best read infix. A @c `Reducer` m@ is a 'Monoid' @m@ that maps+-- values of type @c@ through @unit@ to values of type @m@. A @c@-'Reducer' may also+-- supply operations which tack-on another @c@ to an existing 'Monoid' @m@ on the left+-- or right. These specialized reductions may be more efficient in some scenarios+-- and are used when appropriate by a 'Generator'. The names 'cons' and 'snoc' work+-- by analogy to the synonymous operations in the list monoid.+--+-- This class deliberately avoids functional-dependencies, so that () can be a @c@-Reducer+-- for all @c@, and so many common reducers can work over multiple types, for instance,+-- First and Last may reduce both @a@ and 'Maybe' @a@. Since a 'Generator' has a fixed element+-- type, the input to the reducer is generally known and extracting from the monoid usually+-- is sufficient to fix the result type. Combinators are available for most scenarios where+-- this is not the case, and the few remaining cases can be handled by using an explicit +-- type annotation.+--+-- Minimal definition: 'unit' or 'snoc' class Monoid m => Reducer c m where+    -- | Convert a value into a 'Monoid'     unit :: c -> m +    -- | Append a value to a 'Monoid' for use in left-to-right reduction     snoc :: m -> c -> m+    -- | Prepend a value onto a 'Monoid' for use during right-to-left reduction     cons :: c -> m -> m       unit = snoc mempty      snoc m = mappend m . unit     cons = mappend . unit +-- | Apply a 'Reducer' to a 'Foldable' container, after mapping the contents into a suitable form for reduction. foldMapReduce :: (Foldable f, e `Reducer` m) => (a -> e) -> f a -> m foldMapReduce f = foldMap (unit . f) +-- | Apply a 'Reducer' to a 'Foldable' mapping each element through 'unit' foldReduce :: (Foldable f, e `Reducer` m) => f e -> m foldReduce = foldMap unit @@ -95,16 +134,14 @@ instance Reducer a (Last a) where     unit = Last . Just --- orphan, which should be in Data.FingerTree-instance Measured v a => Monoid (FingerTree v a) where-    mempty = empty-    mappend = (><)- instance Measured v a => Reducer a (FingerTree v a) where     unit = singleton     cons = (<|)     snoc = (|>)  +instance (Stream s m t, c `Reducer` a) => Reducer c (ParsecT s u m a) where+    unit = return . unit+ instance Reducer a (Seq a) where     unit = Seq.singleton     cons = (Seq.<|)@@ -118,7 +155,7 @@ instance Ord a => Reducer a (Set a) where     unit = Set.singleton     cons = Set.insert-    -- pedantic in case Eq doesn't implement structural equality+    -- pedantic about order in case 'Eq' doesn't implement structural equality     snoc s m | Set.member m s = s               | otherwise = Set.insert m s @@ -133,10 +170,6 @@     snoc = flip . uncurry . Map.insertWith $ const id  {--instance Enum a => Monoid (BitSet a) where-    mempty = BitSet.empty-    mappend = BitSet.union -- not yet present, contacted library author- instance Enum a => Reducer a (BitSet a) where     unit m = BitSet.insert m BitSet.empty -}
Data/Monoid/Reducer/Char.hs view
@@ -1,4 +1,16 @@ {-# LANGUAGE UndecidableInstances, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid.Reducer.Char+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs)+--+-----------------------------------------------------------------------------+ module Data.Monoid.Reducer.Char     ( module Data.Monoid.Reducer     , CharReducer@@ -8,6 +20,8 @@  import Data.Monoid.Reducer import Data.Word (Word8)++-- | Provides a mechanism for the UTF8 'Monoid' to report invalid characters to one or more monoids.  class Reducer Char m => CharReducer m where     fromChar :: Char -> m
− Data/Monoid/Reducer/Sugar.hs 
@@ -1,17 +0,0 @@-{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances #-}-module Data.Monoid.Reducer.Sugar -    ( module Data.Monoid.Reducer-    , fromInteger-    , IsString, fromString-    ) where--import Prelude hiding (fromInteger)-import GHC.Exts hiding (fromString)-import Data.Monoid.Generator-import Data.Monoid.Reducer--fromInteger :: Reducer Integer m => Integer -> m-fromInteger = unit--fromString :: Reducer Char m => String -> m-fromString = reduce
Data/Monoid/Reducer/With.hs view
@@ -1,20 +1,32 @@ {-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid.Reducer.With+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs)+--+-----------------------------------------------------------------------------+ module Data.Monoid.Reducer.With     ( module Data.Monoid.Reducer-    , WithReducer(WithReducer,runWithReducer)-    , withoutReducer+    , WithReducer(WithReducer,withoutReducer)     ) where  import Data.Monoid.Reducer import Data.FingerTree -newtype WithReducer c m = WithReducer { runWithReducer :: (m,c) } +-- | If @m@ is a @c@-"Reducer", then m is @(c `WithReducer` m)@-"Reducer"+--   This can be used to quickly select a "Reducer" for use as a 'FingerTree'+--   'measure'. -withoutReducer :: c `WithReducer` m -> c-withoutReducer = snd . runWithReducer+newtype WithReducer c m = WithReducer { withoutReducer :: c }   instance (c `Reducer` m) => Reducer (c `WithReducer` m) m where-    unit = fst . runWithReducer +    unit = unit . withoutReducer   instance (c `Reducer` m) => Measured m (c `WithReducer` m) where-    measure = fst . runWithReducer+    measure = unit . withoutReducer
+ Data/Monoid/Union.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, GeneralizedNewtypeDeriving #-}+module Data.Monoid.Union+    ( module Data.Monoid.Reducer+    -- * Unions of Containers+    , HasUnion+    , empty+    , union+    , Union(Union,getUnion)+    -- * Unions of Containers of Monoids+    , HasUnionWith+    , emptyWith+    , unionWith+    , UnionWith(UnionWith,getUnionWith)+    ) where++import qualified Data.IntMap as IntMap+import Data.IntMap (IntMap)++import qualified Data.IntSet as IntSet+import Data.IntSet (IntSet)++import qualified Data.Map as Map+import Data.Map (Map)++import qualified Data.Set as Set+import Data.Set (Set)++import qualified Data.List as List++import Control.Functor.Pointed++import Data.Monoid.Reducer (Reducer, unit, cons, snoc, Monoid, mappend, mempty)++-- | A Container suitable for the 'Union' 'Monoid'+class HasUnion f where+    empty :: f+    {-# SPECIALIZE union :: IntMap a -> IntMap a -> IntMap a #-}+    {-# SPECIALIZE union :: Ord k => Map k a -> Map k a -> Map k a #-}+    {-# SPECIALIZE union :: Eq a => [a] -> [a] -> [a] #-}+    {-# SPECIALIZE union :: Ord a => Set a -> Set a -> Set a #-}+    {-# SPECIALIZE union :: IntSet -> IntSet -> IntSet #-}+    union :: f -> f -> f++instance HasUnion (IntMap a) where+    empty = IntMap.empty+    union = IntMap.union++instance Ord k => HasUnion (Map k a) where+    empty = Map.empty+    union = Map.union++instance Eq a => HasUnion [a] where+    empty = []+    union = List.union++instance Ord a => HasUnion (Set a) where+    empty = Set.empty+    union = Set.union++instance HasUnion IntSet where+    empty = IntSet.empty+    union = IntSet.union++-- | The 'Monoid' @('union','empty')@+newtype Union f = Union { getUnion :: f } +    deriving (Eq,Ord,Show,Read)++instance (HasUnion f) => Monoid (Union f) where+    mempty = Union empty+    Union a `mappend` Union b = Union (a `union` b)++instance (HasUnion f) => Reducer f (Union f) where+    unit = Union++instance Functor Union where+    fmap f (Union a) = Union (f a)++instance Pointed Union where +    point = Union++instance Copointed Union where+    extract = getUnion++-- | Polymorphic containers that we can supply an operation to handle unions with+class HasUnionWith f where+    {-# SPECIALIZE unionWith :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a #-}+    {-# SPECIALIZE unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a #-}+    unionWith :: (a -> a -> a) -> f a -> f a -> f a+    emptyWith :: f a ++instance HasUnionWith IntMap where +    emptyWith = IntMap.empty+    unionWith = IntMap.unionWith++instance Ord k => HasUnionWith (Map k) where +    emptyWith = Map.empty+    unionWith = Map.unionWith+++-- | The 'Monoid' @('unionWith mappend','empty')@ for containers full of monoids.+newtype UnionWith f m = UnionWith { getUnionWith :: f m } +    deriving (Eq,Ord,Show,Read,Functor,Pointed,Monad)++instance (HasUnionWith f, Monoid m) => Monoid (UnionWith f m) where+    mempty = UnionWith emptyWith+    UnionWith a `mappend` UnionWith b = UnionWith (unionWith mappend a b)++instance (HasUnionWith f, Monoid m) => Reducer (f m) (UnionWith f m) where+    unit = UnionWith+
− Data/Monoid/Unit.hs 
@@ -1,39 +0,0 @@-{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances, MultiParamTypeClasses #-}----------------------------------------------------------------------------------- |----- Module      :  Data.Monoid.Unit----- Copyright   :  (c) Edward Kmett 2009----- License     :  BSD-style----- Maintainer  :  libraries@haskell.org----- Stability   :  experimental----- Portability :  portable------------------------------------------------------------------------------------module Data.Monoid.Unit -    ( module Data.Monoid.Reducer-    , Unit(Unit,getUnit) -    ) where--import Control.Functor.Pointed-import Data.Monoid.Reducer-import Data.Monoid.Reducer.Char--newtype Unit c = Unit { getUnit :: () } --instance Monoid (Unit c) where-    mempty = Unit ()-    _ `mappend` _ = Unit ()-    mconcat _ = Unit ()--instance Reducer c (Unit c) where -    unit _ = Unit ()-    cons _ _ = Unit ()-    snoc _ _ = Unit ()--instance CharReducer (Unit Char)--instance Functor Unit where-    fmap _ _ = Unit ()-    -instance Pointed Unit where-    point _ = Unit ()
Data/Ring.hs view
@@ -2,27 +2,10 @@ module Data.Ring     ( module Data.Group     , module Data.Ring.Semi+    , Ring     ) where  import Data.Group import Data.Ring.Semi -class (Group a, Semiring a) => Ring a---- todo: the Boolean Ring (with symmetric difference as addition)--- use Data.Ring.Semi.Ord.Order Bool to get the and/or based Boolean distribuive lattice semiring--instance Monoid Bool where-    mempty = False-    a `mappend` b = (a || b) && not (a && b)--instance Group Bool where-    gnegate = not--instance MultiplicativeMonoid Bool where-    one = True-    times = (&&)--instance Seminearring Bool-instance Semiring Bool-instance Ring Bool+class (Group a, SemiRing a) => Ring a
+ Data/Ring/Boolean.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Ring.Boolean+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs)+--+-- A Boolean 'Ring' over 'Bool'. Note well that the 'mappend' of this ring is+-- symmetric difference and not disjunction like you might expect. To get that +-- you should use use 'Ord' from "Data.Ring.Semi.Ord.Order" on 'Bool' to get the '&&'/'||'-based +-- distributive-lattice 'SemiRing'+-----------------------------------------------------------------------------++module Data.Ring.Boolean+    ( module Data.Ring+    , BoolRing(BoolRing, getBoolRing)+    ) where++import Data.Ring+import Data.Monoid.Reducer++newtype BoolRing = BoolRing { getBoolRing :: Bool } deriving (Eq,Ord,Show,Read)++instance Monoid BoolRing where+    mempty = BoolRing False+    BoolRing a `mappend` BoolRing b = BoolRing ((a || b) && not (a && b))++instance Group BoolRing where+    gnegate = BoolRing . not . getBoolRing++instance Multiplicative BoolRing where+    one = BoolRing True+    BoolRing a `times` BoolRing b = BoolRing (a && b)++instance LeftSemiNearRing BoolRing+instance RightSemiNearRing BoolRing+instance SemiRing BoolRing+instance Ring BoolRing++instance Reducer Bool BoolRing where+    unit = BoolRing
Data/Ring/FromNum.hs view
@@ -1,4 +1,19 @@ {-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Ring.FromNum+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs)+--+-- A wrapper that lies for you and claims any instance of 'Num' is a 'Ring'.+-- Who knows, for your type it might even be telling the truth!+--+-----------------------------------------------------------------------------+ module Data.Ring.FromNum      ( module Data.Ring     , FromNum(FromNum, getFromNum)@@ -17,11 +32,15 @@     minus = (-)     gnegate = negate     -instance Num a => MultiplicativeMonoid (FromNum a) where+instance Num a => Multiplicative (FromNum a) where     one = fromInteger 1     times = (*) -instance Num a => Seminearring (FromNum a)+-- you can assume these, but you're probably lying to yourself+instance Num a => LeftSemiNearRing (FromNum a)+instance Num a => RightSemiNearRing (FromNum a)+instance Num a => SemiRing (FromNum a)+instance Num a => Ring (FromNum a)      instance Num a => Reducer Integer (FromNum a) where     unit = fromInteger
Data/Ring/Semi.hs view
@@ -1,9 +1,23 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Ring.Semi+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs)+--+--+-----------------------------------------------------------------------------+ module Data.Ring.Semi     ( module Data.Ring.Semi.Near-    , Semiring+    , SemiRing     ) where  import Data.Ring.Semi.Near -class Seminearring a => Semiring a+-- | A 'SemiRing' is an instance of both 'Multiplicative' and 'Monoid' where +--   'times' distributes over 'plus'.+class (RightSemiNearRing a, LeftSemiNearRing a) => SemiRing a
Data/Ring/Semi/Near.hs view
@@ -1,19 +1,89 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Ring.Semi.Near+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable (instances use MPTCs)+--+-- Defines left- and right- seminearrings. Every 'MonadPlus' wrapped around+-- a 'Monoid' qualifies do to the distributivity of (>>=) over mplus.+--+-- See <http://conway.rutgers.edu/~ccshan/wiki/blog/posts/WordNumbers1/>+--+-----------------------------------------------------------------------------+ module Data.Ring.Semi.Near     ( module Data.Monoid.Multiplicative-    , Seminearring+    , LeftSemiNearRing+    , RightSemiNearRing     ) where +import Control.Monad.Reader++import qualified Control.Monad.RWS.Lazy as LRWS+import qualified Control.Monad.RWS.Strict as SRWS++import qualified Control.Monad.State.Lazy as LState+import qualified Control.Monad.State.Strict as SState++import qualified Control.Monad.Writer.Lazy as LWriter+import qualified Control.Monad.Writer.Strict as SWriter+ import Data.Monoid.Multiplicative import Data.FingerTree import Data.Monoid.FromString-import Data.Monoid.Monad.Identity+import Data.Monoid.Self import Data.Monoid.Generator+ import qualified Data.Sequence as Seq import Data.Sequence (Seq) -class (MultiplicativeMonoid m, Monoid m) => Seminearring m -instance Monoid m => Seminearring [m]-instance Monoid m => Seminearring (Seq m)-instance (Measured v m, Monoid m) => Seminearring (FingerTree v m)-instance Seminearring m => Seminearring (Identity m)-instance Seminearring m => Seminearring (FromString m)+import Text.Parsec.Prim++-- | @(a + b) * c = (a * c) + (b * c)@+class (Multiplicative m, Monoid m) => RightSemiNearRing m ++-- 'Monoid' transformers+instance RightSemiNearRing m => RightSemiNearRing (Self m)+instance RightSemiNearRing m => RightSemiNearRing (FromString m)++-- | @a * (b + c) = (a * b) + (a * c)@+class (Multiplicative m, Monoid m) => LeftSemiNearRing m ++-- 'Monoid' transformers+instance LeftSemiNearRing m => LeftSemiNearRing (Self m)+instance LeftSemiNearRing m => LeftSemiNearRing (FromString m)++-- non-'Monad' instances+instance (Measured v m, Monoid m) => LeftSemiNearRing (FingerTree v m)++-- 'Monad' instances+-- Every 'MonadPlus' over a 'Monoid' with an appropriate 'Multiplicative' instance+-- for 'liftM2 mappend' is a 'LeftSemiNearRing' by 'MonadPlus' left-distributivity++instance Monoid m => LeftSemiNearRing [m]++instance Monoid m => LeftSemiNearRing (Maybe m)++instance Monoid m => LeftSemiNearRing (Seq m)++instance (Stream s m t, Monoid a) => LeftSemiNearRing (ParsecT s u m a)++instance (MonadPlus m, Monoid n) => LeftSemiNearRing (SState.StateT s m n)++instance (MonadPlus m, Monoid n) => LeftSemiNearRing (LState.StateT s m n)++instance (MonadPlus m, Monoid n) => LeftSemiNearRing (ReaderT e m n)++instance (MonadPlus m, Monoid w, Monoid n) => LeftSemiNearRing (SRWS.RWST r w s m n)++instance (MonadPlus m, Monoid w, Monoid n) => LeftSemiNearRing (LRWS.RWST r w s m n)++instance (MonadPlus m, Monoid w, Monoid n) => LeftSemiNearRing (SWriter.WriterT w m n)++instance (MonadPlus m, Monoid w, Monoid n) => LeftSemiNearRing (LWriter.WriterT w m n)
Data/Ring/Semi/Ord.hs view
@@ -1,14 +1,14 @@ {-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-} --------------------------------------------------------------------------- |----- Module      :  Data.Ring.Semi.Ord----- Copyright   :  (c) Edward Kmett 2009, Conal Elliott 2008----- License     :  BSD3----- ----- Maintainer  :  ekmett@gmail.com----- Stability   :  experimental----- ----- ordered types as semi-rings+-- |+-- Module      :  Data.Ring.Semi.Ord+-- Copyright   :  (c) Edward Kmett 2009, Conal Elliott 2008+-- License     :  BSD3+-- +-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- +-- Turn an instance of 'Ord' into a 'SemiRing' over 'max' and 'min' ------------------------------------------------------------------------  module Data.Ring.Semi.Ord@@ -24,18 +24,20 @@ import Data.Monoid.Ord import Data.Monoid.Reducer +-- | A 'SemiRing' using a type's built-in Bounded instance. newtype Order a = Order { getOrder :: a } deriving (Eq,Ord,Read,Show,Bounded,Arbitrary)  instance (Bounded a, Ord a) => Monoid (Order a) where     mappend = max     mempty = minBound -instance (Bounded a, Ord a) => MultiplicativeMonoid (Order a) where+instance (Bounded a, Ord a) => Multiplicative (Order a) where     times = min     one = maxBound     -instance (Bounded a, Ord a) => Seminearring (Order a)-instance (Bounded a, Ord a) => Semiring (Order a)+instance (Bounded a, Ord a) => RightSemiNearRing (Order a)+instance (Bounded a, Ord a) => LeftSemiNearRing (Order a)+instance (Bounded a, Ord a) => SemiRing (Order a) instance (Bounded a, Ord a) => Reducer a (Order a) where     unit = Order @@ -48,12 +50,7 @@ instance Copointed Order where     extract = getOrder ------+-- | A 'SemiRing' which adds 'minBound' and 'maxBound' to a pre-existing type. data Priority a = MinBound | Priority a | MaxBound deriving (Eq,Read,Show)  instance Bounded (Priority a) where@@ -92,12 +89,13 @@     mappend = max     mempty = minBound -instance Ord a => MultiplicativeMonoid (Priority a) where+instance Ord a => Multiplicative (Priority a) where     times = min     one = maxBound -instance Ord a => Seminearring (Priority a)-instance Ord a => Semiring (Priority a)+instance Ord a => LeftSemiNearRing (Priority a)+instance Ord a => RightSemiNearRing (Priority a)+instance Ord a => SemiRing (Priority a)  instance Ord a => Reducer a (Priority a) where     unit = Priority
Data/Ring/Sugar.hs view
@@ -1,3 +1,19 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Ring.Sugar+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- Syntactic sugar for working with rings that conflicts with names from the "Prelude".+--+-- > import Prelude hiding ((-), (+), (*), negate, subtract)+-- > import Data.Ring.Sugar+--+-----------------------------------------------------------------------------+ module Data.Ring.Sugar      ( module Data.Monoid.Multiplicative.Sugar     , module Data.Ring.Semi.Near
monoids.cabal view
@@ -1,5 +1,5 @@ name:		    monoids-version:	    0.1.2+version:	    0.1.5 license:	    BSD3 license-file:   LICENSE author:		    Edward A. Kmett@@ -14,48 +14,32 @@ cabal-version:  >=1.2  library-  build-depends: base >= 4, text, fingertree, bytestring, category-extras, parallel, containers, mtl, stm, bitset, QuickCheck+  build-depends: base >= 4, text, fingertree, bytestring, category-extras, parallel, containers, mtl, stm, bitset, QuickCheck, array, parsec >= 3   exposed-modules:     Data.Group+    Data.Group.Combinators     Data.Group.Sugar     Data.Monoid.Additive     Data.Monoid.Additive.Sugar     Data.Monoid.Applicative     Data.Monoid.Categorical+    Data.Monoid.Combinators     Data.Monoid.FromString     Data.Monoid.Generator-    Data.Monoid.Generator.Combinators-    Data.Monoid.IntMap     Data.Monoid.Lexical.SourcePosition+    Data.Monoid.Lexical.RunLengthEncoding     Data.Monoid.Lexical.UTF8.Decoder     Data.Monoid.Lexical.Words-    Data.Monoid.Map     Data.Monoid.Monad-    Data.Monoid.Monad.Cont-    Data.Monoid.Monad.Either---  Data.Monoid.Monad.Error-    Data.Monoid.Monad.Identity-    Data.Monoid.Monad.IO-    Data.Monoid.Monad.Reader-    Data.Monoid.Monad.RWS.Lazy-    Data.Monoid.Monad.RWS.Strict-    Data.Monoid.Monad.State.Lazy-    Data.Monoid.Monad.State.Strict-    Data.Monoid.Monad.ST.Lazy-    Data.Monoid.Monad.STM-    Data.Monoid.Monad.ST.Strict-    Data.Monoid.Monad.Writer.Lazy-    Data.Monoid.Monad.Writer.Strict     Data.Monoid.Multiplicative     Data.Monoid.Multiplicative.Sugar-    Data.Monoid.Multiplicative.Transformer     Data.Monoid.Ord     Data.Monoid.Reducer     Data.Monoid.Reducer.Char-    Data.Monoid.Reducer.Sugar     Data.Monoid.Reducer.With-    Data.Monoid.Unit+    Data.Monoid.Union     Data.Ring+    Data.Ring.Boolean     Data.Ring.Semi     Data.Ring.Semi.Near     Data.Ring.Semi.Ord