[Haskell-cafe] Inferred type less polymorphic than expected

Udo Stenzel u.stenzel at web.de
Tue Nov 8 12:56:16 EST 2005


Joel Reymont wrote:
> Folks,
> 
> How do I fix this?
> 
> data Prop = forall a b.(Eq a, Show a) => Attr a := a
> 
> data Attr a = Attr String
>     (a -> Dynamic, Dynamic -> Maybe a)
>     (PU a)
> 
> type Props = M.Map String (Int, Prop)
> 
> instance Ord (Int, Prop) where
>     compare (a, _) (b, _)
>         | a == b = EQ
>         | a > b = GT
>         | otherwise = LT
> 
> makeAttr :: Typeable a => String -> PU a -> Attr a
> makeAttr name pickler = Attr name (toDyn, fromDynamic) pickler
> ...
> props :: Props -> PU Props
> props m = props' $ sort $ M.toList m
>     where props' [] = lift []
>           props' ((_, (Attr _ _ pp := _)):xs) =
>               wrap (\(a, b) -> a : b,
>                     \(a : b) -> (a, b))
>                        (pair pp (props' xs))

This doesn't give you a (PU Props), but a (PU [exists a . a]) or
something, which is bogus syntax, since the idea is already nonsensical.
You have to dismantle and create 'Prop's if you want to put them into a
list, and you forgot a M.fromList somewhere, too.  You probably want
something like this (untested, in order not to spoil the fun for you):

> props :: Props -> PU Props
> props m = wrap M.toAscList M.fromAscList props'
>     where props' [] = lift []
>           props' ((key, (Attr str casts pp := val)):xs) =
>               wrap (\_ -> val : xs,
>                     \(val' : xs) -> ((key, Attr str casts pp := val'), b))
>                        (pair pp (props' xs))

If you create the pickler from one concrete instance of Props, then use it to
(un-)pickle another, you will get bogus results and propably a pattern
match failure.  Basically you have thrown all static type checking out
the window when you create the Attr type, and it will come back to haunt
you.

You probably also want to ask yourself if you need this heavy
machinery or if putting the properties into records is the more sensible
thing to do.
 

Udo.
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 189 bytes
Desc: Digital signature
Url : http://www.haskell.org//pipermail/haskell-cafe/attachments/20051108/a9638e8f/attachment.bin


More information about the Haskell-Cafe mailing list