[Haskell-cafe] What's the advantage of writing Haskell this way?
John Ky
newhoggy at gmail.com
Tue May 31 02:33:01 CEST 2011
Hi Brandon,
Thanks for your suggestion. I'm a little stuck as adding Monad and
MonadPlus in my instance declaration doesn't seem sufficient. I know
mconcat comes from Monoid, but I don't know how to put that in.
data Stream m a
= Chunks (m a)
| EOF
deriving (Show, Eq)
instance (Monad m, MonadPlus m) => Monoid (Stream m a) where
mempty = Chunks mempty
mappend (Chunks xs) (Chunks ys) = Chunks (xs `mappend` ys)
mappend _ _ = EOF
instance (Monad m, MonadPlus m) => Monad (Stream m) where
return = Chunks . return
Chunks xs >>= f = mconcat (fmap f xs)
EOF >>= _ = EOF
Iteratee.hs:28:25:
No instance for (Monoid (m a))
arising from a use of `mempty'
Possible fix: add an instance declaration for (Monoid (m a))
In the first argument of `Chunks', namely `mempty'
In the expression: Chunks mempty
In an equation for `mempty': mempty = Chunks mempty
Iteratee.hs:29:54:
No instance for (Monoid (m a))
arising from a use of `mappend'
Possible fix: add an instance declaration for (Monoid (m a))
In the first argument of `Chunks', namely `(xs `mappend` ys)'
In the expression: Chunks (xs `mappend` ys)
In an equation for `mappend':
mappend (Chunks xs) (Chunks ys) = Chunks (xs `mappend` ys)
Iteratee.hs:34:43:
Could not deduce (m ~ [])
from the context (Monad m, MonadPlus m)
bound by the instance declaration at Iteratee.hs:32:10-51
`m' is a rigid type variable bound by
the instance declaration at Iteratee.hs:32:17
Expected type: [a]
Actual type: m a
In the second argument of `fmap', namely `xs'
In the first argument of `mconcat', namely `(fmap f xs)'
In the expression: mconcat (fmap f xs)
Failed, modules loaded: none.
Cheers,
-John
On 31 May 2011 00:38, Brandon Moore <brandon_m_moore at yahoo.com> wrote:
> >From: John Ky <newhoggy at gmail.com>
> >Sent: Monday, May 30, 2011 8:01 AM
> >
> >Hi all,
> >
> >I'm trying to learn about enumerators by reading this paper and came
> across some code on page 2 that I found hard to digest, but I think I
> finally got it:
>
>
> Hi John. These programs should behave identically, and I think your version
> should be preferred.
> This first code uses some class methods like mconcat, but it seems to
> always be used on
> the list in Chunks, so it will only ever use the definition for list, which
> is equivalent to what
> you wrote directly in the second code.
>
> The result may not be useful, but to understand this more thoroughly you
> might
> try parametrizating the definition of Stream so the use of more general
> operators
> actually means something. Perhaps
>
> data Stream m a =
> Chunks (m a)
> | EOF
>
> I think you would want Monad and MonadPlus on m.
>
>
> >import Data.Monoid
> >>
> >>
> >>data Stream a
> >>= Chunks [a]
> >>| EOF
> >>deriving (Show, Eq)
> >>
> >>
> >>instance Monad Stream where
> >>return = Chunks . return
> >>Chunks xs >>= f = mconcat (fmap f xs)
> >>EOF >>= _ = EOF
> >>
> >>
> >>instance Monoid (Stream a) where
> >>mempty = Chunks mempty
> >>mappend (Chunks xs) (Chunks ys) = Chunks (xs ++ ys)
> >>mappend _ _ = EOF
> >
> >
> >I guess, it shows my lack of experience in Haskell, but my question is,
> why is writing the code this way preferred over say writing it like this:
> >
> >
> >import Data.Monoid
> >>
> >>
> >>data Stream a
> >>= Chunks [a]
> >>| EOF
> >>deriving (Show, Eq)
> >>
> >>
> >>instance Monad Stream where
> >>return x = Chunks [x]
> >>Chunks xs >>= f = mconcat (fmap f xs)
> >>EOF >>= _ = EOF
> >>
> >>
> >>instance Monoid (Stream a) where
> >>mempty = Chunks []
> >>mappend (Chunks xs) (Chunks ys) = Chunks (xs ++ ys)
> >>mappend _ _ = EOF
> >
> >
> >Cheers,
> >
> >
> >-John
> >
> >
> >_______________________________________________
> >Haskell-Cafe mailing list
> >Haskell-Cafe at haskell.org
> >http://www.haskell.org/mailman/listinfo/haskell-cafe
> >
> >
> >
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20110531/bbfbe299/attachment.htm>
More information about the Haskell-Cafe
mailing list