----------------------------------------------------------------------------- -- -- Pretty-printing TyThings -- -- (c) The GHC Team 2005 -- ----------------------------------------------------------------------------- {-# LANGUAGE CPP #-} module PprTyThing ( pprTyThing, pprTyThingInContext, pprTyThingLoc, pprTyThingInContextLoc, pprTyThingHdr, pprTypeForUser, pprFamInst ) where #include "HsVersions.h" import GhcPrelude import Type ( TyThing(..) ) import IfaceSyn ( ShowSub(..), ShowHowMuch(..), AltPpr(..) , showToHeader, pprIfaceDecl ) import CoAxiom ( coAxiomTyCon ) import HscTypes( tyThingParent_maybe ) import MkIface ( tyThingToIfaceDecl ) import Type ( tidyOpenType ) import FamInstEnv( FamInst(..), FamFlavor(..) ) import Type( Type, pprTypeApp, pprSigmaType ) import Name import VarEnv( emptyTidyEnv ) import Outputable -- ----------------------------------------------------------------------------- -- Pretty-printing entities that we get from the GHC API {- Note [Pretty-printing TyThings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We pretty-print a TyThing by converting it to an IfaceDecl, and pretty-printing that (see ppr_ty_thing below). Here is why: * When pretty-printing (a type, say), the idiomatic solution is not to "rename type variables on the fly", but rather to "tidy" the type (which gives each variable a distinct print-name), and then pretty-print it (without renaming). Separate the two concerns. Functions like tidyType do this. * Alas, for type constructors, TyCon, tidying does not work well, because a TyCon includes DataCons which include Types, which mention TyCons. And tidying can't tidy a mutually recursive data structure graph, only trees. * One alternative would be to ensure that TyCons get type variables with distinct print-names. That's ok for type variables but less easy for kind variables. Processing data type declarations is already so complicated that I don't think it's sensible to add the extra requirement that it generates only "pretty" types and kinds. * One place the non-pretty names can show up is in GHCi. But another is in interface files. Look at MkIface.tyThingToIfaceDecl which converts a TyThing (i.e. TyCon, Class etc) to an IfaceDecl. And it already does tidying as part of that conversion! Why? Because interface files contains fast-strings, not uniques, so the names must at least be distinct. So if we convert to IfaceDecl, we get a nice tidy IfaceDecl, and can print that. Of course, that means that pretty-printing IfaceDecls must be careful to display nice user-friendly results, but that's ok. See #7730, #8776 for details -} -------------------- -- | Pretty-prints a 'FamInst' (type/data family instance) with its defining location. pprFamInst :: FamInst -> SDoc -- * For data instances we go via pprTyThing of the representational TyCon, -- because there is already much cleverness associated with printing -- data type declarations that I don't want to duplicate -- * For type instances we print directly here; there is no TyCon -- to give to pprTyThing -- -- FamInstEnv.pprFamInst does a more quick-and-dirty job for internal purposes pprFamInst (FamInst { fi_flavor = DataFamilyInst rep_tc }) = pprTyThingInContextLoc (ATyCon rep_tc) pprFamInst (FamInst { fi_flavor = SynFamilyInst, fi_axiom = axiom , fi_tys = lhs_tys, fi_rhs = rhs }) = showWithLoc (pprDefinedAt (getName axiom)) $ hang (text "type instance" <+> pprTypeApp (coAxiomTyCon axiom) lhs_tys) 2 (equals <+> ppr rhs) ---------------------------- -- | Pretty-prints a 'TyThing' with its defining location. pprTyThingLoc :: TyThing -> SDoc pprTyThingLoc tyThing = showWithLoc (pprDefinedAt (getName tyThing)) (pprTyThing showToHeader tyThing) -- | Pretty-prints the 'TyThing' header. For functions and data constructors -- the function is equivalent to 'pprTyThing' but for type constructors -- and classes it prints only the header part of the declaration. pprTyThingHdr :: TyThing -> SDoc pprTyThingHdr = pprTyThing showToHeader -- | Pretty-prints a 'TyThing' in context: that is, if the entity -- is a data constructor, record selector, or class method, then -- the entity's parent declaration is pretty-printed with irrelevant -- parts omitted. pprTyThingInContext :: ShowSub -> TyThing -> SDoc pprTyThingInContext show_sub thing = go [] thing where go ss thing = case tyThingParent_maybe thing of Just parent -> go (getOccName thing : ss) parent Nothing -> pprTyThing (show_sub { ss_how_much = ShowSome ss (AltPpr Nothing) }) thing -- | Like 'pprTyThingInContext', but adds the defining location. pprTyThingInContextLoc :: TyThing -> SDoc pprTyThingInContextLoc tyThing = showWithLoc (pprDefinedAt (getName tyThing)) (pprTyThingInContext showToHeader tyThing) -- | Pretty-prints a 'TyThing'. pprTyThing :: ShowSub -> TyThing -> SDoc -- We pretty-print 'TyThing' via 'IfaceDecl' -- See Note [Pretty-printing TyThings] pprTyThing ss ty_thing = pprIfaceDecl ss' (tyThingToIfaceDecl ty_thing) where ss' = case ss_how_much ss of ShowHeader (AltPpr Nothing) -> ss { ss_how_much = ShowHeader ppr' } ShowSome xs (AltPpr Nothing) -> ss { ss_how_much = ShowSome xs ppr' } _ -> ss ppr' = AltPpr $ ppr_bndr $ getName ty_thing ppr_bndr :: Name -> Maybe (OccName -> SDoc) ppr_bndr name | isBuiltInSyntax name = Nothing | otherwise = case nameModule_maybe name of Just mod -> Just $ \occ -> getPprStyle $ \sty -> pprModulePrefix sty mod occ <> ppr occ Nothing -> WARN( True, ppr name ) Nothing -- Nothing is unexpected here; TyThings have External names pprTypeForUser :: Type -> SDoc -- The type is tidied pprTypeForUser ty = pprSigmaType tidy_ty where (_, tidy_ty) = tidyOpenType emptyTidyEnv ty -- Often the types/kinds we print in ghci are fully generalised -- and have no free variables, but it turns out that we sometimes -- print un-generalised kinds (eg when doing :k T), so it's -- better to use tidyOpenType here showWithLoc :: SDoc -> SDoc -> SDoc showWithLoc loc doc = hang doc 2 (char '\t' <> comment <+> loc) -- The tab tries to make them line up a bit where comment = text "--"