[Haskell-cafe] Class constraints with "free" type variables and fundeps

MigMit miguelimo38 at yandex.ru
Sat Sep 29 20:08:03 CEST 2012


On Sep 29, 2012, at 9:49 PM, Gábor Lehel <illissius at gmail.com> wrote:

> On Fri, Sep 28, 2012 at 6:36 PM, Francesco Mazzoli <f at mazzo.li> wrote:
>> I would expect this to work, maybe with some additional notation (a la
>> ScopedTypeVariables)
>> 
>>    {-# LANGUAGE FunctionalDependencies #-}
>>    {-# LANGUAGE MultiParamTypeClasses #-}
>> 
>>    class Foo a b | a -> b
>> 
>>    class Foo a b => Bar a where
>>        foo :: a -> b -> c
>> 
>> The type family equivalent works as expected:
>> 
>>    {-# LANGUAGE TypeFamilies #-}
>> 
>>    class Foo a where
>>        type T a :: *
>> 
>>    class Bar a where
>>        foo :: a -> T a -> c
>> 
>> I can't use type families because the `Foo' I'm using is in an external library.
>> Is there any way to achieve what I want without adding `b' to `Bar'?
> 
> I was browsing the GHC bug tracker and accidentally might have found a
> solution to your problem:
> 
> http://hackage.haskell.org/trac/ghc/ticket/7100
> 
> Basically you have to make a type family to recapitulate the
> functional dependencies in the instances of Foo:
> 
> type family FooFD a

Actually, I think it's better to use a class here:

class Foo a (FooFD a) => FooProxy a where type FooFD a

> 
> -- for each instance Foo A B, you have to write:
> -- type instance FooFD A = B
> 
> class Foo a (FooFD a) => Bar a where
>    foo :: a -> FooFD a -> c
> 
> Anywhere you would use 'b', you use the type family instead.
> 
> The example in the ticket also had a 'b ~ FooFD a' superclass
> constraint on Foo itself, which you can't add if you don't control
> Foo, but I'm not sure what it's necessary for - in my brief tests
> removing it didn't cause problems.
> 
> A weakness of this approach is that you have to manually add a type
> instance for every instance of Foo, which may or may not be a problem
> in your situation.
> 
> 
>> 
>> --
>> Francesco * Often in error, never in doubt
>> 
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
> 
> 
> 
> -- 
> Your ship was destroyed in a monadic eruption.
> 
> _______________________________________________
> 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