{-# LANGUAGE LambdaCase #-}
-- | The 'HomePackageTable' (HPT) contains information about all modules that are part
-- of a home package. At its core, the information for each module is a
-- 'HomeModInfo'.
--
-- During upsweep, the HPT is a monotonically increasing data structure: it
-- only ever gets extended by inserting modules which are loaded and for which
-- we discover the information required to construct a 'ModInfo'.
--
-- There should only ever exist one single HPT for any given home unit. It's
-- crucial we don't accidentally leak HPTs (e.g. by filtering it, which used to
-- happen -- #25511), so the HPT is mutable and only its reference should be shared.
-- This is alright because the modules don't change throughout compilation.
--
-- :::WARNING:::
-- If you intend to change this interface, consider carefully whether you are
-- exposing memory-leak footguns which may end up being misused in the compiler
-- eventually. For instance, if you really, really, end up needing a way to take
-- a snapshot of the IORef (think: do you really need to?), at least make
-- obvious in the name like `snapshotCopyHpt`.
--
-- Or, do you really need a function to traverse all modules in the HPT? It is
-- often better to keep the computation internal to this module, such as in
-- 'hptCollectObjects'...
module GHC.Unit.Home.PackageTable
  (
    HomePackageTable(..)
  , emptyHomePackageTable

    -- * Lookups in the HPT
  , lookupHpt
  , lookupHptByModule

    -- * Extending the HPT
  , addHomeModInfoToHpt
  , addHomeModInfosToHpt

    -- * Restrict the HPT
  , restrictHpt

    -- * Queries about home modules
  , hptCompleteSigs
  , hptAllInstances
  , hptAllFamInstances
  , hptAllAnnotations

    -- ** More Traversal-based queries
  , hptCollectDependencies
  , hptCollectObjects
  , hptCollectModules

    -- ** Memory dangerous queries
  , concatHpt

    -- * Utilities
  , pprHPT

    -- * Internals
    --
    -- | These provide access to the internals of the HomePackageTable to
    -- facilitate existing workflows that used the previous API. For instance,
    -- if you were listing out all elements or merging, you can keep doing so by reading
    -- the internal IO ref and then using the moduleenv contents directly.
    --
    -- In GHC itself these should be avoided, and other uses should justify why
    -- it is not sufficient to go through the intended insert-only API.
  , hptInternalTableRef
  , hptInternalTableFromRef

    -- * Legacy API
    --
    -- | This API is deprecated and meant to be removed.
  , addToHpt
  , addListToHpt
  ) where

import GHC.Prelude
import GHC.Data.Maybe

import Data.IORef
import Control.Monad ((<$!>))
import qualified Data.Set as Set

import GHC.Core.FamInstEnv
import GHC.Core.InstEnv
import GHC.Linker.Types
import GHC.Types.Annotations
import GHC.Types.CompleteMatch
import GHC.Types.Unique.DFM
import GHC.Unit.Home.ModInfo
import GHC.Unit.Module
import GHC.Unit.Module.Deps
import GHC.Unit.Module.ModDetails
import GHC.Unit.Module.ModIface
import GHC.Utils.Outputable
import GHC.Types.Unique (getUnique, getKey)
import qualified GHC.Data.Word64Set as W64

-- | Helps us find information about modules in the home package
newtype HomePackageTable = HPT {

    HomePackageTable -> IORef (DModuleNameEnv HomeModInfo)
table :: IORef (DModuleNameEnv HomeModInfo)
    -- ^ Domain = modules in this home unit
    --
    -- This is an IORef because we want to avoid leaking HPTs (see the particularly bad #25511).
    -- Moreover, the HPT invariant allows mutability in this table without compromising thread safety or soundness.
    -- To recall:
    --   A query to the HPT should depend only on data relevant to that query, such that
    --   there being more or less unrelated entries in the HPT does not influence the result in any way.
    --
    -- Note that the HPT increases monotonically, except at certain barrier
    -- points like when 'restrictHpt' is called. At these barriers, it is safe
    -- to temporarily violate the HPT monotonicity.
    --
    -- The elements of this table may be updated (e.g. on rehydration).
  }

-- | Create a new 'HomePackageTable'.
--
-- Be careful not to share it across e.g. different units, since it uses a
-- mutable variable under the hood to keep the monotonically increasing list of
-- loaded modules.
emptyHomePackageTable :: IO HomePackageTable
-- romes:todo: use a MutableArray directly?
emptyHomePackageTable :: IO HomePackageTable
emptyHomePackageTable = do
  table <- DModuleNameEnv HomeModInfo
-> IO (IORef (DModuleNameEnv HomeModInfo))
forall a. a -> IO (IORef a)
newIORef DModuleNameEnv HomeModInfo
forall {k} (key :: k) elt. UniqDFM key elt
emptyUDFM
  return HPT{table}

--------------------------------------------------------------------------------
-- * Lookups in the HPT
--------------------------------------------------------------------------------

-- | Lookup the 'HomeModInfo' of a module in the HPT, given its name.
lookupHpt :: HomePackageTable -> ModuleName -> IO (Maybe HomeModInfo)
lookupHpt :: HomePackageTable -> ModuleName -> IO (Maybe HomeModInfo)
lookupHpt HPT{table :: HomePackageTable -> IORef (DModuleNameEnv HomeModInfo)
table=IORef (DModuleNameEnv HomeModInfo)
hpt} ModuleName
mn = (DModuleNameEnv HomeModInfo -> ModuleName -> Maybe HomeModInfo
forall key elt.
Uniquable key =>
UniqDFM key elt -> key -> Maybe elt
`lookupUDFM` ModuleName
mn) (DModuleNameEnv HomeModInfo -> Maybe HomeModInfo)
-> IO (DModuleNameEnv HomeModInfo) -> IO (Maybe HomeModInfo)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> IORef (DModuleNameEnv HomeModInfo)
-> IO (DModuleNameEnv HomeModInfo)
forall a. IORef a -> IO a
readIORef IORef (DModuleNameEnv HomeModInfo)
hpt

-- | Lookup the 'HomeModInfo' of a 'Module' in the HPT.
lookupHptByModule :: HomePackageTable -> Module -> IO (Maybe HomeModInfo)
lookupHptByModule :: HomePackageTable -> Module -> IO (Maybe HomeModInfo)
lookupHptByModule HomePackageTable
hpt Module
mod
  = -- The HPT is indexed by ModuleName, not Module,
    -- we must check for a hit on the right Module
    HomePackageTable -> ModuleName -> IO (Maybe HomeModInfo)
lookupHpt HomePackageTable
hpt (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod) IO (Maybe HomeModInfo)
-> (Maybe HomeModInfo -> IO (Maybe HomeModInfo))
-> IO (Maybe HomeModInfo)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe HomeModInfo -> IO (Maybe HomeModInfo)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe HomeModInfo -> IO (Maybe HomeModInfo))
-> (Maybe HomeModInfo -> Maybe HomeModInfo)
-> Maybe HomeModInfo
-> IO (Maybe HomeModInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      Just HomeModInfo
hm | ModIface_ 'ModIfaceFinal -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module (HomeModInfo -> ModIface_ 'ModIfaceFinal
hm_iface HomeModInfo
hm) Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
mod -> HomeModInfo -> Maybe HomeModInfo
forall a. a -> Maybe a
Just HomeModInfo
hm
      Maybe HomeModInfo
_otherwise                               -> Maybe HomeModInfo
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
-- * Extending the HPT
--------------------------------------------------------------------------------

-- | Add a new module to the HPT.
--
-- An HPT is a monotonically increasing data structure, holding information about loaded modules in a package.
-- This is the main function by which the HPT is extended or updated.
--
-- When the module of the inserted 'HomeModInfo' does not exist, a new entry in
-- the HPT is created for that module name.
-- When the module already has an entry, inserting a new one entry in the HPT
-- will always overwrite the existing entry for that module.
addHomeModInfoToHpt :: HomeModInfo -> HomePackageTable -> IO ()
addHomeModInfoToHpt :: HomeModInfo -> HomePackageTable -> IO ()
addHomeModInfoToHpt HomeModInfo
hmi HomePackageTable
hpt = HomePackageTable -> ModuleName -> HomeModInfo -> IO ()
addToHpt HomePackageTable
hpt (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (ModIface_ 'ModIfaceFinal -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module (HomeModInfo -> ModIface_ 'ModIfaceFinal
hm_iface HomeModInfo
hmi))) HomeModInfo
hmi

