{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

-- | Like @'GHC.Unit.Module.Graph'@ but for the @'ExternalModuleGraph'@ which is
-- stored in the EPS.
module GHC.Unit.Module.External.Graph
  ( -- * External Module Graph
    --
    -- | A module graph for the EPS.
    ExternalModuleGraph, ExternalGraphNode(..)
  , ExternalKey(..), emptyExternalModuleGraph
  , emgNodeKey, emgNodeDeps, emgLookupKey

    -- * Extending
    --
    -- | The @'ExternalModuleGraph'@ is a structure which is incrementally
    -- updated as the 'ExternalPackageState' (EPS) is updated (when an iface is
    -- loaded, in 'loadInterface').
    --
    -- Therefore, there is an operation for extending the 'ExternalModuleGraph',
    -- unlike @'GHC.Unit.Module.Graph.ModuleGraph'@, which is constructed once
    -- during downsweep and never altered (since all of the home units
    -- dependencies are fully known then).
  , extendExternalModuleGraph

    -- * Loading
    --
    -- | As mentioned in the top-level haddocks for the
    -- 'extendExternalModuleGraph', the external module graph is incrementally
    -- updated as interfaces are loaded. This module graph keeps an additional
    -- cache registering which modules have already been fully loaded.
    --
    -- This cache is necessary to quickly check when a full-transitive-closure
    -- reachability query would be valid for some module.
    --
    -- Such a query may be invalid if ran on a module in the
    -- 'ExternalModuleGraph' whose dependencies have /not yet/ been fully loaded
    -- into the EPS.
    -- (Recall that interfaces are lazily loaded, and the 'ExternalModuleGraph'
    -- is only incrementally updated).
    --
    -- To guarantee the full transitive closure of a given module is completely
    -- loaded into the EPS (i.e. all interfaces of the modules below this one
    -- are also loaded), see @'loadExternalGraphBelow'@ in
    -- 'GHC.Iface.Load'.
  , isFullyLoadedModule
  , setFullyLoadedModule

    -- * Reachability
    --
    -- | Fast reachability queries on the external module graph. Similar to
    -- reachability queries on 'GHC.Unit.Module.Graph'.
  , emgReachableLoop
  , emgReachableLoopMany
  ) where

import GHC.Prelude
import GHC.Unit.Module.Graph
import GHC.Data.Graph.Directed.Reachability
import GHC.Data.Graph.Directed
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Bifunctor (first, bimap)
import Data.Maybe
import GHC.Utils.Outputable
import GHC.Unit.Types (UnitId, GenWithIsBoot(..), IsBootInterface(..), mkModule)
import GHC.Utils.Misc


--------------------------------------------------------------------------------
-- * Main
--------------------------------------------------------------------------------

data ExternalModuleGraph = ExternalModuleGraph
  { ExternalModuleGraph -> [ExternalGraphNode]
external_nodes :: [ExternalGraphNode]
  -- This transitive dependency query does not contain hs-boot nodes.
  , ExternalModuleGraph
-> (ReachabilityIndex ExternalNode,
    ExternalKey -> Maybe ExternalNode)
external_trans :: (ReachabilityIndex ExternalNode, ExternalKey -> Maybe ExternalNode)
  , ExternalModuleGraph -> Set ExternalKey
external_fully_loaded :: !(S.Set ExternalKey) }

type ExternalNode = Node Int ExternalGraphNode

data ExternalGraphNode
  -- | A node for a home package module that is inserted in the EPS.
  --
  -- INVARIANT: This type of node can only ever exist if compiling in one-shot
  -- mode. In --make mode, it is imperative that the EPS doesn't have any home
  -- package modules ever.
  = NodeHomePackage
      { ExternalGraphNode -> ModNodeKeyWithUid
externalNodeKey :: ModNodeKeyWithUid
      , ExternalGraphNode -> [ExternalKey]
externalNodeDeps :: [ExternalKey] }
  -- | A node for packages with at least one module loaded in the EPS.
  --
  -- Edge from A to NodeExternalPackage p when A has p as a direct package
  -- dependency.
  | NodeExternalPackage
      { ExternalGraphNode -> UnitId
externalPkgKey :: UnitId
      , ExternalGraphNode -> Set UnitId
externalPkgDeps :: S.Set UnitId
      }

data ExternalKey
  = ExternalModuleKey ModNodeKeyWithUid
  | ExternalPackageKey UnitId
  deriving (ExternalKey -> ExternalKey -> Bool
(ExternalKey -> ExternalKey -> Bool)
-> (ExternalKey -> ExternalKey -> Bool) -> Eq ExternalKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExternalKey -> ExternalKey -> Bool
== :: ExternalKey -> ExternalKey -> Bool
$c/= :: ExternalKey -> ExternalKey -> Bool
/= :: ExternalKey -> ExternalKey -> Bool
Eq, Eq ExternalKey
Eq ExternalKey =>
(ExternalKey -> ExternalKey -> Ordering)
-> (ExternalKey -> ExternalKey -> Bool)
-> (ExternalKey -> ExternalKey -> Bool)
-> (ExternalKey -> ExternalKey -> Bool)
-> (ExternalKey -> ExternalKey -> Bool)
-> (ExternalKey -> ExternalKey -> ExternalKey)
-> (ExternalKey -> ExternalKey -> ExternalKey)
-> Ord ExternalKey
ExternalKey -> ExternalKey -> Bool
ExternalKey -> ExternalKey -> Ordering
ExternalKey -> ExternalKey -> ExternalKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ExternalKey -> ExternalKey -> Ordering
compare :: ExternalKey -> ExternalKey -> Ordering
$c< :: ExternalKey -> ExternalKey -> Bool
< :: ExternalKey -> ExternalKey -> Bool
$c<= :: ExternalKey -> ExternalKey -> Bool
<= :: ExternalKey -> ExternalKey -> Bool
$c> :: ExternalKey -> ExternalKey -> Bool
> :: ExternalKey -> ExternalKey -> Bool
$c>= :: ExternalKey -> ExternalKey -> Bool
>= :: ExternalKey -> ExternalKey -> Bool
$cmax :: ExternalKey -> ExternalKey -> ExternalKey
max :: ExternalKey -> ExternalKey -> ExternalKey
$cmin :: ExternalKey -> ExternalKey -> ExternalKey
min :: ExternalKey -> ExternalKey -> ExternalKey
Ord)

emptyExternalModuleGraph :: ExternalModuleGraph
emptyExternalModuleGraph :: ExternalModuleGraph
emptyExternalModuleGraph = [ExternalGraphNode]
-> (ReachabilityIndex ExternalNode,
    ExternalKey -> Maybe ExternalNode)
-> Set ExternalKey
-> ExternalModuleGraph
ExternalModuleGraph [] (Graph ExternalNode -> ReachabilityIndex ExternalNode
forall node. Graph node -> ReachabilityIndex node
graphReachability Graph ExternalNode
forall a. Graph a
emptyGraph, Maybe ExternalNode -> ExternalKey -> Maybe ExternalNode
forall a b. a -> b -> a
const Maybe ExternalNode
forall a. Maybe a
Nothing) Set ExternalKey
forall a. Set a
S.empty

-- | Get the dependencies of an 'ExternalNode'
emgNodeDeps :: Bool -> ExternalGraphNode -> [ExternalKey]
emgNodeDeps :: Bool -> ExternalGraphNode -> [ExternalKey]
emgNodeDeps Bool
drop_hs_boot_nodes = \case
  NodeHomePackage ModNodeKeyWithUid
_ [ExternalKey]
dps -> (ExternalKey -> ExternalKey) -> [ExternalKey] -> [ExternalKey]
forall a b. (a -> b) -> [a] -> [b]
map ExternalKey -> ExternalKey
drop_hs_boot [ExternalKey]
dps
  NodeExternalPackage UnitId
_ Set UnitId
dps -> (UnitId -> ExternalKey) -> [UnitId] -> [ExternalKey]
forall a b. (a -> b) -> [a] -> [b]
map UnitId -> ExternalKey
ExternalPackageKey ([UnitId] -> [ExternalKey]) -> [UnitId] -> [ExternalKey]
forall a b. (a -> b) -> a -> b
$ Set UnitId -> [UnitId]
forall a. Set a -> [a]
S.toList Set UnitId
dps
  where
    -- Drop hs-boot nodes by using HsSrcFile as the key
    hs_boot_key :: IsBootInterface
hs_boot_key | Bool
drop_hs_boot_nodes = IsBootInterface
NotBoot -- is regular mod or signature
                | Bool
otherwise          = IsBootInterface
IsBoot

    drop_hs_boot :: ExternalKey -> ExternalKey
drop_hs_boot (ExternalModuleKey (ModNodeKeyWithUid (GWIB ModuleName
mn IsBootInterface
IsBoot) UnitId
uid)) = (ModNodeKeyWithUid -> ExternalKey
ExternalModuleKey (GenWithIsBoot ModuleName -> UnitId -> ModNodeKeyWithUid
ModNodeKeyWithUid (ModuleName -> IsBootInterface -> GenWithIsBoot ModuleName
forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
GWIB ModuleName
mn IsBootInterface
hs_boot_key) UnitId
uid))
    drop_hs_boot ExternalKey
x = ExternalKey
x

-- | The graph key for a given node
emgNodeKey :: ExternalGraphNode -> ExternalKey
emgNodeKey :: ExternalGraphNode -> ExternalKey
emgNodeKey (NodeHomePackage ModNodeKeyWithUid
k [ExternalKey]
_) = ModNodeKeyWithUid -> ExternalKey
ExternalModuleKey ModNodeKeyWithUid
k
emgNodeKey (NodeExternalPackage UnitId
k Set UnitId
_) = UnitId -> ExternalKey
ExternalPackageKey UnitId
k

-- | Lookup a key in the EMG.
emgLookupKey :: ExternalKey -> ExternalModuleGraph -> Maybe ExternalGraphNode
emgLookupKey :: ExternalKey -> ExternalModuleGraph -> Maybe ExternalGraphNode
emgLookupKey ExternalKey
k ExternalModuleGraph
emg = ExternalNode -> ExternalGraphNode
forall key payload. Node key payload -> payload
node_payload (ExternalNode -> ExternalGraphNode)
-> Maybe ExternalNode -> Maybe ExternalGraphNode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ReachabilityIndex ExternalNode, ExternalKey -> Maybe ExternalNode)
-> ExternalKey -> Maybe ExternalNode
forall a b. (a, b) -> b
snd (ExternalModuleGraph
-> (ReachabilityIndex ExternalNode,
    ExternalKey -> Maybe ExternalNode)
external_trans ExternalModuleGraph
emg)) ExternalKey
k

