GeneralizedNewtypeDeriving produces error messages with incorrect kind signatures
Given the following program:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
import Control.Monad.Reader
newtype AppM a = AppM (ReaderT Int IO a)
deriving (Functor, Applicative, Monad, MonadReader)
The MonadReader
deriving declaration should be MonadReader Int
. GHC produces the following error message:
• Expecting one more argument to ‘MonadReader’
Expected kind ‘* -> Constraint’,
but ‘MonadReader’ has kind ‘* -> (* -> *) -> Constraint’
• In the newtype declaration for ‘AppM’
This error message is confusing to me. The kind of MonadReader
is * -> (* -> *) -> Constraint
, as the error message states, which makes sense. However, the error message states that it expects kind * -> Constraint
, despite the fact that MonadReader Int
is actually of kind (* -> *) -> Constraint
.
,,(This description is adapted from this Stack Overflow question.),,