[Data.Set
ekmett@gmail.com**20090327041621] {
hunk ./Data/Monoid/Applicative.hs 10
+import Control.Functor.Pointed (Pointed, point)
hunk ./Data/Monoid/Applicative.hs 25
+
hunk ./Data/Monoid/Applicative.hs 43
-newtype TraversalWith m n = TraversalWith { getTraversalWith :: m n }
+instance Pointed f => Pointed (Alternate f) where
+ point = Alternate . point
+
+newtype TraversalWith f n = TraversalWith { getTraversalWith :: f n }
hunk ./Data/Monoid/Applicative.hs 48
-instance (Applicative m, Monoid n) => Monoid (TraversalWith m n) where
+instance (Applicative f, Monoid n) => Monoid (TraversalWith f n) where
hunk ./Data/Monoid/Applicative.hs 52
-instance (Applicative m, Monoid n) => Reducer (m n) (TraversalWith m n) where
+instance (Applicative f, Monoid n) => Reducer (f n) (TraversalWith f n) where
hunk ./Data/Monoid/Applicative.hs 55
+instance Functor f => Functor (TraversalWith f) where
+ fmap f = TraversalWith . fmap f . getTraversalWith
+
+instance Pointed f => Pointed (TraversalWith f) where
+ point = TraversalWith . point
hunk ./Data/Monoid/Reducer.hs 16
+import qualified Data.Set as Set
+import Data.Set (Set)
hunk ./Data/Monoid/Reducer.hs 105
+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
+
hunk ./dist/doc/html/monoids/Data-Monoid-Applicative.html 280
+>Pointed f => Pointed (Alternate f)| m n | f n :: m n :: f nFunctor f => Functor (TraversalWith f)
| Pointed f => Pointed (TraversalWith f) |
| m, f, (m n) ( (f n) ( m n) | f n) m, f, m n) f n)Ord a => Reducer a (Set a)
| m, f, (m n) ( (f n) ( m n) | f n)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 ())
-
-
-
-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)
-
-newtype TraversalWith m n = TraversalWith { getTraversalWith :: m n }
+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 ())
+
+
+
+
+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)
hunk ./dist/doc/html/monoids/src/Data-Monoid-Applicative.html 51
-instance (Applicative m, Monoid n) => Monoid (TraversalWith m n) where
- mempty = TraversalWith (pure mempty)
- TraversalWith a `mappend` TraversalWith b = TraversalWith (liftA2 mappend a b)
-
-instance (Applicative m, Monoid n) => Reducer (m n) (TraversalWith m n) where
- unit = TraversalWith
-
+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
hunk ./dist/doc/html/monoids/src/Data-Monoid-Reducer.html 24
-
-
-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
-
-
-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.|>)
+import qualified Data.Set as Set
+import Data.Set (Set)
+
+
+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
+
+
+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
}