{-# DEPRECATED addToHpt "Deprecated in favour of 'addHomeModInfoToHpt', as the module at which a 'HomeModInfo' is inserted should always be derived from the 'HomeModInfo' itself." #-}
-- After deprecation cycle, move `addToHpt` to a `where` clause inside `addHomeModInfoToHpt`.
addToHpt :: HomePackageTable -> ModuleName -> HomeModInfo -> IO ()
addToHpt :: HomePackageTable -> ModuleName -> HomeModInfo -> IO ()
addToHpt HPT{table :: HomePackageTable -> IORef (DModuleNameEnv HomeModInfo)
table=IORef (DModuleNameEnv HomeModInfo)
hptr} ModuleName
mn HomeModInfo
hmi = do
  IORef (DModuleNameEnv HomeModInfo)
-> (DModuleNameEnv HomeModInfo -> (DModuleNameEnv HomeModInfo, ()))
-> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (DModuleNameEnv HomeModInfo)
hptr (\DModuleNameEnv HomeModInfo
hpt -> (DModuleNameEnv HomeModInfo
-> ModuleName -> HomeModInfo -> DModuleNameEnv HomeModInfo
forall key elt.
Uniquable key =>
UniqDFM key elt -> key -> elt -> UniqDFM key elt
addToUDFM DModuleNameEnv HomeModInfo
hpt ModuleName
mn HomeModInfo
hmi, ()))
  -- If the key already existed in the map, this insertion is overwriting
  -- the HMI of a previously loaded module (likely in rehydration).

-- | 'addHomeModInfoToHpt' for multiple module infos.
addHomeModInfosToHpt :: HomePackageTable -> [HomeModInfo] -> IO ()
addHomeModInfosToHpt :: HomePackageTable -> [HomeModInfo] -> IO ()
addHomeModInfosToHpt HomePackageTable
hpt = (HomeModInfo -> IO ()) -> [HomeModInfo] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((HomeModInfo -> HomePackageTable -> IO ())
-> HomePackageTable -> HomeModInfo -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip HomeModInfo -> HomePackageTable -> IO ()
addHomeModInfoToHpt HomePackageTable
hpt)

-- | Thin each HPT variable to only contain keys from the given dependencies.
-- This is used at the end of upsweep to make sure that only completely successfully loaded
-- modules are visible for subsequent operations.
--
-- This is an exception to the invariant of the HPT -- that it grows
-- monotonically, never removing entries -- which is safe as long as it is only
-- called at barrier points, such as the end of upsweep, when all threads are
-- done and we want to clean up failed entries.
restrictHpt :: HomePackageTable -> [HomeModInfo] -> IO ()
restrictHpt :: HomePackageTable -> [HomeModInfo] -> IO ()
restrictHpt HPT{table :: HomePackageTable -> IORef (DModuleNameEnv HomeModInfo)
table=IORef (DModuleNameEnv HomeModInfo)
hptr} [HomeModInfo]
hmis =
  let key_set :: [Word64]
key_set = (HomeModInfo -> Word64) -> [HomeModInfo] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (Unique -> Word64
getKey (Unique -> Word64)
-> (HomeModInfo -> Unique) -> HomeModInfo -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Unique
forall a. Uniquable a => a -> Unique
getUnique (ModuleName -> Unique)
-> (HomeModInfo -> ModuleName) -> HomeModInfo -> Unique
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> ModuleName
hmi_mod) [HomeModInfo]
hmis
      hmi_mod :: HomeModInfo -> ModuleName
hmi_mod HomeModInfo
hmi = Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (ModIface_ 'ModIfaceFinal -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module (HomeModInfo -> ModIface_ 'ModIfaceFinal
hm_iface HomeModInfo
hmi))
  in IORef (DModuleNameEnv HomeModInfo)
