diff --git a/Data/Group.hs b/Data/Group.hs
new file mode 100644
--- /dev/null
+++ b/Data/Group.hs
@@ -0,0 +1,39 @@
+module Data.Group 
+    ( module Data.Monoid.Additive
+    , Group
+    , gnegate
+    , minus
+    ) where
+
+import Data.Monoid.Additive
+import Data.Monoid.Monad.Identity
+import Data.Monoid.FromString
+
+infixl 6 `minus`
+
+class Monoid a => Group a where
+    -- additive inverse
+    gnegate :: a -> a
+
+    -- right cancellation
+    minus :: a -> a -> a
+    a `minus` b = a `plus` gnegate b 
+
+instance Num a => Group (Sum a) where
+    gnegate = Sum . negate . getSum
+    Sum a `minus` Sum b = Sum (a - b)
+    
+instance Fractional a => Group (Product a) where
+    gnegate = Product . negate . getProduct
+    Product a `minus` Product b = Product (a / b)
+    
+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 (FromString a) where
+    gnegate = FromString . gnegate . getFromString
+    FromString a `minus` FromString b = FromString (a `minus` b)
diff --git a/Data/Group/Sugar.hs b/Data/Group/Sugar.hs
new file mode 100644
--- /dev/null
+++ b/Data/Group/Sugar.hs
@@ -0,0 +1,18 @@
+module Data.Group.Sugar 
+    ( module Data.Monoid.Additive.Sugar
+    , module Data.Group
+    , (-)
+    , negate
+    ) where
+
+import Data.Monoid.Additive.Sugar
+import Data.Group
+import Prelude hiding ((-), negate)
+
+infixl 7 -
+
+(-) :: Group g => g -> g -> g
+(-) = minus
+
+negate :: Group g => g -> g
+negate = gnegate
diff --git a/Data/Monoid/Additive.hs b/Data/Monoid/Additive.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Additive.hs
@@ -0,0 +1,15 @@
+module Data.Monoid.Additive
+    ( module Data.Monoid 
+    , plus
+    , zero
+    ) where
+
+import Data.Monoid
+
+infixl 6 `plus`
+
+plus :: Monoid m => m -> m -> m 
+plus = mappend
+
+zero :: Monoid m => m 
+zero = mempty
diff --git a/Data/Monoid/Additive/Sugar.hs b/Data/Monoid/Additive/Sugar.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Additive/Sugar.hs
@@ -0,0 +1,12 @@
+module Data.Monoid.Additive.Sugar 
+    ( module Data.Monoid.Additive
+    , (+)
+    ) where
+
+import Data.Monoid.Additive
+import Prelude hiding ((+))
+
+infixl 6 + 
+
+(+) :: Monoid m => m -> m -> m 
+(+) = mappend
diff --git a/Data/Monoid/Applicative.hs b/Data/Monoid/Applicative.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Applicative.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts #-}
+module Data.Monoid.Applicative 
+    ( module Control.Applicative
+    , module Data.Monoid.Reducer
+    , Traversal(Traversal,getTraversal)
+    , Alternate(Alternate,getAlternate)
+    , TraversalWith(TraversalWith,getTraversalWith)
+    ) where
+
+import Control.Functor.Pointed (Pointed, point)
+import Control.Applicative (Applicative, (*>), pure, Alternative, empty, (<|>), liftA2)
+import Data.Monoid.Reducer
+
+newtype Traversal f = Traversal { getTraversal :: f () } 
+
+instance Applicative f => Monoid (Traversal f) where
+    mempty = Traversal (pure ())
+    Traversal a `mappend` Traversal b = Traversal (a *> b)
+
+instance Applicative f => Reducer (f a) (Traversal f) where
+    unit a = Traversal (a *> pure ())
+    a `cons` Traversal b = Traversal (a *> b)
+    Traversal a `snoc` b = Traversal (a *> b *> pure ())
+
+
+{-# RULES "unitTraversal" unit = Traversal #-}
+{-# RULES "snocTraversal" snoc = snocTraversal #-}
+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
+
+newtype TraversalWith f n = TraversalWith { getTraversalWith :: f n }
+
+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 (Applicative f, Monoid n) => Reducer (f n) (TraversalWith f n) where
+    unit = TraversalWith
+
+instance Functor f => Functor (TraversalWith f) where
+    fmap f = TraversalWith . fmap f . getTraversalWith
+
+instance Pointed f => Pointed (TraversalWith f) where
+    point = TraversalWith . point
diff --git a/Data/Monoid/Categorical.hs b/Data/Monoid/Categorical.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Categorical.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE GADTs #-}
+module Data.Monoid.Categorical
+    ( module Data.Monoid
+    , Endo(Endo, getEndo)
+    , Mon(Mon)
+    , runMon
+    ) where
+
+import Prelude hiding ((.),id)
+import Data.Monoid (Monoid, mempty, mappend) 
+import Control.Category
+
+-- | The 'Monoid' of endomorphisms over some object in an arbitrary 'Category'
+data Endo k a = Endo { getEndo :: k a a } 
+
+instance Category k =>  Monoid (Endo k a) where
+    mempty = Endo id
+    Endo f `mappend` Endo g = Endo (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
+
+instance Monoid m => Category (Mon m) where
+    id = Mon mempty
+    Mon a . Mon b = Mon (a `mappend` b)
diff --git a/Data/Monoid/FromString.hs b/Data/Monoid/FromString.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/FromString.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}
+module Data.Monoid.FromString 
+    ( FromString(FromString,getFromString)
+    ) where
+
+import Control.Functor.Pointed
+import Data.Monoid.Generator
+import Data.Monoid.Reducer
+import GHC.Exts
+
+data FromString m = FromString { getFromString :: m } 
+
+instance Monoid m => Monoid (FromString m) where
+    mempty = FromString mempty
+    FromString a `mappend` FromString b = FromString (a `mappend` b)
+
+instance Reducer Char m => Reducer Char (FromString m) where
+    unit = FromString . unit
+
+instance Reducer Char m => IsString (FromString m) where
+    fromString = FromString . reduce
+
+instance Pointed FromString where
+    point = FromString
+
+instance Copointed FromString where
+    extract = getFromString
+
+instance Functor FromString where
+    fmap f (FromString x) = FromString (f x)
diff --git a/Data/Monoid/Generator.hs b/Data/Monoid/Generator.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Generator.hs
@@ -0,0 +1,136 @@
+{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-}
+module Data.Monoid.Generator
+    ( module Data.Monoid.Reducer
+    , Generator
+    , Elem
+    , mapReduce
+    , mapTo
+    , mapFrom
+    , reduce
+    , Keys(Keys, getKeys)
+    , Values(Values, getValues)
+    , Char8(Char8, getChar8)
+    ) where
+
+import Data.Word (Word8)
+import Data.Text (Text)
+import Data.Foldable (fold,foldMap)
+import qualified Data.Text as Text
+import qualified Data.ByteString as Strict (ByteString, foldl')
+import qualified Data.ByteString.Char8 as Strict8 (foldl')
+import qualified Data.ByteString.Lazy as Lazy (ByteString, toChunks)
+import qualified Data.ByteString.Lazy.Char8 as Lazy8 (toChunks)
+import qualified Data.Sequence as Seq
+import Data.FingerTree (Measured, FingerTree)
+import Data.Sequence (Seq)
+import qualified Data.Set as Set
+import Data.Set (Set)
+import qualified Data.IntSet as IntSet
+import Data.IntSet (IntSet)
+import qualified Data.IntMap as IntMap
+import Data.IntMap (IntMap)
+import qualified Data.Map as Map
+import Data.Map (Map)
+
+import Control.Parallel.Strategies
+import Data.Monoid.Reducer
+
+-- minimal definition mapReduce or affixMapReduce
+class Generator c where
+    type Elem c :: * 
+    mapReduce :: (e `Reducer` m) => (Elem c -> e) -> c -> m
+    mapTo     :: (e `Reducer` m) => (Elem c -> e) -> m -> c -> m 
+    mapFrom   :: (e `Reducer` m) => (Elem c -> e) -> c -> m -> m
+
+    mapReduce f = mapTo f mempty
+    mapTo f m = mappend m . mapReduce f
+    mapFrom f = mappend . mapReduce f
+
+instance Generator Strict.ByteString where
+    type Elem Strict.ByteString = Word8
+    mapTo f = Strict.foldl' (\a -> snoc a . f)
+
+instance Generator Lazy.ByteString where
+    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)
+
+instance Generator [c] where
+    type Elem [c] = c
+    mapReduce f = foldMap (unit . f)
+
+instance Measured v e => Generator (FingerTree v e) where
+    type Elem (FingerTree v e) = e
+    mapReduce f = foldMap (unit . f)
+
+instance Generator (Seq c) where
+    type Elem (Seq c) = c
+    mapReduce f = foldMap (unit . f)
+
+instance Generator IntSet where
+    type Elem IntSet = Int
+    mapReduce f = mapReduce f . IntSet.toList
+
+instance Generator (Set a) where
+    type Elem (Set a) = a
+    mapReduce f = mapReduce f . Set.toList
+
+instance Generator (IntMap v) where
+    type Elem (IntMap v) = (Int,v)
+    mapReduce f = mapReduce f . IntMap.toList
+
+instance Generator (Map k v) where
+    type Elem (Map k v) = (k,v) 
+    mapReduce f = mapReduce f . Map.toList
+
+newtype Keys c = Keys { getKeys :: c } 
+
+instance Generator (Keys (IntMap v)) where
+    type Elem (Keys (IntMap v)) = Int
+    mapReduce f = mapReduce f . IntMap.keys . getKeys
+
+instance Generator (Keys (Map k v)) where
+    type Elem (Keys (Map k v)) = k
+    mapReduce f = mapReduce f . Map.keys . getKeys
+
+newtype Values c = Values { getValues :: c } 
+
+instance Generator (Values (IntMap v)) where
+    type Elem (Values (IntMap v)) = v
+    mapReduce f = mapReduce f . IntMap.elems . getValues
+
+instance Generator (Values (Map k v)) where
+    type Elem (Values (Map k v)) = v
+    mapReduce f = mapReduce f . Map.elems . getValues
+
+{-# 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 #-}
+{-# SPECIALIZE reduce :: (Char `Reducer` m) => Char8 Lazy.ByteString -> m #-}
+{-# SPECIALIZE reduce :: (c `Reducer` m) => [c] -> m #-}
+{-# SPECIALIZE reduce :: (Generator (FingerTree v e), e `Reducer` m) => FingerTree v e -> m #-}
+{-# SPECIALIZE reduce :: (Char `Reducer` m) => Text -> m #-}
+{-# SPECIALIZE reduce :: (e `Reducer` m) => Seq e -> m #-}
+{-# SPECIALIZE reduce :: (Int `Reducer` m) => IntSet -> m #-}
+{-# SPECIALIZE reduce :: (a `Reducer` m) => Set a -> m #-}
+{-# SPECIALIZE reduce :: ((Int,v) `Reducer` m) => IntMap v -> m #-}
+{-# SPECIALIZE reduce :: ((k,v) `Reducer` m) => Map k v -> m #-}
+{-# SPECIALIZE reduce :: (Int `Reducer` m) => Keys (IntMap v) -> m #-}
+{-# 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 #-}
+reduce :: (Generator c, Elem c `Reducer` m) => c -> m
+reduce = mapReduce id
diff --git a/Data/Monoid/Generator/Combinators.hs b/Data/Monoid/Generator/Combinators.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Generator/Combinators.hs
@@ -0,0 +1,76 @@
+{-# 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
diff --git a/Data/Monoid/IntMap.hs b/Data/Monoid/IntMap.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/IntMap.hs
@@ -0,0 +1,17 @@
+{-# 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
diff --git a/Data/Monoid/Lexical/SourcePosition.hs b/Data/Monoid/Lexical/SourcePosition.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Lexical/SourcePosition.hs
@@ -0,0 +1,83 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+module Data.Monoid.Lexical.SourcePosition
+    ( module Data.Monoid.Reducer.Char
+    , SourcePosition
+    , SourceLine
+    , SourceColumn
+    , sourceLine
+    , sourceColumn
+    , startOfFile
+    , showSourcePosition
+    ) where
+
+import Prelude hiding (lex)
+import Control.Functor.Extras
+import Control.Functor.Pointed
+import Data.Monoid.Reducer.Char
+
+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
+    deriving (Read,Show,Eq)
+
+nextTab :: Int -> Int
+nextTab x = x + (8 - (x-1) `mod` 8)
+
+instance Functor SourcePosition where
+    fmap g (Pos f l c) = Pos (g f) l c
+    fmap _ (Lines l c) = Lines l c
+    fmap _ (Columns c) = Columns c
+    fmap _ (Tab x y) = Tab x y
+
+instance Pointed SourcePosition where
+    point f = Pos f 1 1
+
+instance FunctorZero SourcePosition where
+    fzero = mempty
+
+instance FunctorPlus SourcePosition where
+    fplus = mappend
+
+instance Monoid (SourcePosition file) where
+    mempty = Columns 0
+
+    Pos f l _ `mappend` Lines m d = Pos f (l + m) d
+    Pos f l c `mappend` Columns d = Pos f l (c + d)
+    Pos f l c `mappend` Tab x y   = Pos f l (nextTab (c + x) + y)
+    Lines l _ `mappend` Lines m d = Lines (l + m) d
+    Lines l c `mappend` Columns d = Lines l (c + d)
+    Lines l c `mappend` Tab x y   = Lines l (nextTab (c + x) + y)
+    Columns c `mappend` Columns d  = Columns (c + d)
+    Columns c `mappend` Tab x y    = Tab (c + x) y
+    Tab _ _   `mappend` Lines m d  = Lines m d
+    Tab x y   `mappend` Columns d  = Tab x (y + d)
+    Tab x y   `mappend` Tab x' y'  = Tab x (nextTab (y + x') + y')
+    _         `mappend` pos        = pos
+
+instance Reducer Char (SourcePosition file) where
+    unit '\n' = Lines 1 1
+    unit '\t' = Tab 0 0 
+    unit _    = Columns 1
+
+instance CharReducer (SourcePosition file)
+    
+startOfFile :: f -> SourcePosition f
+startOfFile = point
+
+sourceColumn :: SourcePosition f -> Maybe SourceColumn
+sourceColumn (Pos _ _ c) = Just c
+sourceColumn (Lines _ c) = Just c
+sourceColumn _ = Nothing
+
+sourceLine :: SourcePosition f -> Maybe SourceLine
+sourceLine (Pos _ l _) = Just l
+sourceLine _ = Nothing
+
+showSourcePosition :: SourcePosition String -> String
+showSourcePosition pos = showSourcePosition' (point "-" `mappend` pos) where
+    showSourcePosition' (Pos f l c) = f ++ ":" ++ show l ++ ":" ++ show c
+    showSourcePosition' _ = undefined
diff --git a/Data/Monoid/Lexical/UTF8/Decoder.hs b/Data/Monoid/Lexical/UTF8/Decoder.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Lexical/UTF8/Decoder.hs
@@ -0,0 +1,184 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+module Data.Monoid.Lexical.UTF8.Decoder 
+    ( module Data.Monoid.Reducer.Char
+    , UTF8
+    , runUTF8
+    ) where
+    
+import Data.Bits (shiftL,(.&.),(.|.))
+import Data.Word (Word8)
+
+import Control.Functor.Pointed
+
+import Data.Monoid.Reducer.Char
+
+-- Incrementally reduce canonical RFC3629 UTF-8 Characters
+
+-- utf8 characters are at most 4 characters long, so we need only retain state for 3 of them
+-- moreover their length is able to be determined a priori, so lets store that intrinsically in the constructor
+data H = H0
+       | H2_1 {-# UNPACK #-} !Word8 
+       | H3_1 {-# UNPACK #-} !Word8
+       | H3_2 {-# UNPACK #-} !Word8 !Word8
+       | H4_1 {-# UNPACK #-} !Word8
+       | H4_2 {-# UNPACK #-} !Word8 !Word8
+       | H4_3 {-# UNPACK #-} !Word8 !Word8 !Word8
+
+-- words expressing the tail of a character, each between 0x80 and 0xbf
+-- this is arbitrary length to simplify making the parser truly monoidal
+-- this probably means we have O(n^2) worst case performance in the face of very long runs of chars that look like 10xxxxxx
+type T = [Word8]
+
+-- S is a segment that contains a possible tail of a character, the result of reducing some full characters, and the start of another character
+-- T contains a list of bytes each between 0x80 and 0xbf
+data UTF8 m = S T m !H
+            | T T
+
+-- flush any extra characters in a head, when the next character isn't between 0x80 and 0xbf
+flushH :: CharReducer m => H -> m
+flushH (H0) = mempty
+flushH (H2_1 x) = invalidChar [x]
+flushH (H3_1 x) = invalidChar [x]
+flushH (H3_2 x y) = invalidChar [x,y]
+flushH (H4_1 x) = invalidChar [x]
+flushH (H4_2 x y) = invalidChar [x,y]
+flushH (H4_3 x y z) = invalidChar [x,y,z]
+
+-- flush a character tail 
+flushT :: CharReducer m => [Word8] -> m
+flushT = invalidChar
+
+snocH :: CharReducer m => H -> Word8 -> (m -> H -> UTF8 m) -> m -> UTF8 m
+snocH H0 c k m 
+    | c < 0x80 = k (m `mappend` b1 c) H0
+    | c < 0xc0 = k (m `mappend` invalidChar [c]) H0
+    | c < 0xe0 = k m (H2_1 c)
+    | c < 0xf0 = k m (H3_1 c)
+    | c < 0xf5 = k m (H4_1 c)
+    | otherwise = k (m `mappend` invalidChar [c]) H0
+snocH (H2_1 c) d k m
+    | d >= 0x80 && d < 0xc0 = k (m `mappend` b2 c d) H0
+    | otherwise = k (m `mappend` invalidChar [c]) H0
+snocH (H3_1 c) d k m 
+    | d >= 0x80 && d < 0xc0 = k m (H3_2 c d)
+    | otherwise = k (m `mappend` invalidChar [c]) H0
+snocH (H3_2 c d) e k m 
+    | d >= 0x80 && d < 0xc0 = k (m `mappend` b3 c d e) H0
+    | otherwise = k (m `mappend` invalidChar [c,d]) H0
+snocH (H4_1 c) d k m 
+    | d >= 0x80 && d < 0xc0 = k m (H4_2 c d)
+    | otherwise = k (m `mappend` invalidChar [c,d]) H0
+snocH (H4_2 c d) e k m 
+    | d >= 0x80 && d < 0xc0 = k m (H4_3 c d e)
+    | otherwise = k (m `mappend` invalidChar [c,d,e]) H0
+snocH (H4_3 c d e) f k m 
+    | d >= 0x80 && d < 0xc0 = k (m `mappend` b4 c d e f) H0
+    | otherwise = k (m `mappend` invalidChar [c,d,e,f]) H0
+
+mask :: Word8 -> Word8 -> Int
+mask c m = fromEnum (c .&. m) 
+
+combine :: Int -> Word8 -> Int
+combine a r = shiftL a 6 .|. fromEnum (r .&. 0x3f)
+
+b1 :: CharReducer m => Word8 -> m
+b1 c | c < 0x80 = fromChar . toEnum $ fromEnum c
+     | otherwise = invalidChar [c]
+
+b2 :: CharReducer m => Word8 -> Word8 -> m
+b2 c d | valid_b2 c d = fromChar (toEnum (combine (mask c 0x1f) d))
+       | otherwise = invalidChar [c,d]
+
+b3 :: CharReducer m => Word8 -> Word8 -> Word8 -> m
+b3 c d e | valid_b3 c d e = fromChar (toEnum (combine (combine (mask c 0x0f) d) e))
+         | otherwise = invalidChar [c,d,e]
+
+
+b4 :: CharReducer m => Word8 -> Word8 -> Word8 -> Word8 -> m
+b4 c d e f | valid_b4 c d e f = fromChar (toEnum (combine (combine (combine (mask c 0x07) d) e) f))
+           | otherwise = invalidChar [c,d,e,f]
+
+valid_b2 :: Word8 -> Word8 -> Bool
+valid_b2 c d = (c >= 0xc2 && c <= 0xdf && d >= 0x80 && d <= 0xbf)
+
+valid_b3 :: Word8 -> Word8 -> Word8 -> Bool
+valid_b3 c d e = (c == 0xe0 && d >= 0xa0 && d <= 0xbf && e >= 0x80 && e <= 0xbf) || 
+                 (c >= 0xe1 && c <= 0xef && d >= 0x80 && d <= 0xbf && e >= 0x80 && e <= 0xbf)
+
+valid_b4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool
+valid_b4 c d e f = (c == 0xf0 && d >= 0x90 && d <= 0xbf && e >= 0x80 && e <= 0xbf && f >= 0x80 && f <= 0xbf) ||
+      (c >= 0xf1 && c <= 0xf3 && d >= 0x80 && d <= 0xbf && e >= 0x80 && e <= 0xbf && f >= 0x80 && f <= 0xbf) ||
+                   (c == 0xf4 && d >= 0x80 && d <= 0x8f && e >= 0x80 && e <= 0xbf && f >= 0x80 && f <= 0xbf)
+
+consT :: CharReducer m => Word8 -> T -> (H -> UTF8 m) -> (m -> UTF8 m) -> (T -> UTF8 m) -> UTF8 m
+consT c cs h m t
+             | c < 0x80 = m $ b1 c `mappend` invalidChars cs
+             | c < 0xc0 = t (c:cs)
+             | c < 0xe0 = case cs of
+                        [] -> h $ H2_1 c
+                        (d:ds) -> m $ b2 c d `mappend` invalidChars ds
+             | c < 0xf0 = case cs of
+                        [] -> h $ H3_1 c
+                        [d] -> h $ H3_2 c d
+                        (d:e:es) -> m $ b3 c d e `mappend` invalidChars es
+             | c < 0xf5 = case cs of
+                        [] -> h $ H4_1 c
+                        [d] -> h $ H4_2 c d 
+                        [d,e] -> h $ H4_3 c d e 
+                        (d:e:f:fs) -> m $ b4 c d e f `mappend` invalidChars fs
+             | otherwise = mempty
+
+invalidChars :: CharReducer m => [Word8] -> m
+invalidChars = foldr (mappend . invalidChar . return) mempty
+
+merge :: CharReducer m => H -> T -> (m -> a) -> (H -> a) -> a
+merge H0 cs k _               = k $ invalidChars cs
+merge (H2_1 c) [] _ p         = p $ H2_1 c
+merge (H2_1 c) (d:ds) k _     = k $ b2 c d `mappend` invalidChars ds
+merge (H3_1 c) [] _ p         = p $ H3_1 c
+merge (H3_1 c) [d] _ p        = p $ H3_2 c d
+merge (H3_1 c) (d:e:es) k _   = k $ b3 c d e `mappend` invalidChars es
+merge (H3_2 c d) [] _ p       = p $ H3_2 c d
+merge (H3_2 c d) (e:es) k _   = k $ b3 c d e `mappend` invalidChars es
+merge (H4_1 c) [] _ p         = p $ H4_1 c
+merge (H4_1 c) [d] _ p        = p $ H4_2 c d
+merge (H4_1 c) [d,e] _ p      = p $ H4_3 c d e
+merge (H4_1 c) (d:e:f:fs) k _ = k $ b4 c d e f `mappend` invalidChars fs
+merge (H4_2 c d) [] _ p       = p $ H4_2 c d 
+merge (H4_2 c d) [e] _ p      = p $ H4_3 c d e
+merge (H4_2 c d) (e:f:fs) k _ = k $ b4 c d e f `mappend` invalidChars fs
+merge (H4_3 c d e) [] _ p     = p $ H4_3 c d e
+merge (H4_3 c d e) (f:fs) k _ = k $ b4 c d e f `mappend` invalidChars fs
+
+instance CharReducer m => Monoid (UTF8 m) where
+    mempty = T []
+    T c `mappend` T d = T (c ++ d)
+    T c `mappend` S l m r = S (c ++ l) m r
+    S l m c `mappend` S c' m' r = S l (m `mappend` merge c c' id flushH `mappend` m') r
+    s@(S _ _ _) `mappend` T [] = s
+    S l m c `mappend` T c' = merge c c' k (S l m) where
+        k m' = S l (m `mappend` m') H0
+
+instance CharReducer m => Reducer Word8 (UTF8 m) where
+    unit c | c >= 0x80 && c < 0xc0 = T [c]
+           | otherwise = snocH H0 c (S []) mempty
+    S t m h `snoc` c        = snocH h c (S t) m
+    T t     `snoc` c        | c >= 0x80 && c < 0xc0 = T (t ++ [c])
+                            | otherwise = snocH H0 c (S t) mempty
+
+    c       `cons` T cs     = consT c cs (S [] mempty) (flip (S []) H0) T
+    c       `cons` S cs m h = consT c cs k1 k2 k3 where
+        k1 h' = S [] (flushH h' `mappend` m) h
+        k2 m' = S [] (m' `mappend` m) h
+        k3 t' = S t' m h
+    
+instance Functor UTF8 where
+    fmap f (S t x h) = S t (f x) h
+    fmap _ (T t) = T t
+
+instance Pointed UTF8 where
+    point f = S [] f H0
+
+runUTF8 :: CharReducer m => UTF8 m -> m 
+runUTF8 (T t) = flushT t
+runUTF8 (S t m h) = flushT t `mappend` m `mappend` flushH h
diff --git a/Data/Monoid/Lexical/Words.hs b/Data/Monoid/Lexical/Words.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Lexical/Words.hs
@@ -0,0 +1,98 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, GeneralizedNewtypeDeriving, ParallelListComp, TypeFamilies #-}
+module Data.Monoid.Lexical.Words 
+    ( module Data.Monoid.Reducer.Char
+    , Words
+    , runWords
+    , Lines
+    , runLines
+    , Unspaced(runUnspaced)
+    , Unlined(runUnlined)
+    , wordsFrom
+    , linesFrom
+    ) where
+
+import Data.Char (isSpace)
+import Data.Maybe (maybeToList)
+import Data.Monoid.Reducer.Char
+import Data.Monoid.Generator
+import Control.Functor.Pointed
+
+data Words m = Chunk (Maybe m)
+             | Segment (Maybe m) [m] (Maybe m)
+    deriving (Show,Read)
+
+runWords :: Words m -> [m]
+runWords (Chunk m) = maybeToList m
+runWords (Segment l m r) = maybeToList l ++ m ++ maybeToList r
+
+instance Monoid m => Monoid (Words m) where
+    mempty = Chunk mempty
+    Chunk l `mappend` Chunk r = Chunk (l `mappend` r)
+    Chunk l `mappend` Segment l' m r = Segment (l `mappend` l') m r
+    Segment l m r `mappend` Chunk r' = Segment l m (r `mappend` r')
+    Segment l m r `mappend` Segment l' m' r' = Segment l (m ++ maybeToList (r `mappend` l') ++ m') r'
+
+instance Reducer Char m => Reducer Char (Words m) where
+    unit c | isSpace c = Segment (Just (unit c)) [] mempty
+           | otherwise = Chunk (Just (unit c))
+
+instance Functor Words where
+    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
+
+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))
+
+runLines :: Lines m -> [m]
+runLines (Lines x) = runWords x
+
+newtype Unspaced m = Unspaced { runUnspaced :: m }  deriving (Eq,Ord,Show,Read,Monoid)
+
+instance Reducer Char m => Reducer Char (Unspaced m) where
+    unit c | isSpace c = mempty
+           | otherwise = Unspaced (unit c)
+
+instance CharReducer m => CharReducer (Unspaced m) where
+    invalidChar = Unspaced . invalidChar
+
+instance Functor Unspaced where
+    fmap f (Unspaced x) = Unspaced (f x)
+
+instance Pointed Unspaced where
+    point = Unspaced
+
+instance Copointed Unspaced where
+    extract = runUnspaced
+
+newtype Unlined m = Unlined { runUnlined :: m }  deriving (Eq,Ord,Show,Read,Monoid)
+
+instance Reducer Char m => Reducer Char (Unlined m) where
+    unit '\n' = mempty
+    unit c = Unlined (unit c)
+
+instance CharReducer m => CharReducer (Unlined m) where
+    invalidChar = Unlined . invalidChar
+
+instance Functor Unlined where
+    fmap f (Unlined x) = Unlined (f x)
+
+instance Pointed Unlined where
+    point = Unlined
+
+instance Copointed Unlined where
+    extract = runUnlined
+
+-- 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
+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))
diff --git a/Data/Monoid/Map.hs b/Data/Monoid/Map.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Map.hs
@@ -0,0 +1,20 @@
+{-# 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
diff --git a/Data/Monoid/Monad.hs b/Data/Monoid/Monad.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Monad.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts #-}
+module Data.Monoid.Monad 
+    ( module Control.Monad
+    , module Data.Monoid.Reducer
+    , Action(Action,getAction)
+    , MonadSum(MonadSum,getMonadSum)
+    , ActionWith(ActionWith,getActionWith)
+    ) where
+
+import Data.Monoid.Reducer
+import Control.Monad (MonadPlus, mplus, mzero, (>=>), liftM2)
+
+newtype Action m = Action { getAction :: m () } 
+
+instance Monad m => Monoid (Action m) where
+    mempty = Action (return ())
+    Action a `mappend` Action b = Action (a >> b)
+
+instance Monad m => Reducer (m a) (Action m) where
+    unit a = Action (a >> return ())
+    a `cons` Action b = Action (a >> b)
+    Action a `snoc` b = Action (a >> b >> return ())
+
+{-# RULES "unitAction" unit = Action #-}
+{-# RULES "snocAction" snoc = snocAction #-} 
+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)
+
+instance MonadPlus m => Reducer (m a) (MonadSum m a) where
+    unit = MonadSum
+
+newtype ActionWith m n = ActionWith { getActionWith :: m n }
+
+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 (Monad m, Monoid n) => Reducer (m n) (ActionWith m n) where
+    unit = ActionWith
diff --git a/Data/Monoid/Monad/Cont.hs b/Data/Monoid/Monad/Cont.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Monad/Cont.hs
@@ -0,0 +1,27 @@
+{-# 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
diff --git a/Data/Monoid/Monad/Either.hs b/Data/Monoid/Monad/Either.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Monad/Either.hs
@@ -0,0 +1,36 @@
+{-# 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')
diff --git a/Data/Monoid/Monad/IO.hs b/Data/Monoid/Monad/IO.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Monad/IO.hs
@@ -0,0 +1,28 @@
+{-# 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
diff --git a/Data/Monoid/Monad/Identity.hs b/Data/Monoid/Monad/Identity.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Monad/Identity.hs
@@ -0,0 +1,17 @@
+{-# 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
diff --git a/Data/Monoid/Monad/RWS/Lazy.hs b/Data/Monoid/Monad/RWS/Lazy.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Monad/RWS/Lazy.hs
@@ -0,0 +1,27 @@
+{-# 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
diff --git a/Data/Monoid/Monad/RWS/Strict.hs b/Data/Monoid/Monad/RWS/Strict.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Monad/RWS/Strict.hs
@@ -0,0 +1,28 @@
+{-# 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
diff --git a/Data/Monoid/Monad/Reader.hs b/Data/Monoid/Monad/Reader.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Monad/Reader.hs
@@ -0,0 +1,27 @@
+{-# 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
diff --git a/Data/Monoid/Monad/ST/Lazy.hs b/Data/Monoid/Monad/ST/Lazy.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Monad/ST/Lazy.hs
@@ -0,0 +1,21 @@
+{-# 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
+
+
diff --git a/Data/Monoid/Monad/ST/Strict.hs b/Data/Monoid/Monad/ST/Strict.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Monad/ST/Strict.hs
@@ -0,0 +1,21 @@
+{-# 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
+
+
diff --git a/Data/Monoid/Monad/STM.hs b/Data/Monoid/Monad/STM.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Monad/STM.hs
@@ -0,0 +1,19 @@
+{-# 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
diff --git a/Data/Monoid/Monad/State/Lazy.hs b/Data/Monoid/Monad/State/Lazy.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Monad/State/Lazy.hs
@@ -0,0 +1,27 @@
+{-# 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
diff --git a/Data/Monoid/Monad/State/Strict.hs b/Data/Monoid/Monad/State/Strict.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Monad/State/Strict.hs
@@ -0,0 +1,27 @@
+{-# 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
diff --git a/Data/Monoid/Monad/Writer/Lazy.hs b/Data/Monoid/Monad/Writer/Lazy.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Monad/Writer/Lazy.hs
@@ -0,0 +1,27 @@
+{-# 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
diff --git a/Data/Monoid/Monad/Writer/Strict.hs b/Data/Monoid/Monad/Writer/Strict.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Monad/Writer/Strict.hs
@@ -0,0 +1,27 @@
+{-# 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
diff --git a/Data/Monoid/Multiplicative.hs b/Data/Monoid/Multiplicative.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Multiplicative.hs
@@ -0,0 +1,37 @@
+module Data.Monoid.Multiplicative 
+    ( module Data.Monoid.Additive
+    , MultiplicativeMonoid
+    , one, times
+    ) where
+
+import Data.Monoid.Additive
+import Data.FingerTree
+import Data.Monoid.FromString
+import Data.Monoid.Monad.Identity
+import Data.Monoid.Generator
+import qualified Data.Sequence as Seq
+import Data.Sequence (Seq)
+
+class MultiplicativeMonoid 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 ]
+
+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 (Monoid m) => MultiplicativeMonoid (Seq m) where
+    one = Seq.singleton mempty
+    xss `times` yss = runIdentity $ mapReduce (flip fmap yss . mappend) xss
+
+instance MultiplicativeMonoid m => MultiplicativeMonoid (Identity m) where
+    one = Identity one
+    Identity a `times` Identity b = Identity (a `times` b)
+
+instance MultiplicativeMonoid m => MultiplicativeMonoid (FromString m) where
+    one = FromString one
+    FromString a `times` FromString b = FromString (a `times` b)
diff --git a/Data/Monoid/Multiplicative/Sugar.hs b/Data/Monoid/Multiplicative/Sugar.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Multiplicative/Sugar.hs
@@ -0,0 +1,14 @@
+module Data.Monoid.Multiplicative.Sugar
+    ( module Data.Monoid.Additive.Sugar
+    , module Data.Monoid.Multiplicative
+    , (*)
+    ) where
+
+import Data.Monoid.Additive.Sugar
+import Data.Monoid.Multiplicative
+import Prelude hiding ((*))
+
+infixl 7 *
+
+(*) :: MultiplicativeMonoid r => r -> r -> r
+(*) = times
diff --git a/Data/Monoid/Multiplicative/Transformer.hs b/Data/Monoid/Multiplicative/Transformer.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Multiplicative/Transformer.hs
@@ -0,0 +1,19 @@
+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)
diff --git a/Data/Monoid/Ord.hs b/Data/Monoid/Ord.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Ord.hs
@@ -0,0 +1,105 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+-----------------------------------------------------------------------------
+---- |
+---- Module      :  Data.Monoid.Ord
+---- Copyright   :  (c) Edward Kmett 2009
+---- License     :  BSD-style
+---- Maintainer  :  libraries@haskell.org
+---- Stability   :  experimental
+---- Portability :  portable
+----
+---- Some 'Monoid' instances that should probably be in "Data.Monoid".
+----
+-----------------------------------------------------------------------------
+
+module Data.Monoid.Ord 
+    ( module Data.Monoid.Reducer
+    -- * Max
+    , Max(Max,getMax)
+    -- * Min
+    , Min(Min,getMin)
+    -- * MaxPriority: Max semigroup w/ added bottom
+    , MaxPriority(MaxPriority,getMaxPriority)
+    -- * MinPriority: Min semigroup w/ added top
+    , MinPriority(MinPriority,getMinPriority)
+    ) where
+
+import Control.Functor.Pointed
+import Data.Monoid.Reducer (Reducer, unit, Monoid, mappend, mempty)
+
+
+-- | The 'Monoid' @('max','minBound')@
+newtype Max a = Max { getMax :: a } deriving (Eq,Ord,Show,Read,Bounded)
+
+instance (Ord a, Bounded a) => Monoid (Max a) where
+    mempty = Max minBound
+    mappend = max
+
+instance (Ord a, Bounded a) => Reducer a (Max a) where
+    unit = Max
+
+instance Functor Max where 
+    fmap f (Max a) = Max (f a)
+
+instance Pointed Max where
+    point = Max
+
+instance Copointed Max where
+    extract = getMax
+
+-- | The 'Monoid' given by @('min','maxBound')@
+newtype Min a = Min { getMin :: a } deriving (Eq,Ord,Show,Read,Bounded)
+
+instance (Ord a, Bounded a) => Monoid (Min a) where
+    mempty = Min maxBound
+    mappend = min
+
+instance (Ord a, Bounded a) => Reducer a (Min a) where
+    unit = Min
+
+instance Functor Min where
+    fmap f (Min a) = Min (f a)
+
+instance Pointed Min where
+    point = Min
+
+instance Copointed Min where
+    extract = getMin
+
+-- | The 'Monoid' @('max','Nothing')@ over @'Maybe' a@ where 'Nothing' is the bottom element
+newtype MaxPriority a = MaxPriority { getMaxPriority :: Maybe a } deriving (Eq,Ord,Show,Read)
+
+instance Ord a => Monoid (MaxPriority a) where
+    mempty = MaxPriority Nothing
+    mappend = max
+
+instance Ord a => Reducer (Maybe a) (MaxPriority a) where
+    unit = MaxPriority
+
+instance Functor MaxPriority where
+    fmap f (MaxPriority a) = MaxPriority (fmap f a)
+
+instance Pointed MaxPriority where
+    point = MaxPriority . Just
+
+-- | The 'Monoid' @('min','Nothing')@ over @'Maybe' a@ where 'Nothing' is the top element
+newtype MinPriority a = MinPriority { getMinPriority :: Maybe a } deriving (Eq,Show,Read)
+
+instance Ord a => Ord (MinPriority a) where
+    MinPriority Nothing  `compare` MinPriority Nothing  = EQ
+    MinPriority Nothing  `compare` _                    = GT
+    _                    `compare` MinPriority Nothing  = LT
+    MinPriority (Just a) `compare` MinPriority (Just b) = a `compare` b
+
+instance Ord a => Monoid (MinPriority a) where
+    mempty = MinPriority Nothing
+    mappend = min
+
+instance Ord a => Reducer (Maybe a) (MinPriority a) where
+    unit = MinPriority
+
+instance Functor MinPriority where
+    fmap f (MinPriority a) = MinPriority (fmap f a)
+
+instance Pointed MinPriority where
+    point = MinPriority . Just
diff --git a/Data/Monoid/Reducer.hs b/Data/Monoid/Reducer.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Reducer.hs
@@ -0,0 +1,142 @@
+{-# LANGUAGE UndecidableInstances , FlexibleContexts , MultiParamTypeClasses , FlexibleInstances , GeneralizedNewtypeDeriving , FunctionalDependencies #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Data.Monoid.Reducer
+    ( module Data.Monoid
+    , Reducer
+    , unit, snoc, cons
+    , foldMapReduce
+    , foldReduce
+    ) where
+
+import Data.Monoid
+import Data.Foldable
+import Data.FingerTree
+import qualified Data.Sequence as Seq
+import Data.Sequence (Seq)
+import qualified Data.Set as Set
+import Data.Set (Set)
+import qualified Data.IntSet as IntSet
+import Data.IntSet (IntSet)
+import qualified Data.IntMap as IntMap
+import Data.IntMap (IntMap)
+import qualified Data.Map as Map
+import Data.Map (Map)
+--import qualified Data.BitSet as BitSet
+--import Data.BitSet (BitSet)
+
+-- minimal definition unit or snoc
+class Monoid m => Reducer c m where
+    unit :: c -> m 
+    snoc :: m -> c -> m
+    cons :: c -> m -> m 
+
+    unit = snoc mempty 
+    snoc m = mappend m . unit
+    cons = mappend . unit
+
+foldMapReduce :: (Foldable f, e `Reducer` m) => (a -> e) -> f a -> m
+foldMapReduce f = foldMap (unit . f)
+
+foldReduce :: (Foldable f, e `Reducer` m) => f e -> m
+foldReduce = foldMap unit
+
+instance (Reducer c m, Reducer c n) => Reducer c (m,n) where
+    unit x = (unit x,unit x)
+    (m,n) `snoc` x = (m `snoc` x, n `snoc` x)
+    x `cons` (m,n) = (x `cons` m, x `cons` n)
+
+instance (Reducer c m, Reducer c n, Reducer c o) => Reducer c (m,n,o) where
+    unit x = (unit x,unit x, unit x)
+    (m,n,o) `snoc` x = (m `snoc` x, n `snoc` x, o `snoc` x)
+    x `cons` (m,n,o) = (x `cons` m, x `cons` n, x `cons` o)
+
+instance (Reducer c m, Reducer c n, Reducer c o, Reducer c p) => Reducer c (m,n,o,p) where
+    unit x = (unit x,unit x, unit x, unit x)
+    (m,n,o,p) `snoc` x = (m `snoc` x, n `snoc` x, o `snoc` x, p `snoc` x)
+    x `cons` (m,n,o,p) = (x `cons` m, x `cons` n, x `cons` o, x `cons` p)
+
+instance Reducer c [c] where
+    unit = return
+    cons = (:)
+    xs `snoc` x = xs ++ [x]
+
+instance Reducer c () where
+    unit _ = ()
+    _ `snoc` _ = ()
+    _ `cons` _ = ()
+
+instance Reducer Bool Any where
+    unit = Any
+
+instance Reducer Bool All where
+    unit = All
+
+instance Reducer (a -> a) (Endo a) where
+    unit = Endo
+
+instance Monoid a => Reducer a (Dual a) where
+    unit = Dual
+    
+instance Num a => Reducer a (Sum a) where
+    unit = Sum
+
+instance Num a => Reducer a (Product a) where
+    unit = Product
+
+instance Reducer (Maybe a) (First a) where
+    unit = First
+
+instance Reducer a (First a) where
+    unit = First . Just
+
+instance Reducer (Maybe a) (Last a) where
+    unit = Last
+
+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 Reducer a (Seq a) where
+    unit = Seq.singleton
+    cons = (Seq.<|)
+    snoc = (Seq.|>)
+
+instance Reducer Int IntSet where
+    unit = IntSet.singleton
+    cons = IntSet.insert
+    snoc = flip IntSet.insert -- left bias irrelevant
+
+instance Ord a => Reducer a (Set a) where
+    unit = Set.singleton
+    cons = Set.insert
+    -- pedantic in case Eq doesn't implement structural equality
+    snoc s m | Set.member m s = s 
+             | otherwise = Set.insert m s
+
+instance Reducer (Int,v) (IntMap v) where
+    unit = uncurry IntMap.singleton
+    cons = uncurry IntMap.insert
+    snoc = flip . uncurry . IntMap.insertWith $ const id
+
+instance Ord k => Reducer (k,v) (Map k v) where
+    unit = uncurry Map.singleton
+    cons = uncurry Map.insert
+    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
+-}
diff --git a/Data/Monoid/Reducer/Char.hs b/Data/Monoid/Reducer/Char.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Reducer/Char.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE UndecidableInstances, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-}
+module Data.Monoid.Reducer.Char
+    ( module Data.Monoid.Reducer
+    , CharReducer
+    , invalidChar
+    , fromChar
+    ) where
+
+import Data.Monoid.Reducer
+import Data.Word (Word8)
+
+class Reducer Char m => CharReducer m where
+    fromChar :: Char -> m 
+    fromChar = unit
+
+    invalidChar :: [Word8] -> m
+    invalidChar = const mempty
+
+instance (CharReducer m, CharReducer m') =>  CharReducer (m,m') where
+    invalidChar bs = (invalidChar bs, invalidChar bs)
+
+instance (CharReducer m, CharReducer m', CharReducer m'') =>  CharReducer (m,m',m'') where
+    invalidChar bs = (invalidChar bs, invalidChar bs, invalidChar bs)
+
+instance (CharReducer m, CharReducer m', CharReducer m'', CharReducer m''') =>  CharReducer (m,m',m'',m''') where
+    invalidChar bs = (invalidChar bs, invalidChar bs, invalidChar bs, invalidChar bs)
+
+instance CharReducer [Char]
diff --git a/Data/Monoid/Reducer/Sugar.hs b/Data/Monoid/Reducer/Sugar.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Reducer/Sugar.hs
@@ -0,0 +1,17 @@
+{-# 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
diff --git a/Data/Monoid/Reducer/With.hs b/Data/Monoid/Reducer/With.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Reducer/With.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-}
+module Data.Monoid.Reducer.With
+    ( module Data.Monoid.Reducer
+    , WithReducer(WithReducer,runWithReducer)
+    , withoutReducer
+    ) where
+
+import Data.Monoid.Reducer
+import Data.FingerTree
+
+newtype WithReducer c m = WithReducer { runWithReducer :: (m,c) } 
+
+withoutReducer :: c `WithReducer` m -> c
+withoutReducer = snd . runWithReducer
+
+instance (c `Reducer` m) => Reducer (c `WithReducer` m) m where
+    unit = fst . runWithReducer 
+
+instance (c `Reducer` m) => Measured m (c `WithReducer` m) where
+    measure = fst . runWithReducer
diff --git a/Data/Monoid/Unit.hs b/Data/Monoid/Unit.hs
new file mode 100644
--- /dev/null
+++ b/Data/Monoid/Unit.hs
@@ -0,0 +1,39 @@
+{-# 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 ()
diff --git a/Data/Ring.hs b/Data/Ring.hs
new file mode 100644
--- /dev/null
+++ b/Data/Ring.hs
@@ -0,0 +1,28 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Data.Ring
+    ( module Data.Group
+    , module Data.Ring.Semi
+    ) 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
diff --git a/Data/Ring/FromNum.hs b/Data/Ring/FromNum.hs
new file mode 100644
--- /dev/null
+++ b/Data/Ring/FromNum.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
+module Data.Ring.FromNum 
+    ( module Data.Ring
+    , FromNum(FromNum, getFromNum)
+    ) where
+
+import Data.Ring
+import Data.Monoid.Reducer
+
+newtype FromNum a = FromNum { getFromNum :: a } deriving (Eq,Show,Num)
+
+instance Num a => Monoid (FromNum a) where
+    mempty = fromInteger 0
+    mappend = (+)
+
+instance Num a => Group (FromNum a) where
+    minus = (-)
+    gnegate = negate
+    
+instance Num a => MultiplicativeMonoid (FromNum a) where
+    one = fromInteger 1
+    times = (*)
+
+instance Num a => Seminearring (FromNum a)
+    
+instance Num a => Reducer Integer (FromNum a) where
+    unit = fromInteger
diff --git a/Data/Ring/Semi.hs b/Data/Ring/Semi.hs
new file mode 100644
--- /dev/null
+++ b/Data/Ring/Semi.hs
@@ -0,0 +1,9 @@
+module Data.Ring.Semi
+    ( module Data.Ring.Semi.Near
+    , Semiring
+    ) where
+
+import Data.Ring.Semi.Near
+
+class Seminearring a => Semiring a
+
diff --git a/Data/Ring/Semi/Near.hs b/Data/Ring/Semi/Near.hs
new file mode 100644
--- /dev/null
+++ b/Data/Ring/Semi/Near.hs
@@ -0,0 +1,19 @@
+module Data.Ring.Semi.Near
+    ( module Data.Monoid.Multiplicative
+    , Seminearring
+    ) where
+
+import Data.Monoid.Multiplicative
+import Data.FingerTree
+import Data.Monoid.FromString
+import Data.Monoid.Monad.Identity
+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)
diff --git a/Data/Ring/Semi/Ord.hs b/Data/Ring/Semi/Ord.hs
new file mode 100644
--- /dev/null
+++ b/Data/Ring/Semi/Ord.hs
@@ -0,0 +1,119 @@
+{-# 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
+    ( module Data.Ring.Semi
+    , Order(Order,getOrder)
+    , Priority(MinBound,Priority,MaxBound)
+    ) where
+
+import Test.QuickCheck
+-- import Control.Applicative
+import Control.Functor.Pointed
+import Data.Ring.Semi
+import Data.Monoid.Ord
+import Data.Monoid.Reducer
+
+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
+    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) => Reducer a (Order a) where
+    unit = Order
+
+instance Functor Order where
+    fmap f (Order a) = Order (f a)
+
+instance Pointed Order where
+    point = Order
+
+instance Copointed Order where
+    extract = getOrder
+
+
+
+
+
+
+
+data Priority a = MinBound | Priority a | MaxBound deriving (Eq,Read,Show)
+
+instance Bounded (Priority a) where
+    minBound = MinBound
+    maxBound = MaxBound
+
+instance Ord a => Ord (Priority a) where
+  MinBound   <= _         = True
+  Priority _ <= MinBound  = False
+  Priority a <= Priority b = a <= b
+  Priority _ <= MaxBound  = True
+  MaxBound   <= MaxBound  = True
+  MaxBound   <= _         = False
+
+  MinBound   `min` _          = MinBound
+  _          `min` MinBound   = MinBound
+  Priority a `min` Priority b = Priority (a `min` b)
+  u          `min` MaxBound   = u
+  MaxBound   `min` v          = v
+  
+  MinBound   `max` v          = v
+  u          `max` MinBound   = u
+  Priority a `max` Priority b = Priority (a `max` b)
+  _          `max` MaxBound   = MaxBound
+  MaxBound   `max` _          = MaxBound
+
+instance Arbitrary a => Arbitrary (Priority a) where
+  arbitrary = frequency [ (1 ,return MinBound)
+                        , (10, fmap Priority arbitrary)
+                        , (1 ,return MaxBound) ]
+  coarbitrary MinBound    = variant 0
+  coarbitrary (Priority a) = variant 1 . coarbitrary a
+  coarbitrary MaxBound    = variant 2
+
+instance Ord a => Monoid (Priority a) where
+    mappend = max
+    mempty = minBound
+
+instance Ord a => MultiplicativeMonoid (Priority a) where
+    times = min
+    one = maxBound
+
+instance Ord a => Seminearring (Priority a)
+instance Ord a => Semiring (Priority a)
+
+instance Ord a => Reducer a (Priority a) where
+    unit = Priority
+
+instance Ord a => Reducer (MinPriority a) (Priority a) where
+    unit (MinPriority Nothing)  = MaxBound
+    unit (MinPriority (Just x)) = Priority x
+
+instance Ord a => Reducer (MaxPriority a) (Priority a) where
+    unit (MaxPriority Nothing)  = MinBound
+    unit (MaxPriority (Just x)) = Priority x
+
+instance Functor Priority where
+    fmap _ MaxBound = MaxBound
+    fmap f (Priority a) = Priority (f a)
+    fmap _ MinBound = MinBound
+
+instance Pointed Priority where
+    point = Priority
diff --git a/Data/Ring/Sugar.hs b/Data/Ring/Sugar.hs
new file mode 100644
--- /dev/null
+++ b/Data/Ring/Sugar.hs
@@ -0,0 +1,7 @@
+module Data.Ring.Sugar 
+    ( module Data.Monoid.Multiplicative.Sugar
+    , module Data.Ring.Semi.Near
+    ) where
+
+import Data.Monoid.Multiplicative.Sugar
+import Data.Ring.Semi.Near
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2009 Edward Kmett
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Isaac Jones nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,7 @@
+#!/usr/bin/runhaskell
+> module Main (main) where
+
+> import Distribution.Simple
+
+> main :: IO ()
+> main = defaultMain
diff --git a/monoids.cabal b/monoids.cabal
new file mode 100644
--- /dev/null
+++ b/monoids.cabal
@@ -0,0 +1,64 @@
+name:		    monoids
+version:	    0.1.2
+license:	    BSD3
+license-file:   LICENSE
+author:		    Edward A. Kmett
+maintainer:	    Edward A. Kmett <ekmett@gmail.com>
+stability:	    experimental
+homepage:	    http://comonad.com/reader
+category:	    Data
+synopsis:	    Lots of Monoids
+description:    Lots of Monoids
+copyright:      (c) 2009 Edward A. Kmett
+build-type:     Simple
+cabal-version:  >=1.2
+
+library
+  build-depends: base >= 4, text, fingertree, bytestring, category-extras, parallel, containers, mtl, stm, bitset, QuickCheck
+  exposed-modules:
+    Data.Group
+    Data.Group.Sugar
+    Data.Monoid.Additive
+    Data.Monoid.Additive.Sugar
+    Data.Monoid.Applicative
+    Data.Monoid.Categorical
+    Data.Monoid.FromString
+    Data.Monoid.Generator
+    Data.Monoid.Generator.Combinators
+    Data.Monoid.IntMap
+    Data.Monoid.Lexical.SourcePosition
+    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.Ring
+    Data.Ring.Semi
+    Data.Ring.Semi.Near
+    Data.Ring.Semi.Ord
+    Data.Ring.FromNum
+    Data.Ring.Sugar
+  ghc-options: -Wall -fno-warn-duplicate-exports