Possible type-checker regression in GHC 8.0
The following code fragment works with GHCs prior to GHC 8.0 but not with GHC 8.0:
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE IncoherentInstances #-}
{-# LANGUAGE RankNTypes #-}
module Issue where
import Data.Coerce (coerce)
data Proxy a = Proxy
newtype Catch a = Catch a
class Throws e
type role Throws representational
instance Throws (Catch e)
newtype Wrap e a = Wrap { unWrap :: Throws e => a }
coerceWrap :: Wrap e a -> Wrap (Catch e) a
coerceWrap = coerce
unthrow :: proxy e -> (Throws e => a) -> a
unthrow _ = unWrap . coerceWrap . Wrap
{- this works in GHC 7.10.3, but fails in GHC 8.0 with
GHCi, version 8.0.0.20160105: http://www.haskell.org/ghc/ :? for help
[1 of 1] Compiling Issue ( Issue.hs, interpreted )
Issue.hs:25:13: error:
• Could not deduce (Throws e)
from the context: Throws e0
bound by a type expected by the context:
Throws e0 => a
at Issue.hs:26:13-38
Possible fix:
add (Throws e) to the context of
the type signature for:
unthrow :: proxy e -> (Throws e => a) -> a
• In the expression: unWrap . coerceWrap . Wrap
In an equation for ‘unthrow’: unthrow _ = unWrap . coerceWrap . Wrap
Failed, modules loaded: none.
-}
Trac metadata
Trac field | Value |
---|---|
Version | 7.10.3 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | highest |
Resolution | Unresolved |
Component | Compiler (Type checker) |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | bgamari, goldfire, simonpj |
Operating system | |
Architecture |