-> (DModuleNameEnv HomeModInfo -> (DModuleNameEnv HomeModInfo, ()))
-> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (DModuleNameEnv HomeModInfo)
hptr (\DModuleNameEnv HomeModInfo
hpt -> (DModuleNameEnv HomeModInfo
-> Word64Set -> DModuleNameEnv HomeModInfo
forall {k} (key :: k) elt.
UniqDFM key elt -> Word64Set -> UniqDFM key elt
udfmRestrictKeysSet DModuleNameEnv HomeModInfo
hpt ([Word64] -> Word64Set
W64.fromList [Word64]
key_set), ()))

{-# DEPRECATED addListToHpt "Deprecated in favour of 'addHomeModInfosToHpt', as the module at which a 'HomeModInfo' is inserted should always be derived from the 'HomeModInfo' itself." #-}
-- After deprecation cycle, remove.
addListToHpt :: HomePackageTable -> [(ModuleName, HomeModInfo)] -> IO ()
addListToHpt :: HomePackageTable -> [(ModuleName, HomeModInfo)] -> IO ()
addListToHpt HomePackageTable
hpt = ((ModuleName, HomeModInfo) -> IO ())
-> [(ModuleName, HomeModInfo)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((ModuleName -> HomeModInfo -> IO ())
-> (ModuleName, HomeModInfo) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (HomePackageTable -> ModuleName -> HomeModInfo -> IO ()
addToHpt HomePackageTable
hpt))

----------------------------------------------------------------------------------
---- * Queries
----------------------------------------------------------------------------------

-- | Get all 'CompleteMatches' (arising from COMPLETE pragmas) present in all
-- modules from this unit's HPT.
hptCompleteSigs :: HomePackageTable -> IO CompleteMatches
hptCompleteSigs :: HomePackageTable -> IO CompleteMatches
hptCompleteSigs = (HomeModInfo -> CompleteMatches)
-> HomePackageTable -> IO CompleteMatches
forall a. (HomeModInfo -> [a]) -> HomePackageTable -> IO [a]
concatHpt (ModDetails -> CompleteMatches
md_complete_matches (ModDetails -> CompleteMatches)
-> (HomeModInfo -> ModDetails) -> HomeModInfo -> CompleteMatches
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> ModDetails
hm_details)

-- | Find all the instance declarations (of classes and families) from this Home Package Table
hptAllInstances :: HomePackageTable -> IO (InstEnv, [FamInst])
hptAllInstances :: HomePackageTable -> IO (InstEnv, [FamInst])
hptAllInstances HomePackageTable
hpt = do
  hits <- ((HomeModInfo -> [(InstEnv, [FamInst])])
 -> HomePackageTable -> IO [(InstEnv, [FamInst])])
-> HomePackageTable
-> (HomeModInfo -> [(InstEnv, [FamInst])])
-> IO [(InstEnv, [FamInst])]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (HomeModInfo -> [(InstEnv, [FamInst])])
-> HomePackageTable -> IO [(InstEnv, [FamInst])]
forall a. (HomeModInfo -> [a]) -> HomePackageTable -> IO [a]
concatHpt HomePackageTable
hpt ((HomeModInfo -> [(InstEnv, [FamInst])])
 -> IO [(InstEnv, [FamInst])])
-> (HomeModInfo -> [(InstEnv, [FamInst])])
-> IO [(InstEnv, [FamInst])]
forall a b. (a -> b) -> a -> b
$ \HomeModInfo
mod_info -> do
     let details :: ModDetails
details = HomeModInfo -> ModDetails
hm_details HomeModInfo
mod_info
     (InstEnv, [FamInst]) -> [(InstEnv, [FamInst])]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (ModDetails -> InstEnv
md_insts ModDetails
details, ModDetails -> [FamInst]
md_fam_insts ModDetails
details)
  let (insts, famInsts) = unzip hits
  return (foldl' unionInstEnv emptyInstEnv insts, concat famInsts)

-- | Find all the family instance declarations from the HPT
hptAllFamInstances :: HomePackageTable -> IO (ModuleEnv FamInstEnv)
hptAllFamInstances :: HomePackageTable -> IO (ModuleEnv FamInstEnv)
hptAllFamInstances = ([(Module, FamInstEnv)] -> ModuleEnv FamInstEnv)
-> IO [(Module, FamInstEnv)] -> IO (ModuleEnv FamInstEnv)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Module, FamInstEnv)] -> ModuleEnv FamInstEnv
forall a. [(Module, a)] -> ModuleEnv a
mkModuleEnv (IO [(Module, FamInstEnv)] -> IO (ModuleEnv FamInstEnv))
-> (HomePackageTable -> IO [(Module, FamInstEnv)])
-> HomePackageTable
-> IO (ModuleEnv FamInstEnv)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HomeModInfo -> [(Module, FamInstEnv)])
-> HomePackageTable -> IO [(Module, FamInstEnv)]
forall a. (HomeModInfo -> [a]) -> HomePackageTable -> IO [a]
concatHpt (\HomeModInfo
hmi -> [(HomeModInfo -> Module
hmiModule HomeModInfo
hmi, HomeModInfo -> FamInstEnv
hmiFamInstEnv HomeModInfo
hmi)])
  where
    hmiModule :: HomeModInfo -> Module
