module GHC.Types.TyThing.Ppr (
pprTyThing,
pprTyThingInContext,
pprTyThingLoc,
pprTyThingInContextLoc,
pprTyThingHdr,
pprFamInst
) where
import GHC.Prelude
import GHC.Types.TyThing ( TyThing(..), tyThingParent_maybe )
import GHC.Types.Name
import GHC.Core.Type ( ForAllTyFlag(..), mkTyVarBinders )
import GHC.Core.Coercion.Axiom ( coAxiomTyCon )
import GHC.Core.FamInstEnv( FamInst(..), FamFlavor(..) )
import GHC.Core.TyCo.Ppr ( pprUserForAll, pprTypeApp )
import GHC.Iface.Syntax ( ShowSub(..), ShowHowMuch(..), AltPpr(..)
, showToHeader, pprIfaceDecl )
import GHC.Iface.Make ( tyThingToIfaceDecl )
import GHC.Utils.Outputable
import Data.Maybe ( isJust )
pprFamInst :: FamInst -> SDoc
pprFamInst :: FamInst -> SDoc
pprFamInst (FamInst { fi_flavor :: FamInst -> FamFlavor
fi_flavor = DataFamilyInst TyCon
rep_tc })
= TyThing -> SDoc
pprTyThingInContextLoc (TyCon -> TyThing
ATyCon TyCon
rep_tc)
pprFamInst (FamInst { fi_flavor :: FamInst -> FamFlavor
fi_flavor = FamFlavor
SynFamilyInst, fi_axiom :: FamInst -> CoAxiom Unbranched
fi_axiom = CoAxiom Unbranched
axiom
, fi_tvs :: FamInst -> [TyVar]
fi_tvs = [TyVar]
tvs, fi_tys :: FamInst -> [Type]
fi_tys = [Type]
lhs_tys, fi_rhs :: FamInst -> Type
fi_rhs = Type
rhs })
= SDoc -> SDoc -> SDoc
showWithLoc (Name -> SDoc
pprDefinedAt (CoAxiom Unbranched -> Name
forall a. NamedThing a => a -> Name
getName CoAxiom Unbranched
axiom)) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type instance"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [ForAllTyBinder] -> SDoc
pprUserForAll (ForAllTyFlag -> [TyVar] -> [ForAllTyBinder]
forall vis. vis -> [TyVar] -> [VarBndr TyVar vis]
mkTyVarBinders ForAllTyFlag
Specified [TyVar]
tvs)
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyCon -> [Type] -> SDoc
pprTypeApp (CoAxiom Unbranched -> TyCon
forall (br :: BranchFlag). CoAxiom br -> TyCon
coAxiomTyCon CoAxiom Unbranched
axiom) [Type]
lhs_tys)
Int
2 (SDoc
forall doc. IsLine doc => doc
equals SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
rhs)
pprTyThingLoc :: TyThing -> SDoc
pprTyThingLoc :: TyThing -> SDoc
pprTyThingLoc TyThing
tyThing
= SDoc -> SDoc -> SDoc
showWithLoc (Name -> SDoc
pprDefinedAt (TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
tyThing))
(ShowSub -> TyThing -> SDoc
pprTyThing ShowSub
showToHeader TyThing
tyThing)
pprTyThingHdr :: TyThing -> SDoc
pprTyThingHdr :: TyThing -> SDoc
pprTyThingHdr = ShowSub -> TyThing -> SDoc
pprTyThing ShowSub
showToHeader
pprTyThingInContext :: ShowSub -> TyThing -> SDoc
pprTyThingInContext :: ShowSub -> TyThing -> SDoc
pprTyThingInContext ShowSub
show_sub TyThing
thing
= [OccName] -> TyThing -> SDoc
go [] TyThing
thing
where
go :: [OccName] -> TyThing -> SDoc
go [OccName]
ss TyThing
thing
= case TyThing -> Maybe TyThing
tyThingParent_maybe TyThing
thing of
Just TyThing
parent ->
[OccName] -> TyThing -> SDoc
go (TyThing -> OccName
forall a. NamedThing a => a -> OccName
getOccName TyThing
thing OccName -> [OccName] -> [OccName]
forall a. a -> [a] -> [a]
: [OccName]
ss) TyThing
parent
Maybe TyThing
Nothing ->
ShowSub -> TyThing -> SDoc
pprTyThing
(ShowSub
show_sub { ss_how_much = ShowSome ss (AltPpr Nothing) })
TyThing
thing
pprTyThingInContextLoc :: TyThing -> SDoc
pprTyThingInContextLoc :: TyThing -> SDoc
pprTyThingInContextLoc TyThing
tyThing
= SDoc -> SDoc -> SDoc
showWithLoc (Name -> SDoc
pprDefinedAt (TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
tyThing))
(ShowSub -> TyThing -> SDoc
pprTyThingInContext ShowSub
showToHeader TyThing
tyThing)
pprTyThing :: ShowSub -> TyThing -> SDoc
pprTyThing :: ShowSub -> TyThing -> SDoc
pprTyThing ShowSub
ss TyThing
ty_thing
= (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocLinearTypes ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
show_linear_types ->
ShowSub -> IfaceDecl -> SDoc
pprIfaceDecl ShowSub
ss' (Bool -> TyThing -> IfaceDecl
tyThingToIfaceDecl Bool
show_linear_types TyThing
ty_thing)
where
ss' :: ShowSub
ss' = case ShowSub -> ShowHowMuch
ss_how_much ShowSub
ss of
ShowHeader (AltPpr Maybe (OccName -> SDoc)
Nothing) -> ShowSub
ss { ss_how_much = ShowHeader ppr' }
ShowSome [OccName]
xs (AltPpr Maybe (OccName -> SDoc)
Nothing) -> ShowSub
ss { ss_how_much = ShowSome xs ppr' }
ShowHowMuch
_ -> ShowSub
ss
ppr' :: AltPpr
ppr' = Maybe (OccName -> SDoc) -> AltPpr
AltPpr (Maybe (OccName -> SDoc) -> AltPpr)
-> Maybe (OccName -> SDoc) -> AltPpr
forall a b. (a -> b) -> a -> b
$ Name -> Maybe (OccName -> SDoc)
ppr_bndr (Name -> Maybe (OccName -> SDoc))
-> Name -> Maybe (OccName -> SDoc)
forall a b. (a -> b) -> a -> b
$ TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
ty_thing
ppr_bndr :: Name -> Maybe (OccName -> SDoc)
ppr_bndr :: Name -> Maybe (OccName -> SDoc)
ppr_bndr Name
name
| Name -> Bool
isBuiltInSyntax Name
name Bool -> Bool -> Bool
|| Maybe FastString -> Bool
forall a. Maybe a -> Bool
isJust (Name -> Maybe FastString
namePun_maybe Name
name)
= Maybe (OccName -> SDoc)
forall a. Maybe a
Nothing
| Bool
otherwise
= case Name -> Maybe Module
nameModule_maybe Name
name of
Just Module
mod -> (OccName -> SDoc) -> Maybe (OccName -> SDoc)
forall a. a -> Maybe a
Just ((OccName -> SDoc) -> Maybe (OccName -> SDoc))
-> (OccName -> SDoc) -> Maybe (OccName -> SDoc)
forall a b. (a -> b) -> a -> b
$ \OccName
occ -> (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
sty ->
PprStyle -> Module -> OccName -> SDoc
forall doc. IsLine doc => PprStyle -> Module -> OccName -> doc
pprModulePrefix PprStyle
sty Module
mod OccName
occ SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ
Maybe Module
Nothing -> Bool
-> String
-> SDoc
-> Maybe (OccName -> SDoc)
-> Maybe (OccName -> SDoc)
forall a. HasCallStack => Bool -> String -> SDoc -> a -> a
warnPprTrace Bool
True String
"pprTyThing" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) Maybe (OccName -> SDoc)
forall a. Maybe a
Nothing
showWithLoc :: SDoc -> SDoc -> SDoc
showWithLoc :: SDoc -> SDoc -> SDoc
showWithLoc SDoc
loc SDoc
doc
= SDoc -> Int -> SDoc -> SDoc
hang SDoc
doc Int
2 (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'\t' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
comment SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
loc)
where
comment :: SDoc
comment = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"--"