--------------------------------------------------------------------------------
-- * Extending
--------------------------------------------------------------------------------

extendExternalModuleGraph :: ExternalGraphNode -> ExternalModuleGraph -> ExternalModuleGraph
extendExternalModuleGraph :: ExternalGraphNode -> ExternalModuleGraph -> ExternalModuleGraph
extendExternalModuleGraph ExternalGraphNode
node ExternalModuleGraph{[ExternalGraphNode]
(ReachabilityIndex ExternalNode, ExternalKey -> Maybe ExternalNode)
Set ExternalKey
external_nodes :: ExternalModuleGraph -> [ExternalGraphNode]
external_trans :: ExternalModuleGraph
-> (ReachabilityIndex ExternalNode,
    ExternalKey -> Maybe ExternalNode)
external_fully_loaded :: ExternalModuleGraph -> Set ExternalKey
external_nodes :: [ExternalGraphNode]
external_trans :: (ReachabilityIndex ExternalNode, ExternalKey -> Maybe ExternalNode)
external_fully_loaded :: Set ExternalKey
..} =
  ExternalModuleGraph
    { external_fully_loaded :: Set ExternalKey
external_fully_loaded = Set ExternalKey
external_fully_loaded
    , external_nodes :: [ExternalGraphNode]
external_nodes = ExternalGraphNode
node ExternalGraphNode -> [ExternalGraphNode] -> [ExternalGraphNode]
forall a. a -> [a] -> [a]
: [ExternalGraphNode]
external_nodes
    , external_trans :: (ReachabilityIndex ExternalNode, ExternalKey -> Maybe ExternalNode)
external_trans = (Graph ExternalNode -> ReachabilityIndex ExternalNode)
-> (Graph ExternalNode, ExternalKey -> Maybe ExternalNode)
-> (ReachabilityIndex ExternalNode,
    ExternalKey -> Maybe ExternalNode)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Graph ExternalNode -> ReachabilityIndex ExternalNode
forall node. Graph node -> ReachabilityIndex node
cyclicGraphReachability ((Graph ExternalNode, ExternalKey -> Maybe ExternalNode)
 -> (ReachabilityIndex ExternalNode,
     ExternalKey -> Maybe ExternalNode))
-> (Graph ExternalNode, ExternalKey -> Maybe ExternalNode)
-> (ReachabilityIndex ExternalNode,
    ExternalKey -> Maybe ExternalNode)
forall a b. (a -> b) -> a -> b
$
                       Bool
-> [ExternalGraphNode]
-> (Graph ExternalNode, ExternalKey -> Maybe ExternalNode)
externalGraphNodes Bool
True (ExternalGraphNode
node ExternalGraphNode -> [ExternalGraphNode] -> [ExternalGraphNode]
forall a. a -> [a] -> [a]
: [ExternalGraphNode]
external_nodes)
    }

