Data.Monoid
Marc A. Ziegert
coeus at gmx.de
Mon Oct 24 19:29:51 EDT 2005
Erm...
Did anyone read my suggestion? No comments? I feel a little bit ignored.
<http://comments.gmane.org/gmane.comp.lang.haskell.libraries/3795>
Excerpt (revised):
[code]
class Sequence m where
sequence :: [m a] -> m [a]
instance Monad m => Sequence m where
sequence = Control.Monad.sequence
instance (Arrow f) => Sequence (f a) where
sequence [] = pure (const [])
sequence [f] = f >>> pure (:[])
sequence (f:fr) = (f &&& sequence fr) >>> pure (uncurry (:))
--Ross Paterson's Monoid:
rp_concat :: (Monoid b) => [a->b] -> a->b
rp_concat = rp_concat'
rp_concat' :: (Arrow f,Monoid b) => [f a b] -> f a b
rp_concat' fs = sequence fs >>> pure mconcat
[/code]
Am Montag, 24. Oktober 2005 11:40 schrieb Ross Paterson:
> Speaking of boring libraries,
>
> On 9/13/05, Ross Paterson <ross at soi.city.ac.uk> wrote:
> > (regurgitating
> > http://www.haskell.org/pipermail/libraries/2005-July/004057.html)
> >
> > I propose to replace the instance
> >
> > instance Monoid (a -> a) where
> > mempty = id
> > mappend = (.)
> >
> > with
> >
> > newtype Endo a = Endo { runEndo :: a -> a }
> >
> > instance Monoid (Endo a) where
> > mempty = Endo id
> > Endo f `mappend` Endo g = Endo (f . g)
> >
> > instance Monoid b => Monoid (a -> b) where
> > mempty _ = mempty
> > mappend f g x = f x `mappend` g x
>
> On Tue, Sep 13, 2005 at 12:04:00PM -0700, Iavor Diatchki wrote:
> > I am not sure what the process is, but this seems like a good idea to
> > me.
>
> I'm not sure either, so I'll just make the change unless someone objects
> convincingly.
>
> To recap: with Haskell's class system, we can have only one (->) instance,
> so we have to choose.
>
> The old instance is easy to use with Writer monads, and ShowS is a
> special case. With the new instance, one would have to wrap and unwrap
> the newtype.
>
> The new instance is consistent with the instances for tuples, and it's
> compositional, in that it builds instances for complex types out of
> instances for simpler ones, e.g. (first one from Conor):
>
> newtype Parser s a = P ([s] -> [(a, [s])])
>
> instance Monoid (Parser s a) where
> mempty = P mempty
> P f `mappend` P g = P (f `mappend` g)
>
> newtype Automaton a b = A (a -> (b, Automaton a b))
>
> instance Monoid b => Monoid (Automaton a b) where
> mempty = A mempty
> A f `mappend` A g = A (f `mappend` g)
>
> With GHC's newtype-deriving, the first one could just be
>
> newtype Parser s a = P ([s] -> [(a, [s])])
> deriving (Monoid)
>
> The new instance is also Haskell 98.
>
> _______________________________________________
> Libraries mailing list
> Libraries at haskell.org
> http://www.haskell.org/mailman/listinfo/libraries
>
>
More information about the Libraries
mailing list