Good evening everyone,

My program reads:

module Boom where

import Control.Monad.State

type SucParser s = StateT [s] []

newtype WithUnit s a = WithUnit (SucParser s (a, ()))

foo :: SucParser s [s]
foo = get

bar :: WithUnit s [s]
bar = WithUnit get

The compiler complains:

Boom.hs:13:0:
    Couldn't match expected type `([s], ())'
           against inferred type `[s]'
    When using functional dependencies to combine
      MonadState s (StateT s m),
        arising from the instance declaration at <no location info>
      MonadState ([s], ()) (StateT [s] []),
        arising from a use of `get' at Boom.hs:13:15-17
    When generalising the type(s) for `bar'

I'm wondering if I'm making a silly mistake or if there's something less trivial going on here. Could someone please explain the error and give a hint on how to fix it?

Thanks much. :-)

Martijn.

_______________________________________________
Haskell-Cafe mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to