how can i fix this?
Mmmh I really need some haskell type class traingings ;)

============= test file ==============================================
module Main where
import HList
import HOccurs
import Control.Monad.Reader

class Get a b where
  get :: a -> b

data D1 = D1 Int -- dummy type

type ActionMonad a l = forall l. (HOccurs D1 l)
                               => ( ReaderT l IO a )

data CR = CR (ActionMonad Bool ()) 

instance Get CR (ActionMonad Bool ()) where
  get (CR a) = a

main = do
  print "test"

============= error ==================================================
|| [1 of 1] Compiling Main             ( uqt.hs, uqt.o )
|| 
uqt.hs|16| 0:
||     Illegal polymorphic or qualified type: forall l.
||                                         (HOccurs D1 l) =>
||                                         ReaderT l IO Bool
||     In the instance declaration for `Get CR (ActionMonad Bool ())'

======================================================================

Marc
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to