[documentation ekmett@gmail.com**20090327001246] { hunk ./dist/doc/html/monoids/Data-Monoid-Reducer.html 908 +>
foldReduce :: (Foldable f, Reducer e m) => f e -> mSource
foldReduceData.Monoid.Reducer, Data.Monoid.Reducer.Char, Data.Monoid.Lexical.SourcePosition, Data.Monoid.Lexical.UTF8.Decoder, Data.Monoid.Reducer.With, Data.Monoid.Generator, Data.Monoid.Reducer.Sugar, Data.Monoid.Lexical.Words, Data.Monoid.Monad, Data.Monoid.Applicative, Data.Monoid.Self, Data.Monoid.Generator.Combinators, Data.Monoid.Unit ) where - -import Data.Monoid -import Data.Foldable -import Data.FingerTree - --- 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) - -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 - -instance Measured v a => Monoid (FingerTree v a) where - mempty = empty - mappend = (><) + , foldReduce + ) where + +import Data.Monoid +import Data.Foldable +import Data.FingerTree + +-- 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 hunk ./dist/doc/html/monoids/src/Data-Monoid-Reducer.html 94 -instance Measured v a => Reducer a (FingerTree v a) where - unit = singleton - cons = (<|) - snoc = (|>) +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 = (|>) }