    -----------------------------------------------------------------------------
    --
    -- Pretty-printing TyThings
    --
    -- (c) The GHC Team 2005
    --
    -----------------------------------------------------------------------------

    {-# LANGUAGE CPP #-}
    module GHC.Types.TyThing.Ppr (
            pprTyThing,
            pprTyThingInContext,
            pprTyThingLoc,
            pprTyThingInContextLoc,
            pprTyThingHdr,
            pprTypeForUser,
            pprFamInst
      ) where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Driver.Ppr (warnPprTrace)

    import GHC.Types.TyThing ( TyThing(..), tyThingParent_maybe )
    import GHC.Types.Name
    import GHC.Types.Var.Env( emptyTidyEnv )

    import GHC.Core.Type    ( Type, ArgFlag(..), mkTyVarBinders, tidyOpenType )
    import GHC.Core.Coercion.Axiom ( coAxiomTyCon )
    import GHC.Core.FamInstEnv( FamInst(..), FamFlavor(..) )
    import GHC.Core.TyCo.Ppr ( pprUserForAll, pprTypeApp, pprSigmaType )

    import GHC.Iface.Syntax ( ShowSub(..), ShowHowMuch(..), AltPpr(..)
      , showToHeader, pprIfaceDecl )
    import GHC.Iface.Make ( tyThingToIfaceDecl )

    import GHC.Utils.Outputable

    -- -----------------------------------------------------------------------------
    -- Pretty-printing entities that we get from the GHC API

    {- Note [Pretty printing via Iface syntax]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Our general plan for pretty-printing
      - Types
      - TyCons
      - Classes
      - Pattern synonyms
      ...etc...

    is to convert them to Iface syntax, and pretty-print that. For example
      - pprType converts a Type to an IfaceType, and pretty prints that.
      - pprTyThing converts the TyThing to an IfaceDecl,
        and pretty prints that.

    So Iface syntax plays a dual role:
      - it's the internal version of an interface files
      - it's used for pretty-printing

    Why do this?

    * A significant reason is that we need to be able
      to pretty-print Iface syntax (to display Foo.hi), and it was a
      pain to duplicate masses of pretty-printing goop, esp for
      Type and IfaceType.

    * When pretty-printing (a type, say), we want to tidy (with
      tidyType) to avoids having (forall a a. blah) where the two
      a's have different uniques.

      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.

    * Interface files contains fast-strings, not uniques, so the very same
      tidying must take place when we convert to IfaceDecl. E.g.
      GHC.Iface.Make.tyThingToIfaceDecl which converts a TyThing (i.e. TyCon,
      Class etc) to an IfaceDecl.

      Bottom line: IfaceDecls are already 'tidy', so it's straightforward
      to print them.

    * An alternative I once explored was 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.

    Consequences:

    - Iface syntax (and IfaceType) must contain enough information to
      print nicely.  Hence, for example, the IfaceAppArgs type, which
      allows us to suppress invisible kind arguments in types
      (see Note [Suppressing invisible arguments] in GHC.Iface.Type)

    - In a few places we have info that is used only for pretty-printing,
      and is totally ignored when turning Iface syntax back into Core
      (in GHC.IfaceToCore). For example, IfaceClosedSynFamilyTyCon
      stores a [IfaceAxBranch] that is used only for pretty-printing.

    - See Note [Free tyvars in IfaceType] in GHC.Iface.Type

    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 -> 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
    text String
    "type instance"
                SDoc -> SDoc -> SDoc
    <+> [TyCoVarBinder] -> SDoc
    pprUserForAll (ArgFlag -> [TyVar] -> [TyCoVarBinder]
    forall vis. vis -> [TyVar] -> [VarBndr TyVar vis]
    mkTyVarBinders ArgFlag
    Specified [TyVar]
    tvs)
                    -- See Note [Printing foralls in type family instances]
                    -- in GHC.Iface.Type
                SDoc -> SDoc -> SDoc
    <+> TyCon -> [Type] -> SDoc
    pprTypeApp (CoAxiom Unbranched -> TyCon
    forall (br :: BranchFlag). CoAxiom br -> TyCon
    coAxiomTyCon CoAxiom Unbranched
    axiom) [Type]
    lhs_tys)
           Int
    2 (SDoc
    equals SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    rhs)

    ----------------------------
    -- | Pretty-prints a 'TyThing' with its defining location.
    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)

    -- | 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 :: TyThing -> SDoc
    pprTyThingHdr = ShowSub -> TyThing -> SDoc
    pprTyThing ShowSub
    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 :: 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 :: ShowHowMuch
    ss_how_much = [OccName] -> AltPpr -> ShowHowMuch
    ShowSome [OccName]
    ss (Maybe (OccName -> SDoc) -> AltPpr
    AltPpr Maybe (OccName -> SDoc)
    forall a. Maybe a
    Nothing) })
                  TyThing
    thing

    -- | Like 'pprTyThingInContext', but adds the defining location.
    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)

    -- | Pretty-prints a 'TyThing'.
    pprTyThing :: ShowSub -> TyThing -> SDoc
    -- We pretty-print 'TyThing' via 'IfaceDecl'
    -- See Note [Pretty-printing TyThings]
    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 :: ShowHowMuch
    ss_how_much = AltPpr -> ShowHowMuch
    ShowHeader AltPpr
    ppr' }
          ShowSome [OccName]
    xs (AltPpr Maybe (OccName -> SDoc)
    Nothing) -> ShowSub
    ss { ss_how_much :: ShowHowMuch
    ss_how_much = [OccName] -> AltPpr -> ShowHowMuch
    ShowSome [OccName]
    xs AltPpr
    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
             = 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
    pprModulePrefix PprStyle
    sty Module
    mod OccName
    occ SDoc -> SDoc -> SDoc
    <> OccName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OccName
    occ
                 Maybe Module
    Nothing  -> WARN( True, ppr name ) Nothing
                 -- Nothing is unexpected here; TyThings have External names

    pprTypeForUser :: Type -> SDoc
    -- The type is tidied
    pprTypeForUser :: Type -> SDoc
    pprTypeForUser Type
    ty
      = Type -> SDoc
    pprSigmaType Type
    tidy_ty
      where
        (TidyEnv
    _, Type
    tidy_ty)     = TidyEnv -> Type -> (TidyEnv, Type)
    tidyOpenType TidyEnv
    emptyTidyEnv Type
    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 :: SDoc -> SDoc -> SDoc
    showWithLoc SDoc
    loc SDoc
    doc
        = SDoc -> Int -> SDoc -> SDoc
    hang SDoc
    doc Int
    2 (Char -> SDoc
    char Char
    '\t' SDoc -> SDoc -> SDoc
    <> SDoc
    comment SDoc -> SDoc -> SDoc
    <+> SDoc
    loc)
                    -- The tab tries to make them line up a bit
      where
        comment :: SDoc
    comment = String -> SDoc
    text String
    "--"