[Haskell-cafe] Type families and kind signatures

Louis Wasserman wasserman.louis at gmail.com
Thu Apr 2 12:12:36 EDT 2009


Mkay.  One more quick thing -- the wiki demonstrates a place where the
original attempt worked, with a data family instead. (That is, replacing
'type' with 'data' and adjusting the instance makes this program compile
immediately.)
a) Is there a type-hackery reason this is different from data families?
b) Is there a reason this isn't made a lot clearer in the documentation?
 GHC's docs say that higher-order type families can be declared with kind
signatures, but never gives any examples -- which would make it a lot
clearer that the below program doesn't work.

Louis Wasserman
wasserman.louis at gmail.com


On Thu, Apr 2, 2009 at 12:05 PM, Luke Palmer <lrpalmer at gmail.com> wrote:

> 2009/4/2 Louis Wasserman <wasserman.louis at gmail.com>
>
>> The following module does not compile, and I can't figure out why:
>> {-# LANGUAGE TypeFamilies #-}
>> {-# LANGUAGE KindSignatures #-}
>>
>> module Foo where
>>
>> import Control.Monad
>> import Data.Maybe
>>
>> class Key k where
>> type Map k :: * -> *
>> empty :: Map k v
>>  look :: k -> Map k v  -> Maybe v
>> update :: k -> (Maybe v -> Maybe v) -> Map k v -> Map k v
>>
>> instance (Key k1, Key k2) => Key (k1, k2) where
>> type Map (k1, k2) v = Map k1 (Map k2 v)
>>
>
> The arity of the instance has to be *exactly* the same as is declared.  So
> the v is one too many parameters.  That does make your life a little more
> difficult (but points to an abstraction you may not have seen :-).
>
> I would resolve this as:
>
>     type Map (k1,k2) = Map k1 `O` Map k2
>
> Where O is functor composition from TypeCompose on hackage.
>
>
>
>>  empty = empty
>>  update (k1, k2) f = update k1 (update k2 f . fromMaybe empty)
>> look (k1, k2) = look k1 >=> look k2
>>
>> The compile fails with
>> Foo.hs:16:1:
>>     Number of parameters must match family declaration; expected 1
>>     In the type synonym instance declaration for `Map'
>>     In the instance declaration for `Key (k1, k2)'
>>
>> Is this a bug with type synonym families? Is there something silly I'm
>> missing?
>>
>> Louis Wasserman
>> wasserman.louis at gmail.com
>>
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>
>>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20090402/7990fc4a/attachment.htm


More information about the Haskell-Cafe mailing list