Data.Monoid
Marc A. Ziegert
coeus at gmx.de
Tue Oct 25 21:05:05 EDT 2005
oh. pure haskell98... i forgot that old problem. :/
well, i still miss the arrow-(&&&)-version of that monoid.
but, to newtype it, may be the better solution.
[code]
newtype ParArrow f a b = ParArrow (f a b) -- monoid iff b is monoid
newtype SerArrow f a b = SerArrow (f a b) -- monoid on endomorphisms
instance (Arrow f) => Arrow (ParArrow f) where
... -- derived
instance (Arrow f) => Arrow (SerArrow f) where
... -- derived
instance (Arrow f, Monoid b) => Monoid (ParArrow f a b) where
mempty = pure (const mempty)
mappend a b = (a &&& b) >>> pure (uncurry mappend)
instance (Arrow f) => Monoid (SerArrow f a a) where
mempty = pure id
mappend = (>>>)
[/code]
Am Dienstag, 25. Oktober 2005 19:05 schrieb Iavor Diatchki:
> Hello,
> These instances overlap, which is not allowed in Haskell.
> -Iavor
>
> On 10/24/05, Marc A. Ziegert <coeus at gmx.de> wrote:
> > 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 (:))
>
>
More information about the Libraries
mailing list