#2885: Late and confusing error on uncallable class method
---------------------+------------------------------------------------------
Reporter:  blamario  |          Owner:                
    Type:  bug       |         Status:  new           
Priority:  normal    |      Component:  Compiler      
 Version:  6.10.1    |       Severity:  minor         
Keywords:            |       Testcase:                
      Os:  Linux     |   Architecture:  x86_64 (amd64)
---------------------+------------------------------------------------------
 This has been discussed on Haskell Café (http://www.haskell.org/pipermail
 /haskell-cafe/2008-December/051856.html), I'm reporting it here in case
 something can be done to help other confused souls in future.

 In short, the error message reported by GHC (6.10.1):

 {{{
     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
 }}}

 does not begin to indicate that the actual problem with the following
 program is in the type class declaration:

 {{{
    {-# 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))
 }}}

 If the 'wrapper' method can never be called in any possible context, there
 should be an error report at the point where the method is declared. I
 don't think that's a controversial statement. Even if the compiler allows
 the declaration under the assumption that the useless method is never
 called, it should at least emit a strong warning.

-- 
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/2885>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
_______________________________________________
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs

Reply via email to