    module GHC.Types.Name.Ppr
       ( mkNamePprCtx
       , mkQualModule
       , mkQualPackage
       , pkgQual
       )
    where

    import GHC.Prelude
    import GHC.Data.FastString

    import GHC.Unit
    import GHC.Unit.Env

    import GHC.Types.Name
    import GHC.Types.Name.Reader

    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Utils.Misc
    import GHC.Builtin.Types.Prim ( fUNTyConName )
    import GHC.Builtin.Types
    import Data.Maybe (isJust)

    {-
    Note [Printing original names]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Deciding how to print names is pretty tricky.  We are given a name
    P:M.T, where P is the package name, M is the defining module, and T is
    the occurrence name, and we have to decide in which form to display
    the name given a GlobalRdrEnv describing the current scope.

    Ideally we want to display the name in the form in which it is in
    scope.  However, the name might not be in scope at all, and that's
    where it gets tricky.  Here are the cases:

     1. T uniquely maps to  P:M.T      --->  "T"      NameUnqual
     2. There is an X for which X.T
           uniquely maps to  P:M.T     --->  "X.T"    NameQual X
     3. There is no binding for "M.T"  --->  "M.T"    NameNotInScope1
     4. Otherwise                      --->  "P:M.T"  NameNotInScope2

    (3) and (4) apply when the entity P:M.T is not in the GlobalRdrEnv at
    all. In these cases we still want to refer to the name as "M.T", *but*
    "M.T" might mean something else in the current scope (e.g. if there's
    an "import X as M"), so to avoid confusion we avoid using "M.T" if
    there's already a binding for it.  Instead we write P:M.T.

    There's one further subtlety: in case (3), what if there are two
    things around, P1:M.T and P2:M.T?  Then we don't want to print both of
    them as M.T!  However only one of the modules P1:M and P2:M can be
    exposed (say P2), so we use M.T for that, and P1:M.T for the other one.
    This is handled by the qual_mod component of NamePprCtx, inside
    the (ppr mod) of case (3), in Name.pprModulePrefix

    Note [Printing unit ids]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In the old days, original names were tied to PackageIds, which directly
    corresponded to the entities that users wrote in Cabal files, and were perfectly
    suitable for printing when we need to disambiguate packages.  However, with
    instantiated units, the situation can be different: if the key is instantiated
    with some holes, we should try to give the user some more useful information.
    -}

    -- | Creates some functions that work out the best ways to format
    -- names for the user according to a set of heuristics.
    mkNamePprCtx :: Outputable info => PromotionTickContext -> UnitEnv -> GlobalRdrEnvX info -> NamePprCtx
    mkNamePprCtx :: forall info.
    Outputable info =>
    PromotionTickContext -> UnitEnv -> GlobalRdrEnvX info -> NamePprCtx
    mkNamePprCtx PromotionTickContext
    ptc UnitEnv
    unit_env GlobalRdrEnvX info
    env
     = QueryQualifyName
    -> QueryQualifyModule
    -> QueryQualifyPackage
    -> QueryPromotionTick
    -> NamePprCtx
    QueryQualify
          (GlobalRdrEnvX info -> QueryQualifyName
    forall info.
    Outputable info =>
    GlobalRdrEnvX info -> QueryQualifyName
    mkQualName GlobalRdrEnvX info
    env)
          (UnitState -> Maybe HomeUnit -> QueryQualifyModule
    mkQualModule UnitState
    unit_state Maybe HomeUnit
    home_unit)
          (UnitState -> QueryQualifyPackage
    mkQualPackage UnitState
    unit_state)
          (PromotionTickContext -> GlobalRdrEnvX info -> QueryPromotionTick
    forall info.
    PromotionTickContext -> GlobalRdrEnvX info -> QueryPromotionTick
    mkPromTick PromotionTickContext
    ptc GlobalRdrEnvX info
    env)
      where
      unit_state :: UnitState
    unit_state = HasDebugCallStack => UnitEnv -> UnitState
    UnitEnv -> UnitState
    ue_units UnitEnv
    unit_env
      home_unit :: Maybe HomeUnit
    home_unit  = UnitEnv -> Maybe HomeUnit
    ue_homeUnit UnitEnv
    unit_env

    mkQualName :: Outputable info => GlobalRdrEnvX info -> QueryQualifyName
    mkQualName :: forall info.
    Outputable info =>
    GlobalRdrEnvX info -> QueryQualifyName
    mkQualName GlobalRdrEnvX info
    env = QueryQualifyName
    qual_name where
      qual_name :: QueryQualifyName
    qual_name Module
    mod OccName
    occ
            | [GlobalRdrEltX info
    gre] <- [GlobalRdrEltX info]
    unqual_gres
            , GlobalRdrEltX info -> Bool
    right_name GlobalRdrEltX info
    gre
            = QualifyName
    NameUnqual   -- If there's a unique entity that's in scope
                           -- unqualified with 'occ' AND that entity is
                           -- the right one, then we can use the unqualified name

            | [] <- [GlobalRdrEltX info]
    unqual_gres
            , Bool
    pretendNameIsInScopeForPpr
            , Bool -> Bool
    not (OccName -> Bool
    isDerivedOccName OccName
    occ)
            = QualifyName
    NameUnqual   -- See Note [pretendNameIsInScopeForPpr]

            | [GlobalRdrEltX info
    gre] <- [GlobalRdrEltX info]
    qual_gres
            = ModuleName -> QualifyName
    NameQual (GlobalRdrEltX info -> ModuleName
    forall info. Outputable info => GlobalRdrEltX info -> ModuleName
    greQualModName GlobalRdrEltX info
    gre)

            | [GlobalRdrEltX info] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [GlobalRdrEltX info]
    qual_gres
            = if [GlobalRdrEltX info] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([GlobalRdrEltX info] -> Bool) -> [GlobalRdrEltX info] -> Bool
    forall a b. (a -> b) -> a -> b
    $ GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
    forall info.
    GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
    lookupGRE GlobalRdrEnvX info
    env (LookupGRE info -> [GlobalRdrEltX info])
    -> LookupGRE info -> [GlobalRdrEltX info]
    forall a b. (a -> b) -> a -> b
    $
                   RdrName -> WhichGREs info -> LookupGRE info
    forall info. RdrName -> WhichGREs info -> LookupGRE info
    LookupRdrName (ModuleName -> OccName -> RdrName
    mkRdrQual (Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName Module
    mod) OccName
    occ) WhichGREs info
    forall info. WhichGREs info
    SameNameSpace
              then QualifyName
    NameNotInScope1
              else QualifyName
    NameNotInScope2

            | Bool
    otherwise
            = QualifyName
    NameNotInScope1   -- Can happen if 'f' is bound twice in the module
                                -- Eg  f = True; g = 0; f = False
          where
            is_name :: Name -> Bool
            is_name :: Name -> Bool
    is_name Name
    name = Bool -> SDoc -> Bool -> Bool
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (Name -> Bool
    isExternalName Name
    name) (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name) (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $
                           HasDebugCallStack => Name -> Module
    Name -> Module
    nameModule Name
    name Module -> QueryQualifyModule
    forall a. Eq a => a -> a -> Bool
    == Module
    mod Bool -> Bool -> Bool
    && Name -> OccName
    nameOccName Name
    name OccName -> OccName -> Bool
    forall a. Eq a => a -> a -> Bool
    == OccName
    occ

            -- See Note [pretendNameIsInScopeForPpr]
            pretendNameIsInScopeForPpr :: Bool
            pretendNameIsInScopeForPpr :: Bool
    pretendNameIsInScopeForPpr =
              (Name -> Bool) -> [Name] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Name -> Bool
    is_name
                [ Name
    liftedTypeKindTyConName
                , Name
    constraintKindTyConName
                , Name
    heqTyConName
                , Name
    coercibleTyConName
                , Name
    eqTyConName
                , Name
    tYPETyConName
                , Name
    fUNTyConName, Name
    unrestrictedFunTyConName
                , Name
    oneDataConName
                , Name
    listTyConName
                , Name
    manyDataConName
                , Name
    soloDataConName ]
              Bool -> Bool -> Bool
    || Maybe Name -> Bool
    forall a. Maybe a -> Bool
    isJust (Module -> OccName -> Maybe Name
    isTupleTyOcc_maybe Module
    mod OccName
    occ)
              Bool -> Bool -> Bool
    || Maybe Name -> Bool
    forall a. Maybe a -> Bool
    isJust (Module -> OccName -> Maybe Name
    isSumTyOcc_maybe Module
    mod OccName
    occ)

            right_name :: GlobalRdrEltX info -> Bool
    right_name GlobalRdrEltX info
    gre = GlobalRdrEltX info -> Maybe Module
    forall info. GlobalRdrEltX info -> Maybe Module
    greDefinitionModule GlobalRdrEltX info
    gre Maybe Module -> Maybe Module -> Bool
    forall a. Eq a => a -> a -> Bool
    == Module -> Maybe Module
    forall a. a -> Maybe a
    Just Module
    mod

            unqual_gres :: [GlobalRdrEltX info]
    unqual_gres = GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
    forall info.
    GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
    lookupGRE GlobalRdrEnvX info
    env (RdrName -> WhichGREs info -> LookupGRE info
    forall info. RdrName -> WhichGREs info -> LookupGRE info
    LookupRdrName (OccName -> RdrName
    mkRdrUnqual OccName
    occ) WhichGREs info
    forall info. WhichGREs info
    SameNameSpace)
            qual_gres :: [GlobalRdrEltX info]
    qual_gres   = (GlobalRdrEltX info -> Bool)
    -> [GlobalRdrEltX info] -> [GlobalRdrEltX info]
    forall a. (a -> Bool) -> [a] -> [a]
    filter GlobalRdrEltX info -> Bool
    right_name (GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
    forall info.
    GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
    lookupGRE GlobalRdrEnvX info
    env (OccName -> WhichGREs info -> LookupGRE info
    forall info. OccName -> WhichGREs info -> LookupGRE info
    LookupOccName OccName
    occ WhichGREs info
    forall info. WhichGREs info
    SameNameSpace))

        -- we can mention a module P:M without the P: qualifier iff
        -- "import M" would resolve unambiguously to P:M.  (if P is the
        -- current package we can just assume it is unqualified).

    mkPromTick :: PromotionTickContext -> GlobalRdrEnvX info -> QueryPromotionTick
    mkPromTick :: forall info.
    PromotionTickContext -> GlobalRdrEnvX info -> QueryPromotionTick
    mkPromTick PromotionTickContext
    ptc GlobalRdrEnvX info
    env
      | PromotionTickContext -> Bool
    ptcPrintRedundantPromTicks PromotionTickContext
    ptc = QueryPromotionTick
    alwaysPrintPromTick
      | Bool
    otherwise                      = QueryPromotionTick
    print_prom_tick
      where
        print_prom_tick :: QueryPromotionTick
    print_prom_tick (PromotedItemListSyntax (IsEmptyOrSingleton Bool
    eos)) =
          -- Ticked: '[], '[x]
          -- Unticked: [x,y], [x,y,z], and so on
          PromotionTickContext -> Bool
    ptcListTuplePuns PromotionTickContext
    ptc Bool -> Bool -> Bool
    && Bool
    eos
        print_prom_tick PromotedItem
    PromotedItemTupleSyntax =
          PromotionTickContext -> Bool
    ptcListTuplePuns PromotionTickContext
    ptc
        print_prom_tick (PromotedItemDataCon OccName
    occ)
          | OccName -> Bool
    isPunnedDataConName OccName
    occ   -- '[], '(,), ''(,,)
          = PromotionTickContext -> Bool
    ptcListTuplePuns PromotionTickContext
    ptc

          | Just OccName
    occ' <- OccName -> Maybe OccName
    promoteOccName OccName
    occ
          , [] <- GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
    forall info.
    GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
    lookupGRE GlobalRdrEnvX info
    env (RdrName -> WhichGREs info -> LookupGRE info
    forall info. RdrName -> WhichGREs info -> LookupGRE info
    LookupRdrName (OccName -> RdrName
    mkRdrUnqual OccName
    occ') WhichGREs info
    forall info. WhichGREs info
    SameNameSpace)
          = -- Could not find a corresponding type name in the environment,
            -- so the data name is unambiguous. Promotion tick not needed.
            Bool
    False
          | Bool
    otherwise = Bool
    True

    isPunnedDataConName :: OccName -> Bool
    isPunnedDataConName :: OccName -> Bool
    isPunnedDataConName OccName
    occ =
      OccName -> Bool
    isDataOcc OccName
    occ Bool -> Bool -> Bool
    && case FastString -> String
    unpackFS (OccName -> FastString
    occNameFS OccName
    occ) of
        Char
    '[':String
    _ -> Bool
    True
        Char
    '(':String
    _ -> Bool
    True
        String
    _     -> Bool
    False

    {- Note [pretendNameIsInScopeForPpr]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    c.f. Note [pretendNameIsInScope] in GHC.Builtin.Names
    Normally, a name is printed unqualified if it's in scope and unambiguous:
      ghci> :t not
      not :: Bool -> Bool

    Out of scope names are qualified:
      ghci> import Prelude hiding (Bool)
      ghci> :t not
      not :: GHC.Types.Bool -> GHC.Types.Bool

    And so are ambiguous names:
      ghci> data Bool
      ghci> :t not
      not :: Prelude.Bool -> Prelude.Bool

    However, these rules alone would lead to excessive qualification:
      ghci> :k Functor
      Functor :: (GHC.Types.Type -> GHC.Types.Type) -> GHC.Types.Constraint

    Even if the user has not imported Data.Kind, we would rather print:
      Functor :: (Type -> Type) -> Constraint

    So we maintain a list of names for which we only require that they are
    unambiguous. It reduces the amount of qualification in GHCi output and error
    messages thus improving readability.

    One potential problem here is that external tooling that relies on parsing GHCi
    output (e.g. Emacs mode for Haskell) requires names to be properly qualified to
    make sense of the output (see #11208). So extend this list with care.

    Side note (int-index):
      This function is distinct from GHC.Bulitin.Names.pretendNameIsInScope (used
      when filtering out instances), and perhaps we could unify them by taking a
      union, but I have not looked into what that would entail.
    -}

    -- | Creates a function for formatting modules based on two heuristics:
    -- (1) if the module is the current module, don't qualify, and (2) if there
    -- is only one exposed package which exports this module, don't qualify.
    mkQualModule :: UnitState -> Maybe HomeUnit -> QueryQualifyModule
    mkQualModule :: UnitState -> Maybe HomeUnit -> QueryQualifyModule
    mkQualModule UnitState
    unit_state Maybe HomeUnit
    mhome_unit Module
    mod
         | Just HomeUnit
    home_unit <- Maybe HomeUnit
    mhome_unit
         , HomeUnit -> QueryQualifyModule
    isHomeModule HomeUnit
    home_unit Module
    mod = Bool
    False

         | [(Module
    _, UnitInfo
    pkgconfig)] <- [(Module, UnitInfo)]
    lookup,
           UnitInfo -> Unit
    mkUnit UnitInfo
    pkgconfig Unit -> QueryQualifyPackage
    forall a. Eq a => a -> a -> Bool
    == Module -> Unit
    forall unit. GenModule unit -> unit
    moduleUnit Module
    mod
            -- this says: we are given a module P:M, is there just one exposed package
            -- that exposes a module M, and is it package P?
         = Bool
    False

         | Bool
    otherwise = Bool
    True
         where lookup :: [(Module, UnitInfo)]
    lookup = UnitState -> ModuleName -> [(Module, UnitInfo)]
    lookupModuleInAllUnits UnitState
    unit_state (Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName Module
    mod)

    -- | Creates a function for formatting packages based on two heuristics:
    -- (1) don't qualify if the package in question is "main", and (2) only qualify
    -- with a unit id if the package ID would be ambiguous.
    mkQualPackage :: UnitState -> QueryQualifyPackage
    mkQualPackage :: UnitState -> QueryQualifyPackage
    mkQualPackage UnitState
    pkgs Unit
    uid
         | Unit
    uid Unit -> QueryQualifyPackage
    forall a. Eq a => a -> a -> Bool
    == Unit
    mainUnit Bool -> Bool -> Bool
    || Unit
    uid Unit -> QueryQualifyPackage
    forall a. Eq a => a -> a -> Bool
    == Unit
    interactiveUnit
            -- Skip the lookup if it's main, since it won't be in the package
            -- database!
         = Bool
    False
         | Just PackageId
    pkgid <- Maybe PackageId
    mb_pkgid
         , UnitState -> PackageId -> [UnitInfo]
    searchPackageId UnitState
    pkgs PackageId
    pkgid [UnitInfo] -> Int -> Bool
    forall a. [a] -> Int -> Bool
    `lengthIs` Int
    1
            -- this says: we are given a package pkg-0.1@MMM, are there only one
            -- exposed packages whose package ID is pkg-0.1?
         = Bool
    False
         | Bool
    otherwise
         = Bool
    True
         where mb_pkgid :: Maybe PackageId
    mb_pkgid = (UnitInfo -> PackageId) -> Maybe UnitInfo -> Maybe PackageId
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap UnitInfo -> PackageId
    forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> srcpkgid
    unitPackageId (UnitState -> Unit -> Maybe UnitInfo
    lookupUnit UnitState
    pkgs Unit
    uid)

    -- | A function which only qualifies package names if necessary; but
    -- qualifies all other identifiers.
    pkgQual :: UnitState -> NamePprCtx
    pkgQual :: UnitState -> NamePprCtx
    pkgQual UnitState
    pkgs = NamePprCtx
    alwaysQualify { queryQualifyPackage = mkQualPackage pkgs }