[Haskell-cafe] Type families and kind signatures
Louis Wasserman
wasserman.louis at gmail.com
Thu Apr 2 11:59:39 EDT 2009
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)
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
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20090402/fff3cc56/attachment.htm
More information about the Haskell-Cafe
mailing list