--------------------------------------------------------------------------------
-- * Loading
--------------------------------------------------------------------------------

isFullyLoadedModule :: ExternalKey -> ExternalModuleGraph -> Bool
isFullyLoadedModule :: ExternalKey -> ExternalModuleGraph -> Bool
isFullyLoadedModule ExternalKey
key ExternalModuleGraph
graph = ExternalKey -> Set ExternalKey -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member ExternalKey
key (ExternalModuleGraph -> Set ExternalKey
external_fully_loaded ExternalModuleGraph
graph)

setFullyLoadedModule :: ExternalKey -> ExternalModuleGraph -> ExternalModuleGraph
setFullyLoadedModule :: ExternalKey -> ExternalModuleGraph -> ExternalModuleGraph
setFullyLoadedModule ExternalKey
key ExternalModuleGraph
graph = ExternalModuleGraph
graph { external_fully_loaded = S.insert key (external_fully_loaded graph)}

--------------------------------------------------------------------------------
-- * Reachability
--------------------------------------------------------------------------------

-- | Return all nodes reachable from the given key, also known as its full
-- transitive closure.
--
-- @Nothing@ if the key couldn't be found in the graph.
emgReachableLoop :: ExternalModuleGraph -> ExternalKey -> Maybe [ExternalGraphNode]
emgReachableLoop :: ExternalModuleGraph -> ExternalKey -> Maybe [ExternalGraphNode]
emgReachableLoop ExternalModuleGraph
mg ExternalKey
nk = (ExternalNode -> ExternalGraphNode)
-> [ExternalNode] -> [ExternalGraphNode]
forall a b. (a -> b) -> [a] -> [b]
map ExternalNode -> ExternalGraphNode
forall key payload. Node key payload -> payload
node_payload ([ExternalNode] -> [ExternalGraphNode])
-> Maybe [ExternalNode] -> Maybe [ExternalGraphNode]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [ExternalNode]
modules_below where
  (ReachabilityIndex ExternalNode
td_map, ExternalKey -> Maybe ExternalNode
lookup_node) = ExternalModuleGraph
-> (ReachabilityIndex ExternalNode,
    ExternalKey -> Maybe ExternalNode)
