[Haskell-cafe] A small (?) problem with type families

Andy Gimblett haskell at gimbo.org.uk
Fri Nov 13 16:13:11 EST 2009


Hahaha, this is what I get for trying to think about Haskell on a  
Friday night.  Now I think it _is_ a functional dependency after all.   
Who knows how long it will be before I change my mind again? :-)

I shall think about this more carefully tomorrow...

Thanks again,

-Andy

On 13 Nov 2009, at 20:48, Andy Gimblett wrote:

> Ack. I've just realised that P/Q is not a functional dependency.  I  
> need to use a multi-parameter type class there.  So my question is  
> probably completely pointless - sorry!
>
> Thanks anyway,
>
> -Andy
>
> On 13 Nov 2009, at 20:26, Andy Gimblett wrote:
>
>> Hi all,
>>
>> This email is literate Haskell.  I'm trying to use type families to
>> express some dependencies between type classes, and I'm running into
>> trouble, I think because I'm producing chains of dependencies which
>> the checker can't resolve...  Here's a minimised version of the state
>> I've got myself into.  :-)
>>
>> > {-# LANGUAGE FlexibleContexts #-}
>> > {-# LANGUAGE TypeFamilies #-}
>>
>> > module Families where
>>
>> First a type family where the type Y is functionally dependent on
>> the type X, and we have a function from Y to ().
>>
>> > class X a where
>> >   type Y a
>> >   enact :: Y a -> ()
>>
>> Now another type family, where the type Q is functionally dependent
>> on the type P, _and_ it must also be an instance of the X
>> class.
>>
>> > class (X (Q s)) => P s where
>> >   type Q s
>>
>> (Perhaps there's a better way to express that dependency?)
>>
>> Now a function which takes a value whose type is an instance of the Y
>> depending on the Q depending on the P.  (Phew!)  The function just
>> tries to call enact on that value.
>>
>> > bar :: P s => Y (Q s) -> ()
>> > bar w = enact w
>>
>> The error we get is:
>>
>> src/Families.lhs:35:16:
>>   Couldn't match expected type `Y a' against inferred type `Y (Q s)'
>>   In the first argument of `enact', namely `w'
>>   In the expression: enact w
>>   In the definition of `bar': bar w = enact w
>>
>> Presumably this way I'm chaining type dependencies is flawed.  Any
>> suggestions on how to improve it, and/or what to read to understand
>> what I'm dealing with better?  (So far I've read "Fun with type
>> functions V2", but that's about it, and I admit I didn't grok it  
>> all.)
>>
>> Thanks!
>>
>> -Andy
>>
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
> _______________________________________________
> 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