Constraint synonym instances
Something funny happens when you try to declare an instance of a constraint synonym:
{-# LANGUAGE ConstraintKinds #-}
module F where
type ShowF a = Show (a -> Bool)
instance ShowF Int where
show _ = "Fun"
I get:
F.hs:8:5: error: ‘show’ is not a (visible) method of class ‘ShowF’
|
8 | show _ = "Fun"
| ^^^^
OK, but it gets weirder. Look at:
{-# LANGUAGE ConstraintKinds, FlexibleContexts, FlexibleInstances #-}
module F where
type ShowF a = (Show (a -> Bool))
instance ShowF Int where
This is accepted (with a complaint that show
is not implemented.) It gets even more awful:
{-# LANGUAGE ConstraintKinds, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
module F where
type ShowF a = (Show Bool, Show Int)
instance ShowF Int where
This is awful: GHC treats Show Bool
and Show Int
as if they were constraints, and then emits the following DFun:
df9d1b4635f2a752f29ff327ab66d1cb
$f(%,%)ShowShow :: (Show Bool, Show Int)
DFunId
{- Strictness: m, Inline: CONLIKE,
Unfolding: DFun: @ a @ b.
@ (Show Bool) @ (Show Int) $fShowBool $fShowInt -}
I don't even know what this is supposed to mean.
OK, so what should we do? I think there are a few possibilities:
- Completely outlaw instance declarations on constraint synonyms.
- Allow instance declarations on constraint synonyms, but only if after desugaring the synonym, you end up with a single class head. I would find this useful in a few cases, for example, if you are writing
instance MonadSample (Impl t) MyMonad
, if you hadtype MonadSample2 t a = MonadSample (Impl t) a
you might prefer writinginstance MonadSample2 t MyMonad
instead - Figure out what to do with instance declarations with multiple class heads, and proceed accordingly.