    {-# LANGUAGE CPP #-}

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

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Unit
    import GHC.Unit.Env
    import GHC.Unit.State

    import GHC.Core.TyCon

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

    import GHC.Builtin.Types

    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Utils.Misc

    {-
    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 PrintUnqualified, 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.
    mkPrintUnqualified :: UnitEnv -> GlobalRdrEnv -> PrintUnqualified
    mkPrintUnqualified :: UnitEnv -> GlobalRdrEnv -> PrintUnqualified
    mkPrintUnqualified UnitEnv
    unit_env GlobalRdrEnv
    env
     = QueryQualifyName
    -> QueryQualifyModule -> QueryQualifyPackage -> PrintUnqualified
    QueryQualify QueryQualifyName
    qual_name
          (UnitState -> HomeUnit -> QueryQualifyModule
    mkQualModule UnitState
    unit_state HomeUnit
    home_unit)
          (UnitState -> QueryQualifyPackage
    mkQualPackage UnitState
    unit_state)
      where
      unit_state :: UnitState
    unit_state = UnitEnv -> UnitState
    ue_units UnitEnv
    unit_env
      home_unit :: HomeUnit
    home_unit  = UnitEnv -> HomeUnit
    ue_home_unit UnitEnv
    unit_env
      qual_name :: QueryQualifyName
    qual_name Module
    mod OccName
    occ
            | [GlobalRdrElt
    gre] <- [GlobalRdrElt]
    unqual_gres
            , GlobalRdrElt -> Bool
    right_name GlobalRdrElt
    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

            | [] <- [GlobalRdrElt]
    unqual_gres
            , forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Name -> Bool
    is_name [Name]
    forceUnqualNames
            , Bool -> Bool
    not (OccName -> Bool
    isDerivedOccName OccName
    occ)
            = QualifyName
    NameUnqual   -- Don't qualify names that come from modules
                           -- that come with GHC, often appear in error messages,
                           -- but aren't typically in scope. Doing this does not
                           -- cause ambiguity, and it reduces the amount of
                           -- qualification in error messages thus improving
                           -- readability.
                           --
                           -- A motivating example is 'Constraint'. It's often not
                           -- in scope, but printing GHC.Prim.Constraint seems
                           -- overkill.

            | [GlobalRdrElt
    gre] <- [GlobalRdrElt]
    qual_gres
            = ModuleName -> QualifyName
    NameQual (GlobalRdrElt -> ModuleName
    greQualModName GlobalRdrElt
    gre)

            | forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [GlobalRdrElt]
    qual_gres
            = if forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
    lookupGRE_RdrName (ModuleName -> OccName -> RdrName
    mkRdrQual (forall unit. GenModule unit -> ModuleName
    moduleName Module
    mod) OccName
    occ) GlobalRdrEnv
    env)
              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 = ASSERT2( isExternalName name, ppr name )
                           HasDebugCallStack => Name -> Module
    nameModule Name
    name forall a. Eq a => a -> a -> Bool
    == Module
    mod Bool -> Bool -> Bool
    && Name -> OccName
    nameOccName Name
    name forall a. Eq a => a -> a -> Bool
    == OccName
    occ

            forceUnqualNames :: [Name]
            forceUnqualNames :: [Name]
    forceUnqualNames =
              forall a b. (a -> b) -> [a] -> [b]
    map TyCon -> Name
    tyConName [ TyCon
    constraintKindTyCon, TyCon
    heqTyCon, TyCon
    coercibleTyCon ]
              forall a. [a] -> [a] -> [a]
    ++ [ Name
    eqTyConName ]

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

            unqual_gres :: [GlobalRdrElt]
    unqual_gres = RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
    lookupGRE_RdrName (OccName -> RdrName
    mkRdrUnqual OccName
    occ) GlobalRdrEnv
    env
            qual_gres :: [GlobalRdrElt]
    qual_gres   = forall a. (a -> Bool) -> [a] -> [a]
    filter GlobalRdrElt -> Bool
    right_name (GlobalRdrEnv -> OccName -> [GlobalRdrElt]
    lookupGlobalRdrEnv GlobalRdrEnv
    env OccName
    occ)

        -- 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).

    -- | 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 -> HomeUnit -> QueryQualifyModule
    mkQualModule :: UnitState -> HomeUnit -> QueryQualifyModule
    mkQualModule UnitState
    unit_state HomeUnit
    home_unit Module
    mod
         | HomeUnit -> QueryQualifyModule
    isHomeModule HomeUnit
    home_unit Module
    mod = Bool
    False

         | [(Module
    _, UnitInfo
    pkgconfig)] <- [(Module, UnitInfo)]
    lookup,
           UnitInfo -> Unit
    mkUnit UnitInfo
    pkgconfig forall a. Eq a => a -> a -> Bool
    == 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 (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 forall a. Eq a => a -> a -> Bool
    == Unit
    mainUnit Bool -> Bool -> Bool
    || Unit
    uid 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 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid 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 -> PrintUnqualified
    pkgQual :: UnitState -> PrintUnqualified
    pkgQual UnitState
    pkgs = PrintUnqualified
    alwaysQualify { queryQualifyPackage :: QueryQualifyPackage
    queryQualifyPackage = UnitState -> QueryQualifyPackage
    mkQualPackage UnitState
    pkgs }