content: {-# LANGUAGE LambdaCase #-}
  
  -- | GHC API utilities for inspecting the GHC session
  module GHC.Driver.Session.Inspect where
  
  import GHC.Prelude
  import GHC.Data.Maybe
  import Control.Monad
  
  import GHC.ByteCode.Types
  import GHC.Core.FamInstEnv
  import GHC.Core.InstEnv
  import GHC.Driver.Env
  import GHC.Driver.Main
  import GHC.Driver.Monad
  import GHC.Driver.Session
  import GHC.Rename.Names
  import GHC.Runtime.Context
  import GHC.Runtime.Interpreter
  import GHC.Types.Avail
  import GHC.Types.Name
  import GHC.Types.Name.Ppr
  import GHC.Types.Name.Reader
  import GHC.Types.Name.Set
  import GHC.Types.PkgQual
  import GHC.Types.SafeHaskell
  import GHC.Types.SrcLoc
  import GHC.Types.TyThing
  import GHC.Types.TypeEnv
  import GHC.Unit.External
  import GHC.Unit.Home.ModInfo
  import GHC.Unit.Module
  import GHC.Unit.Module.Graph
  import GHC.Unit.Module.ModDetails
  import GHC.Unit.Module.ModIface
  import GHC.Utils.Misc
  import GHC.Utils.Outputable
  import qualified GHC.Unit.Home.Graph as HUG
  
  -- %************************************************************************
  -- %*                                                                      *
  --             Inspecting the session
  -- %*                                                                      *
  -- %************************************************************************
  
  -- | Get the module dependency graph.
  getModuleGraph :: GhcMonad m => m ModuleGraph -- ToDo: DiGraph ModSummary
  getModuleGraph = liftM hsc_mod_graph getSession
  
  {-# DEPRECATED isLoaded "Prefer 'isLoadedModule' and 'isLoadedHomeModule'" #-}
  -- | Return @True@ \<==> module is loaded.
  isLoaded :: GhcMonad m => ModuleName -> m Bool
  isLoaded m = withSession $ \hsc_env -> liftIO $ do
    hmis <- HUG.lookupAllHug (hsc_HUG hsc_env) m
    return $! not (null hmis)
  
  -- | Check whether a 'ModuleName' is found in the 'HomePackageTable'
  -- for the given 'UnitId'.
  isLoadedModule :: GhcMonad m => UnitId -> ModuleName -> m Bool
  isLoadedModule uid m = withSession $ \hsc_env -> liftIO $ do
    hmi <- HUG.lookupHug (hsc_HUG hsc_env) uid m
    return $! isJust hmi
  
  -- | Check whether 'Module' is part of the 'HomeUnitGraph'.
  --
  -- Similar to 'isLoadedModule', but for 'Module's.
  isLoadedHomeModule :: GhcMonad m => Module -> m Bool
  isLoadedHomeModule m = withSession $ \hsc_env -> liftIO $ do
    hmi <- HUG.lookupHugByModule m (hsc_HUG hsc_env)
    return $! isJust hmi
  
  -- | Return the bindings for the current interactive session.
  getBindings :: GhcMonad m => m [TyThing]
  getBindings = withSession $ \hsc_env ->
      return $ icInScopeTTs $ hsc_IC hsc_env
  
  -- | Return the instances for the current interactive session.
  getInsts :: GhcMonad m => m ([ClsInst], [FamInst])
  getInsts = withSession $ \hsc_env ->
      let (inst_env, fam_env) = ic_instances (hsc_IC hsc_env)
      in return (instEnvElts inst_env, fam_env)
  
  getNamePprCtx :: GhcMonad m => m NamePprCtx
  getNamePprCtx = withSession $ \hsc_env -> do
    return $ icNamePprCtx (hsc_unit_env hsc_env) (hsc_IC hsc_env)
  
  -- | Container for information about a 'Module'.
  data ModuleInfo = ModuleInfo {
          minf_type_env  :: TypeEnv,
          minf_exports   :: [AvailInfo],
          minf_instances :: [ClsInst],
          minf_iface     :: Maybe ModIface,
          minf_safe      :: SafeHaskellMode,
          minf_modBreaks :: Maybe InternalModBreaks
    }
          -- We don't want HomeModInfo here, because a ModuleInfo applies
          -- to package modules too.
  
  -- | Request information about a loaded 'Module'
  getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo)  -- XXX: Maybe X
  getModuleInfo mdl = withSession $ \hsc_env -> do
    if HUG.memberHugUnit (moduleUnit mdl) (hsc_HUG hsc_env)
          then liftIO $ getHomeModuleInfo hsc_env mdl
          else liftIO $ getPackageModuleInfo hsc_env mdl
  
  getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
  getPackageModuleInfo hsc_env mdl
    = do  eps <- hscEPS hsc_env
          iface <- hscGetModuleInterface hsc_env mdl
          let
              avails = mi_exports iface
              pte    = eps_PTE eps
              tys    = [ ty | name <- concatMap availNames avails,
                              Just ty <- [lookupTypeEnv pte name] ]
  
          return (Just (ModuleInfo {
                          minf_type_env  = mkTypeEnv tys,
                          minf_exports   = avails,
                          minf_instances = error "getModuleInfo: instances for package module unimplemented",
                          minf_iface     = Just iface,
                          minf_safe      = getSafeMode $ mi_trust iface,
                          minf_modBreaks = Nothing
                  }))
  
  availsToGlobalRdrEnv :: HasDebugCallStack => HscEnv -> Module -> [AvailInfo] -> IfGlobalRdrEnv
  availsToGlobalRdrEnv hsc_env mod avails
    = forceGlobalRdrEnv rdr_env
      -- See Note [Forcing GREInfo] in GHC.Types.GREInfo.
    where
      rdr_env = mkGlobalRdrEnv (gresFromAvails hsc_env (Just imp_spec) avails)
        -- We're building a GlobalRdrEnv as if the user imported
        -- all the specified modules into the global interactive module
      imp_spec = ImpSpec { is_decl = decl, is_item = ImpAll}
      decl = ImpDeclSpec { is_mod = mod, is_as = moduleName mod,
                           is_qual = False, is_isboot = NotBoot, is_pkg_qual = NoPkgQual,
                           is_dloc = srcLocSpan interactiveSrcLoc,
                           is_level = NormalLevel }
  
  getHomeModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
  getHomeModuleInfo hsc_env mdl =
    HUG.lookupHugByModule mdl (hsc_HUG hsc_env) >>= \case
      Nothing  -> return Nothing
      Just hmi -> do
        let details  = hm_details hmi
            iface    = hm_iface hmi
        return (Just (ModuleInfo {
                          minf_type_env  = md_types details,
                          minf_exports   = md_exports details,
                           -- NB: already forced. See Note [Forcing GREInfo] in GHC.Types.GREInfo.
                          minf_instances = instEnvElts $ md_insts details,
                          minf_iface     = Just iface,
                          minf_safe      = getSafeMode $ mi_trust iface,
                          minf_modBreaks = getModBreaks hmi
                          }))
  
  -- | The list of top-level entities defined in a module
  modInfoTyThings :: ModuleInfo -> [TyThing]
  modInfoTyThings minf = typeEnvElts (minf_type_env minf)
  
  modInfoExports :: ModuleInfo -> [Name]
  modInfoExports minf = concatMap availNames $! minf_exports minf
  
  modInfoExportsWithSelectors :: ModuleInfo -> [Name]
  modInfoExportsWithSelectors minf = concatMap availNames $! minf_exports minf
  
  -- | Returns the instances defined by the specified module.
  -- Warning: currently unimplemented for package modules.
  modInfoInstances :: ModuleInfo -> [ClsInst]
  modInfoInstances = minf_instances
  
  modInfoIsExportedName :: ModuleInfo -> Name -> Bool
  modInfoIsExportedName minf name = elemNameSet name (availsToNameSet (minf_exports minf))
  
  mkNamePprCtxForModule ::
    GhcMonad m =>
    Module     ->
    ModuleInfo ->
    m NamePprCtx
  mkNamePprCtxForModule mod minf = withSession $ \hsc_env -> do
    let name_ppr_ctx = mkNamePprCtx ptc (hsc_unit_env hsc_env) (availsToGlobalRdrEnv hsc_env mod (minf_exports minf))
        ptc = initPromotionTickContext (hsc_dflags hsc_env)
    return name_ppr_ctx
  
  modInfoLookupName :: GhcMonad m =>
                       ModuleInfo -> Name
                    -> m (Maybe TyThing) -- XXX: returns a Maybe X
  modInfoLookupName minf name = withSession $ \hsc_env -> do
     case lookupTypeEnv (minf_type_env minf) name of
       Just tyThing -> return (Just tyThing)
       Nothing      -> liftIO (lookupType hsc_env name)
  
  modInfoIface :: ModuleInfo -> Maybe ModIface
  modInfoIface = minf_iface
  
  -- | Retrieve module safe haskell mode
  modInfoSafe :: ModuleInfo -> SafeHaskellMode
  modInfoSafe = minf_safe
  
  modInfoModBreaks :: ModuleInfo -> Maybe InternalModBreaks
  modInfoModBreaks = minf_modBreaks
  
  