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.

--L

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@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to