hmiModule     = ModIface_ 'ModIfaceFinal -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module (ModIface_ 'ModIfaceFinal -> Module)
-> (HomeModInfo -> ModIface_ 'ModIfaceFinal)
-> HomeModInfo
-> Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> ModIface_ 'ModIfaceFinal
hm_iface
    hmiFamInstEnv :: HomeModInfo -> FamInstEnv
hmiFamInstEnv = FamInstEnv -> [FamInst] -> FamInstEnv
extendFamInstEnvList FamInstEnv
emptyFamInstEnv
                      ([FamInst] -> FamInstEnv)
-> (HomeModInfo -> [FamInst]) -> HomeModInfo -> FamInstEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModDetails -> [FamInst]
md_fam_insts (ModDetails -> [FamInst])
-> (HomeModInfo -> ModDetails) -> HomeModInfo -> [FamInst]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> ModDetails
hm_details

-- | All annotations from the HPT
hptAllAnnotations :: HomePackageTable -> IO AnnEnv
hptAllAnnotations :: HomePackageTable -> IO AnnEnv
hptAllAnnotations = ([Annotation] -> AnnEnv) -> IO [Annotation] -> IO AnnEnv
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Annotation] -> AnnEnv
mkAnnEnv (IO [Annotation] -> IO AnnEnv)
-> (HomePackageTable -> IO [Annotation])
-> HomePackageTable
-> IO AnnEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HomeModInfo -> [Annotation])
-> HomePackageTable -> IO [Annotation]
forall a. (HomeModInfo -> [a]) -> HomePackageTable -> IO [a]
concatHpt (ModDetails -> [Annotation]
md_anns (ModDetails -> [Annotation])
-> (HomeModInfo -> ModDetails) -> HomeModInfo -> [Annotation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> ModDetails
hm_details)


--------------------------------------------------------------------------------
-- * Traversal-based queries
--------------------------------------------------------------------------------

-- | Collect the immediate dependencies of all modules in the HPT into a Set.
-- The immediate dependencies are given by the iface as @'dep_direct_pkgs' . 'mi_deps'@.
--
-- Note: This should be a query on the 'ModuleGraph', since we don't really
-- ever want to collect *all* dependencies. The current caller of this function
-- currently takes all dependencies only to then filter them with an ad-hoc transitive closure check.
-- See #25639
hptCollectDependencies :: HomePackageTable -> IO (Set.Set UnitId)
hptCollectDependencies :: HomePackageTable -> IO (Set UnitId)
hptCollectDependencies HPT{IORef (DModuleNameEnv HomeModInfo)
table :: HomePackageTable -> IORef (DModuleNameEnv HomeModInfo)
table :: IORef (DModuleNameEnv HomeModInfo)
table} = do
  hpt <- IORef (DModuleNameEnv HomeModInfo)
-> IO (DModuleNameEnv HomeModInfo)
forall a. IORef a -> IO a
readIORef IORef (DModuleNameEnv HomeModInfo)
table
  return $
    foldr (Set.union . dep_direct_pkgs . mi_deps . hm_iface) Set.empty hpt

-- | Collect the linkable object of all modules in the HPT.
-- The linkable objects are given by @'homeModInfoObject'@.
--
-- $O(n)$ in the number of modules in the HPT.
hptCollectObjects :: HomePackageTable -> IO [Linkable]
hptCollectObjects :: HomePackageTable -> IO [Linkable]
hptCollectObjects HPT{IORef (DModuleNameEnv HomeModInfo)
table :: HomePackageTable -> IORef (DModuleNameEnv HomeModInfo)
table :: IORef (DModuleNameEnv HomeModInfo)
table} = do
  hpt <- IORef (DModuleNameEnv HomeModInfo)
-> IO (DModuleNameEnv HomeModInfo)
forall a. IORef a -> IO a
readIORef IORef (DModuleNameEnv HomeModInfo)
table
  return $
    foldr ((:) . expectJust "collectObjects" . homeModInfoObject) [] hpt

-- | Collect all module ifaces in the HPT
--
-- $O(n)$ in the number of modules in the HPT.
hptCollectModules :: HomePackageTable -> IO [Module]
hptCollectModules :: HomePackageTable -> IO [Module]
hptCollectModules HPT{IORef (DModuleNameEnv HomeModInfo)
table :: HomePackageTable -> IORef (DModuleNameEnv HomeModInfo)
table :: IORef (DModuleNameEnv HomeModInfo)
table} = do
  hpt <- IORef (DModuleNameEnv HomeModInfo)
-> IO (DModuleNameEnv HomeModInfo)
forall a. IORef a -> IO a
readIORef IORef (DModuleNameEnv HomeModInfo)
table
  return $
    foldr ((:) . mi_module . hm_iface) [] hpt

--------------------------------------------------------------------------------
-- * Utilities
--------------------------------------------------------------------------------

-- | Pretty print a 'HomePackageTable'.
--
-- Make sure you really do need to print the whole HPT before infusing too much
-- code with IO.
--
-- For instance, in the HUG, it suffices to print the unit-keys present in the
-- unit map in failed lookups.
pprHPT :: HomePackageTable -> IO SDoc
-- A bit arbitrary for now
pprHPT :: HomePackageTable -> IO SDoc
pprHPT HPT{table :: HomePackageTable -> IORef (DModuleNameEnv HomeModInfo)
table=IORef (DModuleNameEnv HomeModInfo)
hptr} = do
  hpt <- IORef (DModuleNameEnv HomeModInfo)
-> IO (DModuleNameEnv HomeModInfo)
forall a. IORef a -> IO a
readIORef IORef (DModuleNameEnv HomeModInfo)
hptr
  return $!
    pprUDFM hpt $ \[HomeModInfo]
hms ->
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIface_ 'ModIfaceFinal -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module (HomeModInfo -> ModIface_ 'ModIfaceFinal
hm_iface HomeModInfo
hm))
           | HomeModInfo