external_trans ExternalModuleGraph
mg
  modules_below :: Maybe [ExternalNode]
modules_below =
    ReachabilityIndex ExternalNode -> ExternalNode -> [ExternalNode]
forall node. ReachabilityIndex node -> node -> [node]
allReachable ReachabilityIndex ExternalNode
td_map (ExternalNode -> [ExternalNode])
-> Maybe ExternalNode -> Maybe [ExternalNode]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExternalKey -> Maybe ExternalNode
lookup_node ExternalKey
nk

-- | Return all nodes reachable from all of the given keys.
emgReachableLoopMany :: ExternalModuleGraph -> [ExternalKey] -> [ExternalGraphNode]
emgReachableLoopMany :: ExternalModuleGraph -> [ExternalKey] -> [ExternalGraphNode]
emgReachableLoopMany ExternalModuleGraph
mg [ExternalKey]
nk = (ExternalNode -> ExternalGraphNode)
-> [ExternalNode] -> [ExternalGraphNode]
forall a b. (a -> b) -> [a] -> [b]
map ExternalNode -> ExternalGraphNode
forall key payload. Node key payload -> payload
node_payload [ExternalNode]
modules_below where
  (ReachabilityIndex ExternalNode
td_map, ExternalKey -> Maybe ExternalNode
lookup_node) = ExternalModuleGraph
-> (ReachabilityIndex ExternalNode,
    ExternalKey -> Maybe ExternalNode)
