[Haskell-cafe] Type families and kind signatures

Luke Palmer lrpalmer at gmail.com
Thu Apr 2 12:05:13 EDT 2009


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/0954b72b/attachment-0001.htm


More information about the Haskell-Cafe mailing list