[Haskell-cafe] Multi-parameter type class woes
Mario Blažević
mblazevic at stilo.com
Sun Dec 14 23:10:00 EST 2008
> I'll take a swing at this one:
>
> instance Container (Maybe x) [x] where
> wrapper = isNothing
> . . .
>
> That isn't a sensible definition of 'wrapper', but I believe without
> trying to compile it is completely legal. Which wrapper do you use?
>
> You /don't/ have a different matching Container instance, but without the
> functional dependency you /might/, and ghc barfs.
But liftWrap doesn't require any particular instance, it's a
generic function accepting any pair of types for which there is
an instance of Container. Instance selection (as I understand it)
shouldn't come into play until one applies liftWrap to a
particular type, and indeed it does cause problems there: note
the type annotations on the last line. That part I understand
and accept, or at least have learned to live with.
> On Sun, 14 Dec 2008, Mario Bla?evi? wrote:
>
>> I have, for a change, a relatively simple problem with
>> type classes. Can somebody explain to me, or point me to an explanation of
>> the behaviour I see?
>>
>> Here is a short and useless example:
>>
>> {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
>>
>> import Data.Maybe
>>
>> class Container x y where
>> wrapper :: x -> Bool
>> unwrap :: x -> y
>> rewrap :: y -> x
>>
>> liftWrap :: Container x y => (y -> y) -> (x -> x)
>> liftWrap f x = (if wrapper x then rewrap . f . unwrap else id) x
>>
>> instance Container (Maybe x) x where
>> wrapper = isJust
>> unwrap = fromJust
>> rewrap = Just
>>
>> main = print (liftWrap (succ :: Int -> Int) (Just 1 :: Maybe Int))
>>
>> GHC 6.10.1 refuses to typecheck the 'wrapper' function
>> in definition of 'liftWrap', with the following error message:
>>
>> Could not deduce (Container x y) from the context (Container x y1)
>> arising from a use of `wrapper' at Test.hs:11:22-30
>> Possible fix:
>> add (Container x y) to the context of
>> the type signature for `liftWrap'
>> In the expression: wrapper x
>> In the expression:
>> (if wrapper x then rewrap . f . unwrap else id) x
>> In the definition of `liftWrap':
>> liftWrap f x = (if wrapper x then rewrap . f . unwrap else id) x
>>
>> Let me clarify that I'm aware that in this particular
>> example a functional dependecy should be used. Also, I can think of a few
>> workarounds for my actual problem, so I'm not asking for any solutions. I'm
>> looking for an explanation. It bugs me that my intuition of how this type
>> class should have worked is completely wrong. The error message does not
>> help, to put it mildly. Where should I go, what should I read?
>> _______________________________________________
>> 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