external_trans ExternalModuleGraph
mg
  modules_below :: [ExternalNode]
modules_below =
    ReachabilityIndex ExternalNode -> [ExternalNode] -> [ExternalNode]
forall node. ReachabilityIndex node -> [node] -> [node]
allReachableMany ReachabilityIndex ExternalNode
td_map ((ExternalKey -> Maybe ExternalNode)
-> [ExternalKey] -> [ExternalNode]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ExternalKey -> Maybe ExternalNode
lookup_node [ExternalKey]
nk)

--------------------------------------------------------------------------------
-- * Internals
--------------------------------------------------------------------------------

-- | Turn a list of graph nodes into an efficient queriable graph.
-- The first boolean parameter indicates whether nodes corresponding to hs-boot files
-- should be collapsed into their relevant hs nodes.
externalGraphNodes :: Bool
  -> [ExternalGraphNode]
  -> (Graph ExternalNode, ExternalKey -> Maybe ExternalNode)
externalGraphNodes :: Bool
-> [ExternalGraphNode]
-> (Graph ExternalNode, ExternalKey -> Maybe ExternalNode)
externalGraphNodes Bool
drop_hs_boot_nodes [ExternalGraphNode]
summaries =
  ([ExternalNode] -> Graph ExternalNode
forall key payload.
Uniquable key =>
[Node key payload] -> Graph (Node key payload)
graphFromEdgedVerticesUniq [ExternalNode]
nodes, ExternalKey -> Maybe ExternalNode
lookup_node)
  where
    -- Map from module to extra boot summary dependencies which need to be merged in
    (Map (GenModule UnitId) [ExternalKey]
boot_summaries, [ExternalNode]
nodes) = ([(GenModule UnitId, [ExternalKey])]
 -> Map (GenModule UnitId) [ExternalKey])
-> ([ExternalNode] -> [ExternalNode])
-> ([(GenModule UnitId, [ExternalKey])], [ExternalNode])
-> (Map (GenModule UnitId) [ExternalKey], [ExternalNode])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [(GenModule UnitId, [ExternalKey])]
-> Map (GenModule UnitId) [ExternalKey]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ExternalNode] -> [ExternalNode]
forall a. a -> a
id (([(GenModule UnitId, [ExternalKey])], [ExternalNode])
 -> (Map (GenModule UnitId) [ExternalKey], [ExternalNode]))
-> ([(GenModule UnitId, [ExternalKey])], [ExternalNode])
-> (Map (GenModule UnitId) [ExternalKey], [ExternalNode])
forall a b. (a -> b) -> a -> b
$ ((ExternalGraphNode, Int)
 -> Either (GenModule UnitId, [ExternalKey]) ExternalNode)