hm <- [HomeModInfo]
hms ]

----------------------------------------------------------------------------------
-- THE TYPE OF FOOTGUNS WE DON'T WANT TO EXPOSE
----------------------------------------------------------------------------------

-- eltsHpt :: HomePackageTable -> [HomeModInfo]
-- filterHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> HomePackageTable
-- mapHpt :: (HomeModInfo -> HomeModInfo) -> HomePackageTable -> HomePackageTable
-- delFromHpt :: HomePackageTable -> ModuleName -> HomePackageTable
-- listToHpt :: [(ModuleName, HomeModInfo)] -> HomePackageTable
-- listHMIToHpt :: [HomeModInfo] -> HomePackageTable

----------------------------------------------------------------------------------
-- Would be fine, but may lead to linearly traversing the HPT unnecessarily
-- (e.g. `lastLoadedKey` superseded bad usages)
----------------------------------------------------------------------------------

-- allHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> Bool
-- allHpt = allUDFM

-- anyHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> Bool
-- anyHpt = anyUDFM

----------------------------------------------------------------------------------
-- Would be ok to expose this function very /careful/ with the argument function
----------------------------------------------------------------------------------

-- | Like @concatMap f . 'eltsHpt'@, but filters out all 'HomeModInfo' for which
-- @f@ returns the empty list before doing the sort inherent to 'eltsUDFM'.
--
-- If this function is ever exposed from the HPT module, make sure the
-- argument function doesn't introduce leaks.
concatHpt :: (HomeModInfo -> [a]) -> HomePackageTable -> IO [a]
concatHpt :: forall a. (HomeModInfo -> [a]) -> HomePackageTable -> IO [a]
concatHpt HomeModInfo -> [a]
f HPT{IORef (DModuleNameEnv HomeModInfo)
table :: HomePackageTable -> IORef (DModuleNameEnv HomeModInfo)
table :: IORef (DModuleNameEnv HomeModInfo)
table} = do
  hpt <- IORef (DModuleNameEnv HomeModInfo)
