{-# LANGUAGE DeriveGeneric #-}
module GHC.Tc.Errors.Types.PromotionErr ( PromotionErr(..)
, pprPECategory
, peCategory
, TermLevelUseErr(..)
, teCategory
) where
import GHC.Prelude
import GHC.Core.Type (ThetaType)
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Generics (Generic)
data PromotionErr
= TyConPE
| ClassPE
| FamDataConPE
| ConstrainedDataConPE ThetaType
| PatSynPE
| RecDataConPE
| TermVariablePE
| TypeVariablePE
deriving ((forall x. PromotionErr -> Rep PromotionErr x)
-> (forall x. Rep PromotionErr x -> PromotionErr)
-> Generic PromotionErr
forall x. Rep PromotionErr x -> PromotionErr
forall x. PromotionErr -> Rep PromotionErr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PromotionErr -> Rep PromotionErr x
from :: forall x. PromotionErr -> Rep PromotionErr x
$cto :: forall x. Rep PromotionErr x -> PromotionErr
to :: forall x. Rep PromotionErr x -> PromotionErr
Generic)
instance Outputable PromotionErr where
ppr :: PromotionErr -> SDoc
ppr PromotionErr
ClassPE = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ClassPE"
ppr PromotionErr
TyConPE = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TyConPE"
ppr PromotionErr
PatSynPE = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PatSynPE"
ppr PromotionErr
FamDataConPE = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"FamDataConPE"
ppr (ConstrainedDataConPE ThetaType
theta) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ConstrainedDataConPE" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (ThetaType -> SDoc
forall a. Outputable a => a -> SDoc
ppr ThetaType
theta)
ppr PromotionErr
RecDataConPE = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RecDataConPE"
ppr PromotionErr
TermVariablePE = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TermVariablePE"
ppr PromotionErr
TypeVariablePE = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TypeVariablePE"
pprPECategory :: PromotionErr -> SDoc
pprPECategory :: PromotionErr -> SDoc
pprPECategory = String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc)
-> (PromotionErr -> String) -> PromotionErr -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
capitalise (String -> String)
-> (PromotionErr -> String) -> PromotionErr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PromotionErr -> String
peCategory
peCategory :: PromotionErr -> String
peCategory :: PromotionErr -> String
peCategory PromotionErr
ClassPE = String
"class"
peCategory PromotionErr
TyConPE = String
"type constructor"
peCategory PromotionErr
PatSynPE = String
"pattern synonym"
peCategory PromotionErr
FamDataConPE = String
"data constructor"
peCategory ConstrainedDataConPE{} = String
"data constructor"
peCategory PromotionErr
RecDataConPE = String
"data constructor"
peCategory PromotionErr
TermVariablePE = String
"term variable"
peCategory PromotionErr
TypeVariablePE = String
"type variable"
data TermLevelUseErr
= TyConTE
| ClassTE
| TyVarTE
deriving ((forall x. TermLevelUseErr -> Rep TermLevelUseErr x)
-> (forall x. Rep TermLevelUseErr x -> TermLevelUseErr)
-> Generic TermLevelUseErr
forall x. Rep TermLevelUseErr x -> TermLevelUseErr
forall x. TermLevelUseErr -> Rep TermLevelUseErr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TermLevelUseErr -> Rep TermLevelUseErr x
from :: forall x. TermLevelUseErr -> Rep TermLevelUseErr x
$cto :: forall x. Rep TermLevelUseErr x -> TermLevelUseErr
to :: forall x. Rep TermLevelUseErr x -> TermLevelUseErr
Generic)
teCategory :: TermLevelUseErr -> String
teCategory :: TermLevelUseErr -> String
teCategory TermLevelUseErr
ClassTE = String
"class"
teCategory TermLevelUseErr
TyConTE = String
"type constructor"
teCategory TermLevelUseErr
TyVarTE = String
"type variable"