-> [(ExternalGraphNode, Int)]
-> ([(GenModule UnitId, [ExternalKey])], [ExternalNode])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith (ExternalGraphNode, Int)
-> Either (GenModule UnitId, [ExternalKey]) ExternalNode
go [(ExternalGraphNode, Int)]
numbered_summaries

      where
        go :: (ExternalGraphNode, Int)
-> Either (GenModule UnitId, [ExternalKey]) ExternalNode
go (ExternalGraphNode
s, Int
key) =
          case ExternalGraphNode
s of
                NodeHomePackage (ModNodeKeyWithUid (GWIB ModuleName
mn IsBootInterface
IsBoot) UnitId
uid) [ExternalKey]
_deps | Bool
drop_hs_boot_nodes
                  -- Using emgNodeDeps here converts dependencies on other
                  -- boot files to dependencies on dependencies on non-boot files.
                  -> (GenModule UnitId, [ExternalKey])
-> Either (GenModule UnitId, [ExternalKey]) ExternalNode
forall a b. a -> Either a b
Left (UnitId -> ModuleName -> GenModule UnitId
forall u. u -> ModuleName -> GenModule u
mkModule UnitId
uid ModuleName
mn, Bool -> ExternalGraphNode -> [ExternalKey]
emgNodeDeps Bool
drop_hs_boot_nodes ExternalGraphNode
s)
                ExternalGraphNode
_ -> Either (GenModule UnitId, [ExternalKey]) ExternalNode
normal_case
          where
           normal_case :: Either (GenModule UnitId, [ExternalKey]) ExternalNode
normal_case =
              let lkup_key :: Maybe (GenModule UnitId)
lkup_key =
                    case ExternalGraphNode
s of
                      NodeHomePackage (ModNodeKeyWithUid (GWIB ModuleName
mn IsBootInterface
IsBoot) UnitId
uid) [ExternalKey]
_deps
                        -> GenModule UnitId -> Maybe (GenModule UnitId)
forall a. a -> Maybe a
Just (GenModule UnitId -> Maybe (GenModule UnitId))
-> GenModule UnitId -> Maybe (GenModule UnitId)
forall a b. (a -> b) -> a -> b
$ UnitId -> ModuleName -> GenModule UnitId
forall u. u -> ModuleName -> GenModule u
mkModule UnitId
uid ModuleName
mn
                      ExternalGraphNode
_ -> Maybe (GenModule UnitId)
forall a. Maybe a
Nothing

                  extra :: Maybe [ExternalKey]
extra = (Maybe (GenModule UnitId)
lkup_key Maybe (GenModule UnitId)
-> (GenModule UnitId -> Maybe [ExternalKey]) -> Maybe [ExternalKey]
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \GenModule UnitId
key -> GenModule UnitId
-> Map (GenModule UnitId) [ExternalKey] -> Maybe [ExternalKey]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup GenModule UnitId
key Map (GenModule UnitId) [ExternalKey]
boot_summaries)

              in ExternalNode
-> Either (GenModule UnitId, [ExternalKey]) ExternalNode
forall a b. b -> Either a b
Right (ExternalNode
 -> Either (GenModule UnitId, [ExternalKey]) ExternalNode)
-> ExternalNode
-> Either (GenModule UnitId, [ExternalKey]) ExternalNode
forall a b. (a -> b) -> a -> b
$ ExternalGraphNode -> Int -> [Int] -> ExternalNode
forall key payload. payload -> key -> [key] -> Node key payload
DigraphNode ExternalGraphNode
s Int
key ([Int] -> ExternalNode) -> [Int] -> ExternalNode
forall a b. (a -> b) -> a -> b
$ [ExternalKey] -> [Int]
out_edge_keys ([ExternalKey] -> [Int]) -> [ExternalKey] -> [Int]
forall a b. (a -> b) -> a -> b
$
                      ([ExternalKey] -> Maybe [ExternalKey] -> [ExternalKey]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [ExternalKey]
extra
                        [ExternalKey] -> [ExternalKey] -> [ExternalKey]
forall a. [a] -> [a] -> [a]
++ Bool -> ExternalGraphNode -> [ExternalKey]
emgNodeDeps Bool
drop_hs_boot_nodes ExternalGraphNode
s)

    numbered_summaries :: [(ExternalGraphNode, Int)]
