[Haskell-cafe] Multi-Class monadic type?

Alexander Treptow alexander.treptow at googlemail.com
Wed Feb 3 09:17:36 EST 2010


Thanks,
i tried it with your code changes but then i ll only get a type mismatch

Test.hs:12:11:
Couldn't match expected type `forall a. (Conf a, MonadIO m) => m a'
       against inferred type `forall a (m1 :: * -> *). (Conf a, MonadIO 
m1) => m1 a'
In the expression: TestType
In the definition of `testFunc': testFunc = TestType


Miguel Mitrofanov schrieb:
> Error message suggests that you've used "Conf" improperly.
>
> testFunc :: (forall a. Conf a, MonadIO m => m a) -> TestType
>
> is illegal, as I recall, you should use another pair of brackets:
>
> testFunc :: (forall a. (Conf a, MonadIO m) => m a) -> TestType
>
> Alexander Treptow wrote:
>> Hi,
>> i got a little problem and don't know how to solve that. Hope you can
>> help me.
>>
>> code:
>> ----------
>> module Test where
>> {-# LANGUAGE Rank2Types, RankNTypes #-}
>> import Control.Monad.Trans
>>
>> data TestType = TestType
>>  {tst :: (Conf a, MonadIO m) => m a}
>>
>> class Conf a where
>>  get :: MonadIO m => m a
>>
>> testFunc :: (forall a. Conf a, MonadIO m => m a) -> TestType
>> testFunc = TestType
>> --------------
>> error:
>> --------------
>> Test.hs:11:23
>>    Class `Conf' used as a type
>>    In the type signature for `testFunc':
>>      testFunc :: (forall a. Conf a, (MonadIO m) => m a) -> TestType
>> --------------
>>
>> explanation:
>> I need a data type that creates a record with a member that has no fixed
>> type, because its not known at compile-time. The Rank2Types language
>> extension fits that need, but i figured out that i ll need to make that
>> time monadic to avoid the use of unsafePerformIO in the program that
>> uses this lib.
>>
>> Thanks and greetings,
>>    Alex
>>
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>
>



More information about the Haskell-Cafe mailing list