-> IO (DModuleNameEnv HomeModInfo)
forall a. IORef a -> IO a
readIORef IORef (DModuleNameEnv HomeModInfo)
table
  return $ concat . eltsUDFM . mapMaybeUDFM g $ hpt
  where
    g :: HomeModInfo -> Maybe [a]
g HomeModInfo
hmi = case HomeModInfo -> [a]
f HomeModInfo
hmi of { [] -> Maybe [a]
forall a. Maybe a
Nothing; [a]
as -> [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
as }

--------------------------------------------------------------------------------
-- * Internals (see haddocks!)
--------------------------------------------------------------------------------

-- | Gets the internal 'IORef' which holds the 'HomeModInfo's of this HPT.
-- Use with care.
hptInternalTableRef :: HomePackageTable -> IORef (DModuleNameEnv HomeModInfo)
hptInternalTableRef :: HomePackageTable -> IORef (DModuleNameEnv HomeModInfo)
hptInternalTableRef = HomePackageTable -> IORef (DModuleNameEnv HomeModInfo)
table

-- | Construct a HomePackageTable from the IORef.
-- Use with care, only if you can really justify going around the intended insert-only API.
hptInternalTableFromRef :: IORef (DModuleNameEnv HomeModInfo) -> IO HomePackageTable
hptInternalTableFromRef :: IORef (DModuleNameEnv HomeModInfo) -> IO HomePackageTable
hptInternalTableFromRef IORef (DModuleNameEnv HomeModInfo)
ref = do
  HomePackageTable -> IO HomePackageTable
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return HPT {
    table :: IORef (DModuleNameEnv HomeModInfo)
table = IORef (DModuleNameEnv HomeModInfo)
ref
  }