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

    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.Decl   ( tyThingToIfaceDecl )
    import GHC.Iface.Syntax ( ShowSub(..), ShowHowMuch(..), AltPpr(..)
                            , showToHeader, pprIfaceDecl )

    import GHC.Utils.Outputable

    import Data.Maybe ( isJust )

    -- -----------------------------------------------------------------------------
    -- 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 and CoVars 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
    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)
                    -- See Note [Printing foralls in type family instances]
                    -- in GHC.Iface.Type
                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)

    ----------------------------
    -- | 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
      = case TyThing -> [TyThing]
    parents TyThing
    thing of
          -- If there are no parents print everything.
          [] -> Maybe (OccName -> Bool) -> TyThing -> SDoc
    print_it Maybe (OccName -> Bool)
    forall a. Maybe a
    Nothing TyThing
    thing
          -- If `thing` has a parent, print the parent and only its child `thing`
          TyThing
    thing':[TyThing]
    rest -> let subs :: [OccName]
    subs = (TyThing -> OccName) -> [TyThing] -> [OccName]
    forall a b. (a -> b) -> [a] -> [b]
    map TyThing -> OccName
    forall a. NamedThing a => a -> OccName
    getOccName (TyThing
    thingTyThing -> [TyThing] -> [TyThing]
    forall a. a -> [a] -> [a]
    :[TyThing]
    rest)
                             filt :: OccName -> Bool
    filt = (OccName -> [OccName] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [OccName]
    subs)
                         in Maybe (OccName -> Bool) -> TyThing -> SDoc
    print_it ((OccName -> Bool) -> Maybe (OccName -> Bool)
    forall a. a -> Maybe a
    Just OccName -> Bool
    filt) TyThing
    thing'
      where
        parents :: TyThing -> [TyThing]
    parents = TyThing -> [TyThing]
    go
          where
            go :: TyThing -> [TyThing]
    go TyThing
    thing =
              case TyThing -> Maybe TyThing
    tyThingParent_maybe TyThing
    thing of
                Just TyThing
    parent -> TyThing
    parent TyThing -> [TyThing] -> [TyThing]
    forall a. a -> [a] -> [a]
    : TyThing -> [TyThing]
    go TyThing
    parent
                Maybe TyThing
    Nothing     -> []

        print_it :: Maybe (OccName -> Bool) -> TyThing -> SDoc
        print_it :: Maybe (OccName -> Bool) -> TyThing -> SDoc
    print_it Maybe (OccName -> Bool)
    mb_filt TyThing
    thing =
          ShowSub -> TyThing -> SDoc
    pprTyThing (ShowSub
    show_sub { ss_how_much = ShowSome mb_filt (AltPpr 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 via Iface syntax]
    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 Maybe (OccName -> Bool)
    filt (AltPpr Maybe (OccName -> SDoc)
    Nothing) -> ShowSub
    ss { ss_how_much = ShowSome filt 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
    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
                 -- Nothing is unexpected here; TyThings have External names

    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)
                    -- The tab tries to make them line up a bit
      where
        comment :: SDoc
    comment = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "--"