[auto ekmett@gmail.com**20090329234524] { hunk ./doc/html/monoids/Data-Group.html 421 -> (TraversalWith (App (ActionWith (Mon WrappedApplicative f a = WrappedApplicative Alt f a = AltgetWrappedApplicativegetAlt TraversalWith f m = TraversalWith App f m = AppgetTraversalWithgetApp WrappedApplicativeAltWrappedApplicativeAltWrappedApplicativeAltgetWrappedApplicativegetAltshow/hideshow/hide
(Alternative f, Reducer c a) => Reducer c (WrappedApplicative f a) (WrappedApplicative (Alt (WrappedApplicative (Alt (WrappedApplicative (AltPointed f => Pointed (WrappedApplicativeApplicative f => Pointed (AltCopointed f => Copointed (WrappedApplicativeCopointed f => Copointed (AltAlternative f => Reducer (f a) (Alt f a) (WrappedApplicative (Alt (WrappedApplicative (Alt (WrappedApplicative (Alt (WrappedApplicative (Alt (WrappedApplicative (Alt(Alternative(Applicative (WrappedApplicative (Alt (WrappedApplicative (Alt TraversalWithApp over rTraversalWithApp over rTraversalWithAppgetTraversalWithgetAppshow/hideshow/hide
c (TraversalWith c (App r (TraversalWith r (App r (TraversalWith r (App r (TraversalWith r (App (TraversalWith (App (TraversalWith (App (TraversalWith (AppPointed f => Pointed (TraversalWithPointed f => Pointed (AppCopointed f => Copointed (TraversalWithCopointed f => Copointed (App (TraversalWith (App (TraversalWith (App (TraversalWith (App (TraversalWith (App (TraversalWith (App (TraversalWith (AppCMonoid m n o
Mon m n o where
Mon :: Monoid m => m -> Mon m a a
categoryToMonoid :: CMonoid m m m -> mgetMon :: Mon m m m -> mmonoidToCategory :: Monoid m => m -> CMonoid m m m Mon m n o whereCMonoid m n o with one object. +> with one object. This fakes that with a GADT hunk ./doc/html/monoids/Data-Monoid-Categorical.html 385 ->Constructors
Mon :: Monoid m => m -> Mon m a a
show/hideshow/hide
c (Mon c (CMonoid (Mon (CMonoid (Mon (CMonoidMonoid m => Reducer (CMonoid m m m) mgetMon :: MoncategoryToMonoid :: CMonoid
monoidToCategory :: Monoid m => m -> CMonoid m m mSource
Convert a value in a Monoid into an arrow in a Category. +msum :: (Generator c, MonadPlus m, m a ~ Elem c) => c -> m aasum :: (Generator c, Alternative f, f a ~ Elem c) => c -> f a
msum :: (Generator c, MonadPlus m, m a ~ Elem c) => c -> m aSource
The sum of a collection of actions, generalizing concat +
asum :: (Generator c, Alternative f, f a ~ Elem c) => c -> f aSource
The sum of a collection of actions, generalizing concat hunk ./doc/html/monoids/Data-Monoid-Monad.html 96 ->Lifting Modules +>MonadPlus Monoid hunk ./doc/html/monoids/Data-Monoid-Monad.html 101 ->Wrapped Monads +>Lifting Modules hunk ./doc/html/monoids/Data-Monoid-Monad.html 210 -> ActionWith f m = ActionWith MonadSum m a = MonadSumgetActionWith :: f mgetMonadSum :: m a WrappedMonad m a = WrappedMonad Mon f m = MongetWrappedMonad :: m agetMon :: f mLifting Modules +>MonadPlus Monoid hunk ./doc/html/monoids/Data-Monoid-Monad.html 470 -> ActionWith f m MonadSum m a if m is a ModuleA MonadSum over r and f is a turns any MonadPlus instance into a Monoid. + It also provides a Multiplicative instance for a then f ActionWith wrapped around a Monoid m is a Module + and asserts that any MonadPlus as well +> applied to a Monoid forms a LeftSemiNearRing + under these operations. hunk ./doc/html/monoids/Data-Monoid-Monad.html 539 ->ActionWithMonadSumgetActionWith :: f mgetMonadSum :: m ashow/hideshow/hide
(Reducer c m, f) => Reducer c (ActionWith f m)(Module r m, m => f) => Module r (ActionWith f m) (MonadSum m)(RightModule r m, f) => RightModule r (ActionWith f m) m => Functor (MonadSum m)(LeftModule r m, Monad f) => LeftModule r (ActionWith f m)MonadPlus m => MonadPlus (MonadSum m) f => Monad (ActionWith f) m => Applicative (MonadSum m)Functor f => Functor (ActionWith f)Monad m => Pointed (MonadSum m) f => MonadPlus (ActionWith f)Pointed f => Pointed (ActionWith f) m => Reducer (m a) (MonadSum m a) (f m) => (m a) => (ActionWith f m) (MonadSum m a) (f m) => (m a) => (ActionWith f m) (MonadSum m a) (f m) => (m a) => (ActionWith f m) (MonadSum m a) (f m) => (m a) => (ActionWith f m) (MonadSum m a)(MonadPlus m => m, (MonadSum m a)( f) => m, (ActionWith f m) a) => Multiplicative (MonadSum m a)(Group m, Monad f) => Group (ActionWith f m)(MonadPlus m, Monoid a) => LeftSemiNearRing (MonadSum m a)Wrapped Monads +>Lifting Modules hunk ./doc/html/monoids/Data-Monoid-Monad.html 736 -> WrappedMonad m a Mon f m A WrappedMonad turns any MonadPlus instance into a Monoid. - It also provides a Multiplicativeif m is a Module instance for a over r and f is a wrapped around a Monoid - and asserts that any MonadPlus applied to a Monoid then f Mon forms a LeftSemiNearRing m is a Module - under these operations. +> as well hunk ./doc/html/monoids/Data-Monoid-Monad.html 790 ->WrappedMonadMongetWrappedMonad :: m agetMon :: f mshow/hideshow/hide
(MonadPlus m, ( c a) => c m, Monad f) => c (WrappedMonad m a) c (Mon f m)(Module r m, Monad f) => Module r (Mon f m)(RightModule r m, Monad f) => RightModule r (Mon f m)(LeftModule r m, Monad f) => LeftModule r (Mon f m) m => f => (WrappedMonad m) (Mon f) m => f => (WrappedMonad m) (Mon f) m => f => (WrappedMonad m) (Mon f)Pointed m => Pointed (WrappedMonad m)Pointed f => Pointed (Mon f) (m a) => (f m) => (WrappedMonad m a) (Mon f m) (m a) => (f m) => (WrappedMonad m a) (Mon f m) (m a) => (f m) => (WrappedMonad m a) (Mon f m) (m a) => (f m) => (WrappedMonad m a) (Mon f m)MonadPlus m => ( (WrappedMonad m a)( m, m, f) => a) => Multiplicative (WrappedMonad m a) (Mon f m)(MonadPlus m, Monoid a) => LeftSemiNearRing (WrappedMonad m a)(Group m, Monad f) => Group (Mon f m)(Alternative(Applicative (WrappedApplicative (Alt (WrappedMonad (MonadSum c (TraversalWith c (App(Alternative f, Reducer c a) => Reducer c (WrappedApplicative f a) c (ActionWith c (Mon(MonadPlus m, Reducer c a) => Reducer c (WrappedMonad m a) c (Mon c (CMonoidAlternative f => Reducer (f a) (Alt f a)MonadPlus m => Reducer (m a) (MonadSum m a)Monoid m => Reducer (CMonoid m m m) m r (TraversalWith r (App r (ActionWith r (Mon r (TraversalWith r (App r (ActionWith r (Mon r (TraversalWith r (App r (ActionWith r (Mon (WrappedApplicative (Alt (WrappedMonad (MonadSumActionWith1 (Type/Class)Data.Monoid.Monad2 (Data Constructor)Data.Monoid.MonadAlt1 (Type/Class)Data.Monoid.Applicative2 (Data Constructor)Data.Monoid.ApplicativeApp1 (Type/Class)Data.Monoid.Applicative2 (Data Constructor)Data.Monoid.ApplicativeasumData.Monoid.CombinatorscategoryToMonoidData.Monoid.CategoricalCMonoidData.Monoid.CategoricalgetActionWithgetAllData.Monoid.MonadData.Monoid.Reducer, Data.Monoid.Reducer.Char, Data.Monoid.Lexical.UTF8.Decoder, Data.Monoid.Reducer.With, Data.Monoid.Generator, Data.Monoid.Lexical.SourcePosition, Data.Monoid.Lexical.Words, Data.Monoid.Self, Data.Monoid.Generator.LZ78, Data.Monoid.FromString, Data.Monoid.Categorical, Data.Monoid.Additive, Data.Monoid.Additive.Sugar, Data.Monoid.Multiplicative, Data.Monoid.Multiplicative.Sugar, Data.Ring.Semi.Near, Data.Ring.Semi, Data.Ring.Semi.Ord, Data.Ring.Semi.Tropical, Data.Ring.Sugar, Data.Group, Data.Group.Combinators, Data.Group.Sugar, Data.Ring, Data.Ring.Boolean, Data.Ring.FromNum, Data.Ring.Module, Data.Monoid.Applicative, Data.Monoid.Monad, Data.Monoid.Combinators, Data.Monoid.Generator.Free, Data.Monoid.Generator.RLE, Data.Ring.Module.AutomaticDifferentiationgetAllgetAltData.Monoid.Reducer, Data.Monoid.Reducer.Char, Data.Monoid.Lexical.UTF8.Decoder, Data.Monoid.Reducer.With, Data.Monoid.Generator, Data.Monoid.Lexical.SourcePosition, Data.Monoid.Lexical.Words, Data.Monoid.Self, Data.Monoid.Generator.LZ78, Data.Monoid.FromString, Data.Monoid.Categorical, Data.Monoid.Additive, Data.Monoid.Additive.Sugar, Data.Monoid.Multiplicative, Data.Monoid.Multiplicative.Sugar, Data.Ring.Semi.Near, Data.Ring.Semi, Data.Ring.Semi.Ord, Data.Ring.Semi.Tropical, Data.Ring.Sugar, Data.Group, Data.Group.Combinators, Data.Group.Sugar, Data.Ring, Data.Ring.Boolean, Data.Ring.FromNum, Data.Ring.Module, Data.Monoid.Applicative, Data.Monoid.Monad, Data.Monoid.Combinators, Data.Monoid.Generator.Free, Data.Monoid.Generator.RLE, Data.Ring.Module.AutomaticDifferentiationData.Monoid.ApplicativegetAppData.Monoid.ApplicativeData.Monoid.CategoricalData.Monoid.MonadgetMonadSumData.Monoid.MonadgetTraversalWithData.Monoid.ApplicativegetWrappedApplicativeData.Monoid.ApplicativegetWrappedMonadData.Monoid.MonadData.Monoid.CategoricalData.Monoid.MonadData.Monoid.CategoricalData.Monoid.MonadMonadSum1 (Type/Class)Data.Monoid.Monad2 (Data Constructor)Data.Monoid.MonadmonoidToCategoryData.Monoid.CategoricalmsumData.Monoid.CombinatorsTraversalWith1 (Type/Class)Data.Monoid.Applicative2 (Data Constructor)Data.Monoid.ApplicativeWrappedApplicative1 (Type/Class)Data.Monoid.Applicative2 (Data Constructor)Data.Monoid.ApplicativeWrappedMonad1 (Type/Class)Data.Monoid.Monad2 (Data Constructor)Data.Monoid.Monad , WrappedApplicative(WrappedApplicative,getWrappedApplicative) - , TraversalWith(TraversalWith,getTraversalWith) + , Alt(Alt,getAlt) + , App(App,getApp) hunk ./doc/html/monoids/src/Data-Monoid-Applicative.html 54 -{-# 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 + +-- | 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 +{-# RULES "unitTraversal" unit = Traversal #-} +{-# RULES "snocTraversal" snoc = snocTraversal #-} hunk ./doc/html/monoids/src/Data-Monoid-Applicative.html 62 - --- | 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 WrappedApplicative f a = WrappedApplicative { getWrappedApplicative :: f a } - deriving (Eq,Ord,Show,Read,Functor,Pointed,Applicative,Alternative,Copointed) - -instance Alternative f => Monoid (WrappedApplicative f a) where - mempty = empty - WrappedApplicative a `mappend` WrappedApplicative b = WrappedApplicative (a <|> b) - -instance (Alternative f, Monoid a) => Multiplicative (WrappedApplicative f a) where - one = pure mempty - times = liftA2 mappend - -instance (Alternative f, c `Reducer` a) => Reducer c (WrappedApplicative f a) where - unit = WrappedApplicative . pure . unit - -instance (Alternative f, Monoid a) => LeftSemiNearRing (WrappedApplicative f a) +-- | A 'Alt' 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 Alt f a = Alt { getAlt :: f a } + deriving (Eq,Ord,Show,Read,Functor,Applicative,Alternative,Copointed) + +instance Alternative f => Monoid (Alt f a) where + mempty = empty + Alt a `mappend` Alt b = Alt (a <|> b) + +instance (Applicative f, Monoid a) => Multiplicative (Alt f a) where + one = pure mempty + times = liftA2 mappend + +instance Applicative f => Pointed (Alt f) where + point = pure + +instance Alternative f => Reducer (f a) (Alt f a) where + unit = Alt hunk ./doc/html/monoids/src/Data-Monoid-Applicative.html 84 --- | if @m@ is a 'Module' and @f@ is a 'Applicative' then @f `TraversalWith` m@ is a 'Module' as well +instance (Alternative f, Monoid a) => LeftSemiNearRing (Alt f a) hunk ./doc/html/monoids/src/Data-Monoid-Applicative.html 86 -newtype TraversalWith f m = TraversalWith { getTraversalWith :: f m } - deriving (Eq,Ord,Show,Read,Functor,Pointed,Applicative,Alternative,Copointed) - -instance (Monoid m, Applicative f) => Monoid (f `TraversalWith` m) where - mempty = pure mempty - mappend = liftA2 mappend - -instance (Group m, Applicative f) => Group (f `TraversalWith` m) where - gnegate = fmap gnegate - minus = liftA2 minus - gsubtract = liftA2 gsubtract - -instance (c `Reducer` m, Applicative f) => Reducer c (f `TraversalWith` m) where - unit = pure . unit - -instance (LeftModule r m, Applicative f) => LeftModule r (f `TraversalWith` m) where - x *. m = (x *.) <$> m - -instance (RightModule r m, Applicative f) => RightModule r (f `TraversalWith` m) where - m .* y = (.* y) <$> m - -instance (Module r m, Applicative f) => Module r (f `TraversalWith` m) +-- | if @m@ is a 'Module' over @r@ and @f@ is a 'Applicative' then @f `App` m@ is a 'Module' over @r@ as well + +newtype App f m = App { getApp :: f m } + deriving (Eq,Ord,Show,Read,Functor,Pointed,Applicative,Alternative,Copointed) + +instance (Monoid m, Applicative f) => Monoid (f `App` m) where + mempty = pure mempty + mappend = liftA2 mappend + +instance (Group m, Applicative f) => Group (f `App` m) where + gnegate = fmap gnegate + minus = liftA2 minus + gsubtract = liftA2 gsubtract + +instance (c `Reducer` m, Applicative f) => Reducer c (f `App` m) where + unit = pure . unit + +instance (LeftModule r m, Applicative f) => LeftModule r (f `App` m) where + x *. m = (x *.) <$> m + +instance (RightModule r m, Applicative f) => RightModule r (f `App` m) where + m .* y = (.* y) <$> m + +instance (Module r m, Applicative f) => Module r (f `App` m) hunk ./doc/html/monoids/src/Data-Monoid-Categorical.html 28 - , Mon(Mon) - , getMon - ) where - -import Prelude hiding ((.),id) -import Data.Monoid.Reducer -import Control.Category - --- | 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 (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 - --- | 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 + , CMonoid + , categoryToMonoid + , monoidToCategory + ) where + +import Prelude hiding ((.),id) +import Data.Monoid.Reducer +import Control.Category + +-- | 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 (GEndo k a) where + mempty = GEndo id + GEndo f `mappend` GEndo g = GEndo (f . g) + +-- | A 'Monoid' is just a 'Category' with one object. This fakes that with a GADT +data CMonoid m n o where + M :: Monoid m => m -> CMonoid m a a + +-- | Extract the 'Monoid' from its representation as a 'Category' +categoryToMonoid :: CMonoid m m m -> m +categoryToMonoid (M m) = m +{-# INLINE categoryToMonoid #-} + +-- | Convert a value in a 'Monoid' into an arrow in a 'Category'. +monoidToCategory :: Monoid m => m -> CMonoid m m m +monoidToCategory = M +{-# INLINE monoidToCategory #-} + +instance Monoid m => Category (CMonoid m) where + id = M mempty + M a . M b = M (a `mappend` b) + +instance Monoid m => Monoid (CMonoid m m m) where + mempty = id + mappend = (.) + +instance (c `Reducer` m) => Reducer c (CMonoid m m m) where + unit = M . unit + +instance Monoid m => Reducer (CMonoid m m m) m where + unit (M m) = m hunk ./doc/html/monoids/src/Data-Monoid-Combinators.html 32 - -- * Applicative Reduction - , traverse_ - , for_ - -- * Logical Reduction - , and - , or - , any - , all - -- * Monoidal Reduction - , foldMap - , fold - , toList - -- * List-Like Reduction - , concatMap - , elem - , filter - , find - , sum - , product - , notElem - -- * List-Like Monoid Generation - , repeat - , replicate - , cycle - -- * QuickCheck Properties - , prop_replicate_right_distributive - ) 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 -import Test.QuickCheck - --- | 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_ = mapReduceWith getTraversal -{-# INLINE traverse_ #-} - --- | flipped 'traverse_' as in "Data.Foldable" -for_ :: (Generator c, Applicative f) => c -> (Elem c -> f b) -> f () -for_ = flip traverse_ -{-# INLINE for_ #-} - --- | 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_ = mapReduceWith getAction -{-# INLINE mapM_ #-} - --- | flipped 'mapM_' as in "Data.Foldable" and "Control.Monad" -forM_ :: (Generator c, Monad m) => c -> (Elem c -> m b) -> m () -forM_ = flip mapM_ -{-# INLINE forM_ #-} - --- | 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 = mapReduceWith getSelf -{-# INLINE foldMap #-} - --- | A further specialization of "foldMap" -concatMap :: Generator c => (Elem c -> [b]) -> c -> [b] -concatMap = foldMap -{-# INLINE concatMap #-} - --- | 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 = reduceWith getSelf -{-# INLINE fold #-} - --- | Convert any 'Generator' to a list of its contents -toList :: Generator c => c -> [Elem c] -toList = reduce -{-# INLINE toList #-} - --- | Efficiently 'reduce' a 'Generator' that contains values of type 'Bool' -and :: (Generator c, Elem c ~ Bool) => c -> Bool -and = reduceWith getAll -{-# INLINE and #-} - --- | Efficiently 'reduce' a 'Generator' that contains values of type 'Bool' -or :: (Generator c, Elem c ~ Bool) => c -> Bool -or = reduceWith getAny -{-# INLINE or #-} - --- | 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 = mapReduceWith getAny -{-# INLINE any #-} - --- | 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 = mapReduceWith getAll -{-# INLINE all #-} - --- | Efficiently 'mapReduce' any 'Generator' using the 'Sum' 'Monoid' -sum :: (Generator c, Num (Elem c)) => c -> Elem c -sum = reduceWith getSum -{-# INLINE sum #-} - --- | Efficiently 'mapReduce' any 'Generator' using the 'Product' 'Monoid' -product :: (Generator c, Num (Elem c)) => c -> Elem c -product = reduceWith getProduct -{-# INLINE product #-} - --- | 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 . (==) -{-# INLINE elem #-} - --- | 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 -{-# INLINE notElem #-} - --- | 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 -{-# INLINE filter #-} - -filterWith :: (Generator c, Elem c `Reducer` m) => (m -> n) -> (Elem c -> Bool) -> c -> n -filterWith f p = f . filter p -{-# INLINE filterWith #-} - --- | A specialization of 'filter' using the 'First' 'Monoid', analogous to 'Data.List.find' -find :: Generator c => (Elem c -> Bool) -> c -> Maybe (Elem c) -find = filterWith getFirst -{-# INLINE find #-} - --- | 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) -{-# INLINE replicate #-} - --- | 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 - -prop_replicate_right_distributive :: (Eq m, Monoid m, Arbitrary m, Integral n) => m -> n -> n -> Bool -prop_replicate_right_distributive m x y - = replicate m (x + y) == replicate m x `mappend` replicate m y + , msum + -- * Applicative Reduction + , traverse_ + , for_ + , asum + -- * Logical Reduction + , and + , or + , any + , all + -- * Monoidal Reduction + , foldMap + , fold + , toList + -- * List-Like Reduction + , concatMap + , elem + , filter + , find + , sum + , product + , notElem + -- * List-Like Monoid Generation + , repeat + , replicate + , cycle + -- * QuickCheck Properties + , prop_replicate_right_distributive + ) where + +import Prelude hiding (mapM_, any, elem, filter, concatMap, and, or, all, sum, product, notElem, replicate, cycle, repeat) +import Control.Applicative +import Control.Monad (MonadPlus) +import Data.Monoid.Generator +import Data.Monoid.Applicative +import Data.Monoid.Self +import Data.Monoid.Monad +import Test.QuickCheck + +-- | 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_ = mapReduceWith getTraversal +{-# INLINE traverse_ #-} + +-- | flipped 'traverse_' as in "Data.Foldable" +for_ :: (Generator c, Applicative f) => c -> (Elem c -> f b) -> f () +for_ = flip traverse_ +{-# INLINE for_ #-} + +-- | The sum of a collection of actions, generalizing 'concat' +asum :: (Generator c, Alternative f, f a ~ Elem c) => c -> f a +asum = reduceWith getAlt +{-# INLINE asum #-} + +-- | 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_ = mapReduceWith getAction +{-# INLINE mapM_ #-} + +-- | flipped 'mapM_' as in "Data.Foldable" and "Control.Monad" +forM_ :: (Generator c, Monad m) => c -> (Elem c -> m b) -> m () +forM_ = flip mapM_ +{-# INLINE forM_ #-} + +-- | The sum of a collection of actions, generalizing 'concat' +msum :: (Generator c, MonadPlus m, m a ~ Elem c) => c -> m a +msum = reduceWith getMonadSum +{-# INLINE msum #-} + +-- | 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 = mapReduceWith getSelf +{-# INLINE foldMap #-} + +-- | A further specialization of "foldMap" +concatMap :: Generator c => (Elem c -> [b]) -> c -> [b] +concatMap = foldMap +{-# INLINE concatMap #-} + +-- | 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 = reduceWith getSelf +{-# INLINE fold #-} + +-- | Convert any 'Generator' to a list of its contents +toList :: Generator c => c -> [Elem c] +toList = reduce +{-# INLINE toList #-} + +-- | Efficiently 'reduce' a 'Generator' that contains values of type 'Bool' +and :: (Generator c, Elem c ~ Bool) => c -> Bool +and = reduceWith getAll +{-# INLINE and #-} + +-- | Efficiently 'reduce' a 'Generator' that contains values of type 'Bool' +or :: (Generator c, Elem c ~ Bool) => c -> Bool +or = reduceWith getAny +{-# INLINE or #-} + +-- | 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 = mapReduceWith getAny +{-# INLINE any #-} + +-- | 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 = mapReduceWith getAll +{-# INLINE all #-} + +-- | Efficiently 'mapReduce' any 'Generator' using the 'Sum' 'Monoid' +sum :: (Generator c, Num (Elem c)) => c -> Elem c +sum = reduceWith getSum +{-# INLINE sum #-} + +-- | Efficiently 'mapReduce' any 'Generator' using the 'Product' 'Monoid' +product :: (Generator c, Num (Elem c)) => c -> Elem c +product = reduceWith getProduct +{-# INLINE product #-} + +-- | 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 . (==) +{-# INLINE elem #-} + +-- | 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 +{-# INLINE notElem #-} + +-- | 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 +{-# INLINE filter #-} + +filterWith :: (Generator c, Elem c `Reducer` m) => (m -> n) -> (Elem c -> Bool) -> c -> n +filterWith f p = f . filter p +{-# INLINE filterWith #-} + +-- | A specialization of 'filter' using the 'First' 'Monoid', analogous to 'Data.List.find' +find :: Generator c => (Elem c -> Bool) -> c -> Maybe (Elem c) +find = filterWith getFirst +{-# INLINE find #-} + +-- | 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) +{-# INLINE replicate #-} + +-- | 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 + +prop_replicate_right_distributive :: (Eq m, Monoid m, Arbitrary m, Integral n) => m -> n -> n -> Bool +prop_replicate_right_distributive m x y + = replicate m (x + y) == replicate m x `mappend` replicate m y hunk ./doc/html/monoids/src/Data-Monoid-Monad.html 30 - -- * Lifting Modules - , ActionWith(ActionWith,getActionWith) - -- * Wrapped Monads - , WrappedMonad(WrappedMonad, getWrappedMonad) + -- * MonadPlus Monoid + , MonadSum(MonadSum, getMonadSum) + -- * Lifting Modules + , Mon(Mon,getMon) hunk ./doc/html/monoids/src/Data-Monoid-Monad.html 36 -import Control.Functor.Pointed -import Data.Monoid.Reducer -import Data.Ring.Semi.Near -import Data.Ring.Module -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 - 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 #-} - --- | 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 - --- | 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. - -newtype WrappedMonad m a = WrappedMonad { getWrappedMonad :: m a } - deriving (Eq,Ord,Show,Read,Functor,Pointed, Monad,MonadPlus) - -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 (MonadPlus m, c `Reducer` a) => Reducer c (WrappedMonad m a) where - unit = WrappedMonad . return . unit - -instance (MonadPlus m, Monoid a) => LeftSemiNearRing (WrappedMonad m a) - --- | if @m@ is a 'Module' over @r@ and @f@ is a 'Monad' then @f `ActionWith` m@ is a 'Module' as well - -newtype ActionWith f m = ActionWith { getActionWith :: f m } - deriving (Eq,Ord,Show,Read,Functor,Pointed, Monad,MonadPlus) - -instance (Monoid m, Monad f) => Monoid (f `ActionWith` m) where - mempty = return mempty - mappend = liftM2 mappend +import Control.Applicative +import Control.Functor.Pointed +import Data.Monoid.Reducer +import Data.Ring.Semi.Near +import Data.Ring.Module +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 + 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 #-} + +-- | 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 + +-- | A 'MonadSum' 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. + +newtype MonadSum m a = MonadSum { getMonadSum :: m a } + deriving (Eq,Ord,Show,Read,Monad,MonadPlus) + +instance (Monad m, Monoid a) => Multiplicative (MonadSum m a) where + one = MonadSum (return mempty) + MonadSum m `times` MonadSum n = MonadSum (liftM2 mappend m n) + +instance MonadPlus m => Monoid (MonadSum m a) where + mempty = mzero + mappend = mplus + +instance Monad m => Functor (MonadSum m) where + fmap = liftM + +instance Monad m => Applicative (MonadSum m) where + pure = return + (<*>) = ap + +instance Monad m => Pointed (MonadSum m) where + point = return + +instance MonadPlus m => Reducer (m a) (MonadSum m a) where + unit = MonadSum hunk ./doc/html/monoids/src/Data-Monoid-Monad.html 94 -instance (Group m, Monad f) => Group (f `ActionWith` m) where - gnegate = liftM gnegate - minus = liftM2 minus - gsubtract = liftM2 gsubtract - -instance (c `Reducer` m, Monad f) => Reducer c (f `ActionWith` m) where - unit = return . unit - -instance (LeftModule r m, Monad f) => LeftModule r (f `ActionWith` m) where - x *. m = liftM (x *.) m +instance (MonadPlus m, Monoid a) => LeftSemiNearRing (MonadSum m a) + +-- | if @m@ is a 'Module' over @r@ and @f@ is a 'Monad' then @f `Mon` m@ is a 'Module' as well + +newtype Mon f m = Mon { getMon :: f m } + deriving (Eq,Ord,Show,Read,Functor,Pointed, Monad,MonadPlus) + +instance (Monoid m, Monad f) => Monoid (f `Mon` m) where + mempty = return mempty + mappend = liftM2 mappend hunk ./doc/html/monoids/src/Data-Monoid-Monad.html 105 -instance (RightModule r m, Monad f) => RightModule r (f `ActionWith` m) where - m .* y = liftM (.* y) m - -instance (Module r m, Monad f) => Module r (f `ActionWith` m) +instance (Group m, Monad f) => Group (f `Mon` m) where + gnegate = liftM gnegate + minus = liftM2 minus + gsubtract = liftM2 gsubtract + +instance (c `Reducer` m, Monad f) => Reducer c (f `Mon` m) where + unit = return . unit + +instance (LeftModule r m, Monad f) => LeftModule r (f `Mon` m) where + x *. m = liftM (x *.) m + +instance (RightModule r m, Monad f) => RightModule r (f `Mon` m) where + m .* y = liftM (.* y) m + +instance (Module r m, Monad f) => Module r (f `Mon` m) }