numbered_summaries = [ExternalGraphNode] -> [Int] -> [(ExternalGraphNode, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ExternalGraphNode]
summaries [Int
1..]

    lookup_node :: ExternalKey -> Maybe ExternalNode
    lookup_node :: ExternalKey -> Maybe ExternalNode
lookup_node ExternalKey
key = ExternalKey -> Map ExternalKey ExternalNode -> Maybe ExternalNode
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ExternalKey
key Map ExternalKey ExternalNode
node_map

    lookup_key :: ExternalKey -> Maybe Int
    lookup_key :: ExternalKey -> Maybe Int
lookup_key = (ExternalNode -> Int) -> Maybe ExternalNode -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExternalNode -> Int
forall key payload. Node key payload -> key
node_key (Maybe ExternalNode -> Maybe Int)
-> (ExternalKey -> Maybe ExternalNode) -> ExternalKey -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExternalKey -> Maybe ExternalNode
lookup_node

    node_map :: M.Map ExternalKey ExternalNode
    node_map :: Map ExternalKey ExternalNode
node_map =
      [(ExternalKey, ExternalNode)] -> Map ExternalKey ExternalNode
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (ExternalGraphNode -> ExternalKey
emgNodeKey ExternalGraphNode
s, ExternalNode
node)
                 | ExternalNode
node <- [ExternalNode]
nodes
                 , let s :: ExternalGraphNode
s = ExternalNode -> ExternalGraphNode
forall key payload. Node key payload -> payload
node_payload ExternalNode
node
                 ]

    out_edge_keys :: [ExternalKey] -> [Int]
    out_edge_keys :: [ExternalKey] -> [Int]
out_edge_keys = (ExternalKey -> Maybe Int) -> [ExternalKey] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ExternalKey -> Maybe Int
lookup_key
        -- If we want keep_hi_boot_nodes, then we do lookup_key with
        -- IsBoot; else False

instance Outputable ExternalGraphNode where
  ppr :: ExternalGraphNode -> SDoc
ppr = \case
    NodeHomePackage ModNodeKeyWithUid
mk [ExternalKey]
ds -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NodeHomePackage" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModNodeKeyWithUid -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModNodeKeyWithUid
mk SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [ExternalKey] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [ExternalKey]
ds
    NodeExternalPackage UnitId
mk Set UnitId
ds -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NodeExternalPackage" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
mk SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Set UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr Set UnitId
ds

instance Outputable ExternalKey where
  ppr :: ExternalKey -> SDoc
ppr = \case
    ExternalModuleKey ModNodeKeyWithUid
mk -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ExternalModuleKey" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModNodeKeyWithUid -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModNodeKeyWithUid
mk
    ExternalPackageKey UnitId
uid -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ExternalPackageKey" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
uid

instance Outputable ExternalModuleGraph where
  ppr :: ExternalModuleGraph -> SDoc
ppr ExternalModuleGraph{[ExternalGraphNode]
external_nodes :: ExternalModuleGraph -> [ExternalGraphNode]
external_nodes :: [ExternalGraphNode]
external_nodes, Set ExternalKey
external_fully_loaded :: ExternalModuleGraph -> Set ExternalKey
external_fully_loaded :: Set ExternalKey
external_fully_loaded}
    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ExternalModuleGraph" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [ExternalGraphNode] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [ExternalGraphNode]
external_nodes SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Set ExternalKey -> SDoc
forall a. Outputable a => a -> SDoc
ppr Set ExternalKey
external_fully_loaded