Shortcomings in dependency analysis of deriving clauses
{-# LANGUAGE DerivingStrategies, GeneralisedNewtypeDeriving #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
module T23496 where
import Data.Kind
class C a where
type T a :: Type
instance C Int where
type T Int = Bool
newtype N = MkN Int
deriving newtype C
--deriving instance C N
--instance C N where
-- type T N = T Int
type F :: forall a. T a -> Type
type family F a where
F @Int True = Float
F @N False = Double
With either of the derived instances (standalone or non-standalone), we get a type error:
error: [GHC-83865]
• Expected kind ‘T N’, but ‘False’ has kind ‘Bool’
• In the second argument of ‘F’, namely ‘False’
In the type family declaration for ‘F’
|
28 | F @N False = Double
| ^^^^^
Changing it to an user-written instance (comment out the deriving clause and uncomment the instance), the program compiles fine.
I think the problem is that we separate out derived instances from user-written instances in tcTyClsInstDecls
; they should instead be handled together as they might depend on eachother.
Edited by sheaf