Better error message when instance signature is incorrect
I was recently trying to solve an ambiguity error in a type class instance I was writing, and ended up with some code that looked like this (the ambiguity error has been eliminated for simplicity):
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE ScopedTypeVariables #-}
module A where
data F a = F a
instance Show a => Show (F a) where
show :: forall a. Show a => F a -> String
show (F x) = show x
This instance signature is incorrect: it's not necessary to add a universal quantifier to scope over type variables defined in the instance head; they are automatically in scope. But GHC unhelpfully reports:
ezyang@sabre:~$ Dev/ghc-7.10.2/usr/bin/ghci A.hs
GHCi, version 7.10.2: http://www.haskell.org/ghc/ :? for help
[1 of 1] Compiling A ( A.hs, interpreted )
A.hs:8:13:
Could not deduce (Show a0)
from the context (Show a)
bound by the type signature for show :: Show a => F a -> String
at A.hs:8:13-45
The type variable ‘a0’ is ambiguous
When checking that:
forall a. Show a => forall a1. Show a1 => F a1 -> String
is more polymorphic than: forall a. Show a => F a -> String
When checking that instance signature for ‘show’
is more general than its signature in the class
Instance sig: forall a.
Show a =>
forall a1. Show a1 => F a1 -> String
Class sig: forall a. Show a => F a -> String
In the instance declaration for ‘Show (F a)’
Failed, modules loaded: none.
Why did I get the wrong idea about how instance signatures work? Well, GHC doesn't warn if you write this:
instance Show a => Show (F a) where
show :: Show a => F a -> String
show (F x) = show x
Because this turns into a full type signature 'Show a, Show a => F a -> String' (the first a and the second a end up getting unified.) I'm not sure if it should warn; it's an easy mistake to make if you are treating instance methods like plain function definitions (of course you have to write the full type signature...)
Trac metadata
Trac field | Value |
---|---|
Version | 7.10.2 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | Compiler (Type checker) |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |