[documentation
ekmett@gmail.com**20090327043314] {
hunk ./dist/doc/html/monoids/Data-Monoid-Reducer.html 814
+>| Reducer ((,) Int v) (IntMap v) | | Reducer ((,) Int v) (IntMap v) |
| Ord k => Reducer ((,) k v) (Map k v) |
| Ord k => Reducer ((,) k v) (Map k v) |
-
-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
+import qualified Data.IntMap as IntMap
+import Data.IntMap (IntMap)
+import qualified Data.Map as Map
+import Data.Map (Map)
+
+
+class Monoid m => Reducer c m where
+ unit :: c -> m
+ snoc :: m -> c -> m
+ cons :: c -> m -> m
hunk ./dist/doc/html/monoids/src/Data-Monoid-Reducer.html 39
-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
-
-
-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 Ord a => Reducer a (Set a) where
- unit = Set.singleton
- cons = Set.insert
- snoc s m | Set.member m s = s
- | otherwise = Set.insert m s
-
-instance Reducer Int IntSet where
- unit = IntSet.singleton
- cons = IntSet.insert
- snoc = flip IntSet.insert
+ 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
+
+
+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
+
+instance Ord a => Reducer a (Set a) where
+ unit = Set.singleton
+ cons = Set.insert
+
+ 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
}