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

module GHC.Unit.Module.Graph
   ( ModuleGraph
   , ModuleGraphNode(..)
   , nodeDependencies
   , emptyMG
   , mkModuleGraph
   , extendMG
   , extendMGInst
   , extendMG'
   , unionMG
   , isTemplateHaskellOrQQNonBoot
   , filterToposortToModules
   , mapMG
   , mgModSummaries
   , mgModSummaries'
   , mgLookupModule
   , mgTransDeps
   , showModMsg
   , moduleGraphNodeModule
   , moduleGraphNodeModSum

   , moduleGraphNodes
   , SummaryNode
   , summaryNodeSummary

   , NodeKey(..)
   , ModNodeKey
   , mkNodeKey
   , msKey


   , moduleGraphNodeUnitId

   , ModNodeKeyWithUid(..)
   )
where

import GHC.Prelude

import qualified GHC.LanguageExtensions as LangExt

import GHC.Data.Maybe
import GHC.Data.Graph.Directed

import GHC.Driver.Backend
import GHC.Driver.Ppr
import GHC.Driver.Session

import GHC.Types.SourceFile ( hscSourceString )

import GHC.Unit.Module.ModSummary
import GHC.Unit.Module.Env
import GHC.Unit.Types
import GHC.Utils.Outputable

import System.FilePath
import qualified Data.Map as Map
import GHC.Types.Unique.DSet
import qualified Data.Set as Set
import GHC.Unit.Module
import GHC.Linker.Static.Utils

import Data.Bifunctor
import Data.Either
import Data.Function
import GHC.Data.List.SetOps

-- | A '@ModuleGraphNode@' is a node in the '@ModuleGraph@'.
-- Edges between nodes mark dependencies arising from module imports
-- and dependencies arising from backpack instantiations.
data ModuleGraphNode
  -- | Instantiation nodes track the instantiation of other units
  -- (backpack dependencies) with the holes (signatures) of the current package.
  = InstantiationNode UnitId InstantiatedUnit
  -- | There is a module summary node for each module, signature, and boot module being built.
  | ModuleNode [NodeKey] ModSummary
  -- | Link nodes are whether are are creating a linked product (ie executable/shared object etc) for a unit.
  | LinkNode [NodeKey] UnitId

moduleGraphNodeModule :: ModuleGraphNode -> Maybe ModuleName
moduleGraphNodeModule :: ModuleGraphNode -> Maybe ModuleName
moduleGraphNodeModule ModuleGraphNode
mgn = ModSummary -> ModuleName
ms_mod_name (ModSummary -> ModuleName) -> Maybe ModSummary -> Maybe ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ModuleGraphNode -> Maybe ModSummary
moduleGraphNodeModSum ModuleGraphNode
mgn)

moduleGraphNodeModSum :: ModuleGraphNode -> Maybe ModSummary
moduleGraphNodeModSum :: ModuleGraphNode -> Maybe ModSummary
moduleGraphNodeModSum (InstantiationNode {}) = Maybe ModSummary
forall a. Maybe a
Nothing
moduleGraphNodeModSum (LinkNode {})          = Maybe ModSummary
forall a. Maybe a
Nothing
moduleGraphNodeModSum (ModuleNode [NodeKey]
_ ModSummary
ms)      = ModSummary -> Maybe ModSummary
forall a. a -> Maybe a
Just ModSummary
ms

moduleGraphNodeUnitId :: ModuleGraphNode -> UnitId
moduleGraphNodeUnitId :: ModuleGraphNode -> UnitId
moduleGraphNodeUnitId ModuleGraphNode
mgn =
  case ModuleGraphNode
mgn of
    InstantiationNode UnitId
uid InstantiatedUnit
_iud -> UnitId
uid
    ModuleNode [NodeKey]
_ ModSummary
ms           -> Unit -> UnitId
toUnitId (GenModule Unit -> Unit
forall unit. GenModule unit -> unit
moduleUnit (ModSummary -> GenModule Unit
ms_mod ModSummary
ms))
    LinkNode [NodeKey]
_ UnitId
uid             -> UnitId
uid

instance Outputable ModuleGraphNode where
  ppr :: ModuleGraphNode -> SDoc
ppr = \case
    InstantiationNode UnitId
_ InstantiatedUnit
iuid -> InstantiatedUnit -> SDoc
forall a. Outputable a => a -> SDoc
ppr InstantiatedUnit
iuid
    ModuleNode [NodeKey]
nks ModSummary
ms -> ModuleNameWithIsBoot -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModSummary -> ModuleNameWithIsBoot
ms_mnwib ModSummary
ms) SDoc -> SDoc -> SDoc
<+> [NodeKey] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [NodeKey]
nks
    LinkNode [NodeKey]
uid UnitId
_     -> String -> SDoc
text String
"LN:" SDoc -> SDoc -> SDoc
<+> [NodeKey] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [NodeKey]
uid

instance Eq ModuleGraphNode where
  == :: ModuleGraphNode -> ModuleGraphNode -> Bool
(==) = NodeKey -> NodeKey -> Bool
forall a. Eq a => a -> a -> Bool
(==) (NodeKey -> NodeKey -> Bool)
-> (ModuleGraphNode -> NodeKey)
-> ModuleGraphNode
-> ModuleGraphNode
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ModuleGraphNode -> NodeKey
mkNodeKey

instance Ord ModuleGraphNode where
  compare :: ModuleGraphNode -> ModuleGraphNode -> Ordering
compare = NodeKey -> NodeKey -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (NodeKey -> NodeKey -> Ordering)
-> (ModuleGraphNode -> NodeKey)
-> ModuleGraphNode
-> ModuleGraphNode
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ModuleGraphNode -> NodeKey
mkNodeKey

data NodeKey = NodeKey_Unit {-# UNPACK #-} !InstantiatedUnit
             | NodeKey_Module {-# UNPACK #-} !ModNodeKeyWithUid
             | NodeKey_Link !UnitId
  deriving (NodeKey -> NodeKey -> Bool
(NodeKey -> NodeKey -> Bool)
-> (NodeKey -> NodeKey -> Bool) -> Eq NodeKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeKey -> NodeKey -> Bool
$c/= :: NodeKey -> NodeKey -> Bool
== :: NodeKey -> NodeKey -> Bool
$c== :: NodeKey -> NodeKey -> Bool
Eq, Eq NodeKey
Eq NodeKey
-> (NodeKey -> NodeKey -> Ordering)
-> (NodeKey -> NodeKey -> Bool)
-> (NodeKey -> NodeKey -> Bool)
-> (NodeKey -> NodeKey -> Bool)
-> (NodeKey -> NodeKey -> Bool)
-> (NodeKey -> NodeKey -> NodeKey)
-> (NodeKey -> NodeKey -> NodeKey)
-> Ord NodeKey
NodeKey -> NodeKey -> Bool
NodeKey -> NodeKey -> Ordering
NodeKey -> NodeKey -> NodeKey
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
min :: NodeKey -> NodeKey -> NodeKey
$cmin :: NodeKey -> NodeKey -> NodeKey
max :: NodeKey -> NodeKey -> NodeKey
$cmax :: NodeKey -> NodeKey -> NodeKey
>= :: NodeKey -> NodeKey -> Bool
$c>= :: NodeKey -> NodeKey -> Bool
> :: NodeKey -> NodeKey -> Bool
$c> :: NodeKey -> NodeKey -> Bool
<= :: NodeKey -> NodeKey -> Bool
$c<= :: NodeKey -> NodeKey -> Bool
< :: NodeKey -> NodeKey -> Bool
$c< :: NodeKey -> NodeKey -> Bool
compare :: NodeKey -> NodeKey -> Ordering
$ccompare :: NodeKey -> NodeKey -> Ordering
$cp1Ord :: Eq NodeKey
Ord)

instance Outputable NodeKey where
  ppr :: NodeKey -> SDoc
ppr NodeKey
nk = NodeKey -> SDoc
pprNodeKey NodeKey
nk

pprNodeKey :: NodeKey -> SDoc
pprNodeKey :: NodeKey -> SDoc
pprNodeKey (NodeKey_Unit InstantiatedUnit
iu) = InstantiatedUnit -> SDoc
forall a. Outputable a => a -> SDoc
ppr InstantiatedUnit
iu
pprNodeKey (NodeKey_Module ModNodeKeyWithUid
mk) = ModNodeKeyWithUid -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModNodeKeyWithUid
mk
pprNodeKey (NodeKey_Link UnitId
uid)  = UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
uid

data ModNodeKeyWithUid = ModNodeKeyWithUid { ModNodeKeyWithUid -> ModuleNameWithIsBoot
mnkModuleName :: ModuleNameWithIsBoot
                                           , ModNodeKeyWithUid -> UnitId
mnkUnitId     :: UnitId } deriving (ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
(ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool)
-> (ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool)
-> Eq ModNodeKeyWithUid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
$c/= :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
== :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
$c== :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
Eq, Eq ModNodeKeyWithUid
Eq ModNodeKeyWithUid
-> (ModNodeKeyWithUid -> ModNodeKeyWithUid -> Ordering)
-> (ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool)
-> (ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool)
-> (ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool)
-> (ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool)
-> (ModNodeKeyWithUid -> ModNodeKeyWithUid -> ModNodeKeyWithUid)
-> (ModNodeKeyWithUid -> ModNodeKeyWithUid -> ModNodeKeyWithUid)
-> Ord ModNodeKeyWithUid
ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
ModNodeKeyWithUid -> ModNodeKeyWithUid -> Ordering
ModNodeKeyWithUid -> ModNodeKeyWithUid -> ModNodeKeyWithUid
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
min :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> ModNodeKeyWithUid
$cmin :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> ModNodeKeyWithUid
max :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> ModNodeKeyWithUid
$cmax :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> ModNodeKeyWithUid
>= :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
$c>= :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
> :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
$c> :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
<= :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
$c<= :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
< :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
$c< :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
compare :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Ordering
$ccompare :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Ordering
$cp1Ord :: Eq ModNodeKeyWithUid
Ord)

instance Outputable ModNodeKeyWithUid where
  ppr :: ModNodeKeyWithUid -> SDoc
ppr (ModNodeKeyWithUid ModuleNameWithIsBoot
mnwib UnitId
uid) = UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
uid SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
<> ModuleNameWithIsBoot -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleNameWithIsBoot
mnwib

-- | A '@ModuleGraph@' contains all the nodes from the home package (only). See
-- '@ModuleGraphNode@' for information about the nodes.
--
-- Modules need to be compiled. hs-boots need to be typechecked before
-- the associated "real" module so modules with {-# SOURCE #-} imports can be
-- built. Instantiations also need to be typechecked to ensure that the module
-- fits the signature. Substantiation typechecking is roughly comparable to the
-- check that the module and its hs-boot agree.
--
-- The graph is not necessarily stored in topologically-sorted order.  Use
-- 'GHC.topSortModuleGraph' and 'GHC.Data.Graph.Directed.flattenSCC' to achieve this.
data ModuleGraph = ModuleGraph
  { ModuleGraph -> [ModuleGraphNode]
mg_mss :: [ModuleGraphNode]
  , ModuleGraph -> Map NodeKey (Set NodeKey)
mg_trans_deps :: Map.Map NodeKey (Set.Set NodeKey)
    -- A cached transitive dependency calculation so that a lot of work is not
    -- repeated whenever the transitive dependencies need to be calculated (for example, hptInstances)
  , ModuleGraph -> ModuleEnv ModSummary
mg_non_boot :: ModuleEnv ModSummary
    -- a map of all non-boot ModSummaries keyed by Modules
  }

-- | Map a function 'f' over all the 'ModSummaries'.
-- To preserve invariants 'f' can't change the isBoot status.
mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph
mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph
mapMG ModSummary -> ModSummary
f mg :: ModuleGraph
mg@ModuleGraph{[ModuleGraphNode]
Map NodeKey (Set NodeKey)
ModuleEnv ModSummary
mg_non_boot :: ModuleEnv ModSummary
mg_trans_deps :: Map NodeKey (Set NodeKey)
mg_mss :: [ModuleGraphNode]
mg_non_boot :: ModuleGraph -> ModuleEnv ModSummary
mg_trans_deps :: ModuleGraph -> Map NodeKey (Set NodeKey)
mg_mss :: ModuleGraph -> [ModuleGraphNode]
..} = ModuleGraph
mg
  { mg_mss :: [ModuleGraphNode]
mg_mss = ((ModuleGraphNode -> ModuleGraphNode)
 -> [ModuleGraphNode] -> [ModuleGraphNode])
-> [ModuleGraphNode]
-> (ModuleGraphNode -> ModuleGraphNode)
-> [ModuleGraphNode]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ModuleGraphNode -> ModuleGraphNode)
-> [ModuleGraphNode] -> [ModuleGraphNode]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ModuleGraphNode]
mg_mss ((ModuleGraphNode -> ModuleGraphNode) -> [ModuleGraphNode])
-> (ModuleGraphNode -> ModuleGraphNode) -> [ModuleGraphNode]
forall a b. (a -> b) -> a -> b
$ \case
      InstantiationNode UnitId
uid InstantiatedUnit
iuid -> UnitId -> InstantiatedUnit -> ModuleGraphNode
InstantiationNode UnitId
uid InstantiatedUnit
iuid
      LinkNode [NodeKey]
uid UnitId
nks -> [NodeKey] -> UnitId -> ModuleGraphNode
LinkNode [NodeKey]
uid UnitId
nks
      ModuleNode [NodeKey]
deps ModSummary
ms  -> [NodeKey] -> ModSummary -> ModuleGraphNode
ModuleNode [NodeKey]
deps (ModSummary -> ModSummary
f ModSummary
ms)
  , mg_non_boot :: ModuleEnv ModSummary
mg_non_boot = (ModSummary -> ModSummary)
-> ModuleEnv ModSummary -> ModuleEnv ModSummary
forall a b. (a -> b) -> ModuleEnv a -> ModuleEnv b
mapModuleEnv ModSummary -> ModSummary
f ModuleEnv ModSummary
mg_non_boot
  }

unionMG :: ModuleGraph -> ModuleGraph -> ModuleGraph
unionMG :: ModuleGraph -> ModuleGraph -> ModuleGraph
unionMG ModuleGraph
a ModuleGraph
b =
  let new_mss :: [ModuleGraphNode]
new_mss = (ModuleGraphNode -> ModuleGraphNode -> Ordering)
-> [ModuleGraphNode] -> [ModuleGraphNode]
forall a. (a -> a -> Ordering) -> [a] -> [a]
nubOrdBy ModuleGraphNode -> ModuleGraphNode -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([ModuleGraphNode] -> [ModuleGraphNode])
-> [ModuleGraphNode] -> [ModuleGraphNode]
forall a b. (a -> b) -> a -> b
$ ModuleGraph -> [ModuleGraphNode]
mg_mss ModuleGraph
a [ModuleGraphNode] -> [ModuleGraphNode] -> [ModuleGraphNode]
forall a. Monoid a => a -> a -> a
`mappend` ModuleGraph -> [ModuleGraphNode]
mg_mss ModuleGraph
b
  in ModuleGraph :: [ModuleGraphNode]
-> Map NodeKey (Set NodeKey) -> ModuleEnv ModSummary -> ModuleGraph
ModuleGraph {
        mg_mss :: [ModuleGraphNode]
mg_mss = [ModuleGraphNode]
new_mss
      , mg_trans_deps :: Map NodeKey (Set NodeKey)
mg_trans_deps = [ModuleGraphNode] -> Map NodeKey (Set NodeKey)
mkTransDeps [ModuleGraphNode]
new_mss
      , mg_non_boot :: ModuleEnv ModSummary
mg_non_boot = ModuleGraph -> ModuleEnv ModSummary
mg_non_boot ModuleGraph
a ModuleEnv ModSummary
-> ModuleEnv ModSummary -> ModuleEnv ModSummary
forall a. ModuleEnv a -> ModuleEnv a -> ModuleEnv a
`plusModuleEnv` ModuleGraph -> ModuleEnv ModSummary
mg_non_boot ModuleGraph
b
      }


mgTransDeps :: ModuleGraph -> Map.Map NodeKey (Set.Set NodeKey)
mgTransDeps :: ModuleGraph -> Map NodeKey (Set NodeKey)
mgTransDeps = ModuleGraph -> Map NodeKey (Set NodeKey)
mg_trans_deps

mgModSummaries :: ModuleGraph -> [ModSummary]
mgModSummaries :: ModuleGraph -> [ModSummary]
mgModSummaries ModuleGraph
mg = [ ModSummary
m | ModuleNode [NodeKey]
_ ModSummary
m <- ModuleGraph -> [ModuleGraphNode]
mgModSummaries' ModuleGraph
mg ]

mgModSummaries' :: ModuleGraph -> [ModuleGraphNode]
mgModSummaries' :: ModuleGraph -> [ModuleGraphNode]
mgModSummaries' = ModuleGraph -> [ModuleGraphNode]
mg_mss

-- | Look up a ModSummary in the ModuleGraph
mgLookupModule :: ModuleGraph -> Module -> Maybe ModSummary
mgLookupModule :: ModuleGraph -> GenModule Unit -> Maybe ModSummary
mgLookupModule ModuleGraph{[ModuleGraphNode]
Map NodeKey (Set NodeKey)
ModuleEnv ModSummary
mg_non_boot :: ModuleEnv ModSummary
mg_trans_deps :: Map NodeKey (Set NodeKey)
mg_mss :: [ModuleGraphNode]
mg_non_boot :: ModuleGraph -> ModuleEnv ModSummary
mg_trans_deps :: ModuleGraph -> Map NodeKey (Set NodeKey)
mg_mss :: ModuleGraph -> [ModuleGraphNode]
..} GenModule Unit
m = ModuleEnv ModSummary -> GenModule Unit -> Maybe ModSummary
forall a. ModuleEnv a -> GenModule Unit -> Maybe a
lookupModuleEnv ModuleEnv ModSummary
mg_non_boot GenModule Unit
m

emptyMG :: ModuleGraph
emptyMG :: ModuleGraph
emptyMG = [ModuleGraphNode]
-> Map NodeKey (Set NodeKey) -> ModuleEnv ModSummary -> ModuleGraph
ModuleGraph [] Map NodeKey (Set NodeKey)
forall k a. Map k a
Map.empty ModuleEnv ModSummary
forall a. ModuleEnv a
emptyModuleEnv

isTemplateHaskellOrQQNonBoot :: ModSummary -> Bool
isTemplateHaskellOrQQNonBoot :: ModSummary -> Bool
isTemplateHaskellOrQQNonBoot ModSummary
ms =
  (Extension -> DynFlags -> Bool
xopt Extension
LangExt.TemplateHaskell (ModSummary -> DynFlags
ms_hspp_opts ModSummary
ms)
    Bool -> Bool -> Bool
|| Extension -> DynFlags -> Bool
xopt Extension
LangExt.QuasiQuotes (ModSummary -> DynFlags
ms_hspp_opts ModSummary
ms)) Bool -> Bool -> Bool
&&
  (ModSummary -> IsBootInterface
isBootSummary ModSummary
ms IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
NotBoot)

-- | Add an ExtendedModSummary to ModuleGraph. Assumes that the new ModSummary is
-- not an element of the ModuleGraph.
extendMG :: ModuleGraph -> [NodeKey] -> ModSummary -> ModuleGraph
extendMG :: ModuleGraph -> [NodeKey] -> ModSummary -> ModuleGraph
extendMG ModuleGraph{[ModuleGraphNode]
Map NodeKey (Set NodeKey)
ModuleEnv ModSummary
mg_non_boot :: ModuleEnv ModSummary
mg_trans_deps :: Map NodeKey (Set NodeKey)
mg_mss :: [ModuleGraphNode]
mg_non_boot :: ModuleGraph -> ModuleEnv ModSummary
mg_trans_deps :: ModuleGraph -> Map NodeKey (Set NodeKey)
mg_mss :: ModuleGraph -> [ModuleGraphNode]
..} [NodeKey]
deps ModSummary
ms = ModuleGraph :: [ModuleGraphNode]
-> Map NodeKey (Set NodeKey) -> ModuleEnv ModSummary -> ModuleGraph
ModuleGraph
  { mg_mss :: [ModuleGraphNode]
mg_mss = [NodeKey] -> ModSummary -> ModuleGraphNode
ModuleNode [NodeKey]
deps ModSummary
ms ModuleGraphNode -> [ModuleGraphNode] -> [ModuleGraphNode]
forall a. a -> [a] -> [a]
: [ModuleGraphNode]
mg_mss
  , mg_trans_deps :: Map NodeKey (Set NodeKey)
mg_trans_deps = [ModuleGraphNode] -> Map NodeKey (Set NodeKey)
mkTransDeps ([NodeKey] -> ModSummary -> ModuleGraphNode
ModuleNode [NodeKey]
deps ModSummary
ms ModuleGraphNode -> [ModuleGraphNode] -> [ModuleGraphNode]
forall a. a -> [a] -> [a]
: [ModuleGraphNode]
mg_mss)
  , mg_non_boot :: ModuleEnv ModSummary
mg_non_boot = case ModSummary -> IsBootInterface
isBootSummary ModSummary
ms of
      IsBootInterface
IsBoot -> ModuleEnv ModSummary
mg_non_boot
      IsBootInterface
NotBoot -> ModuleEnv ModSummary
-> GenModule Unit -> ModSummary -> ModuleEnv ModSummary
forall a. ModuleEnv a -> GenModule Unit -> a -> ModuleEnv a
extendModuleEnv ModuleEnv ModSummary
mg_non_boot (ModSummary -> GenModule Unit
ms_mod ModSummary
ms) ModSummary
ms
  }

mkTransDeps :: [ModuleGraphNode] -> Map.Map NodeKey (Set.Set NodeKey)
mkTransDeps :: [ModuleGraphNode] -> Map NodeKey (Set NodeKey)
mkTransDeps [ModuleGraphNode]
mss =
  let (Graph SummaryNode
gg, NodeKey -> Maybe SummaryNode
_lookup_node) = Bool
-> [ModuleGraphNode]
-> (Graph SummaryNode, NodeKey -> Maybe SummaryNode)
moduleGraphNodes Bool
False [ModuleGraphNode]
mss
  in Graph SummaryNode
-> (SummaryNode -> NodeKey) -> Map NodeKey (Set NodeKey)
forall key node.
Ord key =>
Graph node -> (node -> key) -> Map key (Set key)
allReachable Graph SummaryNode
gg (ModuleGraphNode -> NodeKey
mkNodeKey (ModuleGraphNode -> NodeKey)
-> (SummaryNode -> ModuleGraphNode) -> SummaryNode -> NodeKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SummaryNode -> ModuleGraphNode
forall key payload. Node key payload -> payload
node_payload)

extendMGInst :: ModuleGraph -> UnitId -> InstantiatedUnit -> ModuleGraph
extendMGInst :: ModuleGraph -> UnitId -> InstantiatedUnit -> ModuleGraph
extendMGInst ModuleGraph
mg UnitId
uid InstantiatedUnit
depUnitId = ModuleGraph
mg
  { mg_mss :: [ModuleGraphNode]
mg_mss = UnitId -> InstantiatedUnit -> ModuleGraphNode
InstantiationNode UnitId
uid InstantiatedUnit
depUnitId ModuleGraphNode -> [ModuleGraphNode] -> [ModuleGraphNode]
forall a. a -> [a] -> [a]
: ModuleGraph -> [ModuleGraphNode]
mg_mss ModuleGraph
mg
  }

extendMGLink :: ModuleGraph -> UnitId -> [NodeKey] -> ModuleGraph
extendMGLink :: ModuleGraph -> UnitId -> [NodeKey] -> ModuleGraph
extendMGLink ModuleGraph
mg UnitId
uid [NodeKey]
nks = ModuleGraph
mg { mg_mss :: [ModuleGraphNode]
mg_mss = [NodeKey] -> UnitId -> ModuleGraphNode
LinkNode [NodeKey]
nks UnitId
uid ModuleGraphNode -> [ModuleGraphNode] -> [ModuleGraphNode]
forall a. a -> [a] -> [a]
: ModuleGraph -> [ModuleGraphNode]
mg_mss ModuleGraph
mg }

extendMG' :: ModuleGraph -> ModuleGraphNode -> ModuleGraph
extendMG' :: ModuleGraph -> ModuleGraphNode -> ModuleGraph
extendMG' ModuleGraph
mg = \case
  InstantiationNode UnitId
uid InstantiatedUnit
depUnitId -> ModuleGraph -> UnitId -> InstantiatedUnit -> ModuleGraph
extendMGInst ModuleGraph
mg UnitId
uid InstantiatedUnit
depUnitId
  ModuleNode [NodeKey]
deps ModSummary
ms -> ModuleGraph -> [NodeKey] -> ModSummary -> ModuleGraph
extendMG ModuleGraph
mg [NodeKey]
deps ModSummary
ms
  LinkNode [NodeKey]
deps UnitId
uid   -> ModuleGraph -> UnitId -> [NodeKey] -> ModuleGraph
extendMGLink ModuleGraph
mg UnitId
uid [NodeKey]
deps

mkModuleGraph :: [ModuleGraphNode] -> ModuleGraph
mkModuleGraph :: [ModuleGraphNode] -> ModuleGraph
mkModuleGraph = (ModuleGraphNode -> ModuleGraph -> ModuleGraph)
-> ModuleGraph -> [ModuleGraphNode] -> ModuleGraph
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((ModuleGraph -> ModuleGraphNode -> ModuleGraph)
-> ModuleGraphNode -> ModuleGraph -> ModuleGraph
forall a b c. (a -> b -> c) -> b -> a -> c
flip ModuleGraph -> ModuleGraphNode -> ModuleGraph
extendMG') ModuleGraph
emptyMG

-- | This function filters out all the instantiation nodes from each SCC of a
-- topological sort. Use this with care, as the resulting "strongly connected components"
-- may not really be strongly connected in a direct way, as instantiations have been
-- removed. It would probably be best to eliminate uses of this function where possible.
filterToposortToModules
  :: [SCC ModuleGraphNode] -> [SCC ModSummary]
filterToposortToModules :: [SCC ModuleGraphNode] -> [SCC ModSummary]
filterToposortToModules = (SCC ModuleGraphNode -> Maybe (SCC ModSummary))
-> [SCC ModuleGraphNode] -> [SCC ModSummary]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((SCC ModuleGraphNode -> Maybe (SCC ModSummary))
 -> [SCC ModuleGraphNode] -> [SCC ModSummary])
-> (SCC ModuleGraphNode -> Maybe (SCC ModSummary))
-> [SCC ModuleGraphNode]
-> [SCC ModSummary]
forall a b. (a -> b) -> a -> b
$ (ModuleGraphNode -> Maybe ModSummary)
-> SCC ModuleGraphNode -> Maybe (SCC ModSummary)
forall a b. (a -> Maybe b) -> SCC a -> Maybe (SCC b)
mapMaybeSCC ((ModuleGraphNode -> Maybe ModSummary)
 -> SCC ModuleGraphNode -> Maybe (SCC ModSummary))
-> (ModuleGraphNode -> Maybe ModSummary)
-> SCC ModuleGraphNode
-> Maybe (SCC ModSummary)
forall a b. (a -> b) -> a -> b
$ \case
  InstantiationNode UnitId
_ InstantiatedUnit
_ -> Maybe ModSummary
forall a. Maybe a
Nothing
  LinkNode{} -> Maybe ModSummary
forall a. Maybe a
Nothing
  ModuleNode [NodeKey]
_deps ModSummary
node -> ModSummary -> Maybe ModSummary
forall a. a -> Maybe a
Just ModSummary
node
  where
    -- This higher order function is somewhat bogus,
    -- as the definition of "strongly connected component"
    -- is not necessarily respected.
    mapMaybeSCC :: (a -> Maybe b) -> SCC a -> Maybe (SCC b)
    mapMaybeSCC :: (a -> Maybe b) -> SCC a -> Maybe (SCC b)
mapMaybeSCC a -> Maybe b
f = \case
      AcyclicSCC a
a -> b -> SCC b
forall vertex. vertex -> SCC vertex
AcyclicSCC (b -> SCC b) -> Maybe b -> Maybe (SCC b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe b
f a
a
      CyclicSCC [a]
as -> case (a -> Maybe b) -> [a] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
f [a]
as of
        [] -> Maybe (SCC b)
forall a. Maybe a
Nothing
        [b
a] -> SCC b -> Maybe (SCC b)
forall a. a -> Maybe a
Just (SCC b -> Maybe (SCC b)) -> SCC b -> Maybe (SCC b)
forall a b. (a -> b) -> a -> b
$ b -> SCC b
forall vertex. vertex -> SCC vertex
AcyclicSCC b
a
        [b]
as -> SCC b -> Maybe (SCC b)
forall a. a -> Maybe a
Just (SCC b -> Maybe (SCC b)) -> SCC b -> Maybe (SCC b)
forall a b. (a -> b) -> a -> b
$ [b] -> SCC b
forall vertex. [vertex] -> SCC vertex
CyclicSCC [b]
as

showModMsg :: DynFlags -> Bool -> ModuleGraphNode -> SDoc
showModMsg :: DynFlags -> Bool -> ModuleGraphNode -> SDoc
showModMsg DynFlags
dflags Bool
_ (LinkNode {}) =
      let staticLink :: Bool
staticLink = case DynFlags -> GhcLink
ghcLink DynFlags
dflags of
                          GhcLink
LinkStaticLib -> Bool
True
                          GhcLink
_ -> Bool
False

          platform :: Platform
platform  = DynFlags -> Platform
targetPlatform DynFlags
dflags
          exe_file :: String
exe_file  = Platform -> Bool -> Maybe String -> String
exeFileName Platform
platform Bool
staticLink (DynFlags -> Maybe String
outputFile_ DynFlags
dflags)
      in String -> SDoc
text String
exe_file
showModMsg DynFlags
_ Bool
_ (InstantiationNode UnitId
_uid InstantiatedUnit
indef_unit) =
  UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UnitId -> SDoc) -> UnitId -> SDoc
forall a b. (a -> b) -> a -> b
$ InstantiatedUnit -> UnitId
forall unit. GenInstantiatedUnit unit -> unit
instUnitInstanceOf InstantiatedUnit
indef_unit
showModMsg DynFlags
dflags Bool
recomp (ModuleNode [NodeKey]
_ ModSummary
mod_summary) =
  if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_HideSourcePaths DynFlags
dflags
      then String -> SDoc
text String
mod_str
      else [SDoc] -> SDoc
hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$
         [ String -> SDoc
text (String
mod_str String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
mod_str)) Char
' ')
         , Char -> SDoc
char Char
'('
         , String -> SDoc
text (String -> String
op (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ModSummary -> String
msHsFilePath ModSummary
mod_summary) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
','
         , SDoc
message, Char -> SDoc
char Char
')' ]

  where
    op :: String -> String
op       = String -> String
normalise
    mod :: ModuleName
mod      = GenModule Unit -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (ModSummary -> GenModule Unit
ms_mod ModSummary
mod_summary)
    mod_str :: String
mod_str  = DynFlags -> ModuleName -> String
forall a. Outputable a => DynFlags -> a -> String
showPpr DynFlags
dflags ModuleName
mod String -> String -> String
forall a. [a] -> [a] -> [a]
++ HscSource -> String
hscSourceString (ModSummary -> HscSource
ms_hsc_src ModSummary
mod_summary)
    dyn_file :: String
dyn_file = String -> String
op (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ModSummary -> String
msDynObjFilePath ModSummary
mod_summary
    obj_file :: String
obj_file = String -> String
op (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ModSummary -> String
msObjFilePath ModSummary
mod_summary
    message :: SDoc
message = case DynFlags -> Backend
backend DynFlags
dflags of
                Backend
Interpreter | Bool
recomp -> String -> SDoc
text String
"interpreted"
                Backend
NoBackend            -> String -> SDoc
text String
"nothing"
                Backend
_                    ->
                  if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_BuildDynamicToo  DynFlags
dflags
                    then String -> SDoc
text String
obj_file SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
dyn_file
                    else String -> SDoc
text String
obj_file



type SummaryNode = Node Int ModuleGraphNode

summaryNodeKey :: SummaryNode -> Int
summaryNodeKey :: SummaryNode -> Int
summaryNodeKey = SummaryNode -> Int
forall key payload. Node key payload -> key
node_key

summaryNodeSummary :: SummaryNode -> ModuleGraphNode
summaryNodeSummary :: SummaryNode -> ModuleGraphNode
summaryNodeSummary = SummaryNode -> ModuleGraphNode
forall key payload. Node key payload -> payload
node_payload

-- | Collect the immediate dependencies of a ModuleGraphNode,
-- optionally avoiding hs-boot dependencies.
-- If the drop_hs_boot_nodes flag is False, and if this is a .hs and there is
-- an equivalent .hs-boot, add a link from the former to the latter.  This
-- has the effect of detecting bogus cases where the .hs-boot depends on the
-- .hs, by introducing a cycle.  Additionally, it ensures that we will always
-- process the .hs-boot before the .hs, and so the HomePackageTable will always
-- have the most up to date information.
nodeDependencies :: Bool -> ModuleGraphNode -> [NodeKey]
nodeDependencies :: Bool -> ModuleGraphNode -> [NodeKey]
nodeDependencies Bool
drop_hs_boot_nodes = \case
    LinkNode [NodeKey]
deps UnitId
_uid -> [NodeKey]
deps
    InstantiationNode UnitId
uid InstantiatedUnit
iuid ->
      ModNodeKeyWithUid -> NodeKey
NodeKey_Module (ModNodeKeyWithUid -> NodeKey)
-> (ModuleName -> ModNodeKeyWithUid) -> ModuleName -> NodeKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\ModuleName
mod -> ModuleNameWithIsBoot -> UnitId -> ModNodeKeyWithUid
ModNodeKeyWithUid (ModuleName -> IsBootInterface -> ModuleNameWithIsBoot
forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
GWIB ModuleName
mod IsBootInterface
NotBoot) UnitId
uid)  (ModuleName -> NodeKey) -> [ModuleName] -> [NodeKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UniqDSet ModuleName -> [ModuleName]
forall a. UniqDSet a -> [a]
uniqDSetToList (InstantiatedUnit -> UniqDSet ModuleName
forall unit. GenInstantiatedUnit unit -> UniqDSet ModuleName
instUnitHoles InstantiatedUnit
iuid)
    ModuleNode [NodeKey]
deps ModSummary
_ms ->
      (NodeKey -> NodeKey) -> [NodeKey] -> [NodeKey]
forall a b. (a -> b) -> [a] -> [b]
map NodeKey -> NodeKey
drop_hs_boot [NodeKey]
deps
  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 :: NodeKey -> NodeKey
drop_hs_boot (NodeKey_Module (ModNodeKeyWithUid (GWIB ModuleName
mn IsBootInterface
IsBoot) UnitId
uid)) = (ModNodeKeyWithUid -> NodeKey
NodeKey_Module (ModuleNameWithIsBoot -> UnitId -> ModNodeKeyWithUid
ModNodeKeyWithUid (ModuleName -> IsBootInterface -> ModuleNameWithIsBoot
forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
GWIB ModuleName
mn IsBootInterface
hs_boot_key) UnitId
uid))
    drop_hs_boot NodeKey
x = NodeKey
x

-- | 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.
moduleGraphNodes :: Bool
  -> [ModuleGraphNode]
  -> (Graph SummaryNode, NodeKey -> Maybe SummaryNode)
moduleGraphNodes :: Bool
-> [ModuleGraphNode]
-> (Graph SummaryNode, NodeKey -> Maybe SummaryNode)
moduleGraphNodes Bool
drop_hs_boot_nodes [ModuleGraphNode]
summaries =
  ([SummaryNode] -> Graph SummaryNode
forall key payload.
Uniquable key =>
[Node key payload] -> Graph (Node key payload)
graphFromEdgedVerticesUniq [SummaryNode]
nodes, NodeKey -> Maybe SummaryNode
lookup_node)
  where
    -- Map from module to extra boot summary dependencies which need to be merged in
    (Map (GenModule Unit) [NodeKey]
boot_summaries, [SummaryNode]
nodes) = ([(GenModule Unit, [NodeKey])] -> Map (GenModule Unit) [NodeKey])
-> ([SummaryNode] -> [SummaryNode])
-> ([(GenModule Unit, [NodeKey])], [SummaryNode])
-> (Map (GenModule Unit) [NodeKey], [SummaryNode])
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [(GenModule Unit, [NodeKey])] -> Map (GenModule Unit) [NodeKey]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [SummaryNode] -> [SummaryNode]
forall a. a -> a
id (([(GenModule Unit, [NodeKey])], [SummaryNode])
 -> (Map (GenModule Unit) [NodeKey], [SummaryNode]))
-> ([(GenModule Unit, [NodeKey])], [SummaryNode])
-> (Map (GenModule Unit) [NodeKey], [SummaryNode])
forall a b. (a -> b) -> a -> b
$ [Either (GenModule Unit, [NodeKey]) SummaryNode]
-> ([(GenModule Unit, [NodeKey])], [SummaryNode])
forall a b. [Either a b] -> ([a], [b])
partitionEithers (((ModuleGraphNode, Int)
 -> Either (GenModule Unit, [NodeKey]) SummaryNode)
-> [(ModuleGraphNode, Int)]
-> [Either (GenModule Unit, [NodeKey]) SummaryNode]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleGraphNode, Int)
-> Either (GenModule Unit, [NodeKey]) SummaryNode
go [(ModuleGraphNode, Int)]
numbered_summaries)

      where
        go :: (ModuleGraphNode, Int)
-> Either (GenModule Unit, [NodeKey]) SummaryNode
go (ModuleGraphNode
s, Int
key) =
          case ModuleGraphNode
s of
                ModuleNode [NodeKey]
__deps ModSummary
ms | ModSummary -> IsBootInterface
isBootSummary ModSummary
ms IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot, Bool
drop_hs_boot_nodes
                  -- Using nodeDependencies here converts dependencies on other
                  -- boot files to dependencies on dependencies on non-boot files.
                  -> (GenModule Unit, [NodeKey])
-> Either (GenModule Unit, [NodeKey]) SummaryNode
forall a b. a -> Either a b
Left (ModSummary -> GenModule Unit
ms_mod ModSummary
ms, Bool -> ModuleGraphNode -> [NodeKey]
nodeDependencies Bool
drop_hs_boot_nodes ModuleGraphNode
s)
                ModuleGraphNode
_ -> Either (GenModule Unit, [NodeKey]) SummaryNode
normal_case
          where
           normal_case :: Either (GenModule Unit, [NodeKey]) SummaryNode
normal_case =
              let lkup_key :: Maybe (GenModule Unit)
lkup_key = ModSummary -> GenModule Unit
ms_mod (ModSummary -> GenModule Unit)
-> Maybe ModSummary -> Maybe (GenModule Unit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModuleGraphNode -> Maybe ModSummary
moduleGraphNodeModSum ModuleGraphNode
s
                  extra :: Maybe [NodeKey]
extra = (Maybe (GenModule Unit)
lkup_key Maybe (GenModule Unit)
-> (GenModule Unit -> Maybe [NodeKey]) -> Maybe [NodeKey]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \GenModule Unit
key -> GenModule Unit -> Map (GenModule Unit) [NodeKey] -> Maybe [NodeKey]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup GenModule Unit
key Map (GenModule Unit) [NodeKey]
boot_summaries)

              in SummaryNode -> Either (GenModule Unit, [NodeKey]) SummaryNode
forall a b. b -> Either a b
Right (SummaryNode -> Either (GenModule Unit, [NodeKey]) SummaryNode)
-> SummaryNode -> Either (GenModule Unit, [NodeKey]) SummaryNode
forall a b. (a -> b) -> a -> b
$ ModuleGraphNode -> Int -> [Int] -> SummaryNode
forall key payload. payload -> key -> [key] -> Node key payload
DigraphNode ModuleGraphNode
s Int
key ([Int] -> SummaryNode) -> [Int] -> SummaryNode
forall a b. (a -> b) -> a -> b
$ [NodeKey] -> [Int]
out_edge_keys ([NodeKey] -> [Int]) -> [NodeKey] -> [Int]
forall a b. (a -> b) -> a -> b
$
                      ([NodeKey] -> Maybe [NodeKey] -> [NodeKey]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [NodeKey]
extra
                        [NodeKey] -> [NodeKey] -> [NodeKey]
forall a. [a] -> [a] -> [a]
++ Bool -> ModuleGraphNode -> [NodeKey]
nodeDependencies Bool
drop_hs_boot_nodes ModuleGraphNode
s)

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

    lookup_node :: NodeKey -> Maybe SummaryNode
    lookup_node :: NodeKey -> Maybe SummaryNode
lookup_node NodeKey
key = NodeKey -> Map NodeKey SummaryNode -> Maybe SummaryNode
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NodeKey
key (NodeMap SummaryNode -> Map NodeKey SummaryNode
forall a. NodeMap a -> Map NodeKey a
unNodeMap NodeMap SummaryNode
node_map)

    lookup_key :: NodeKey -> Maybe Int
    lookup_key :: NodeKey -> Maybe Int
lookup_key = (SummaryNode -> Int) -> Maybe SummaryNode -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SummaryNode -> Int
summaryNodeKey (Maybe SummaryNode -> Maybe Int)
-> (NodeKey -> Maybe SummaryNode) -> NodeKey -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeKey -> Maybe SummaryNode
lookup_node

    node_map :: NodeMap SummaryNode
    node_map :: NodeMap SummaryNode
node_map = Map NodeKey SummaryNode -> NodeMap SummaryNode
forall a. Map NodeKey a -> NodeMap a
NodeMap (Map NodeKey SummaryNode -> NodeMap SummaryNode)
-> Map NodeKey SummaryNode -> NodeMap SummaryNode
forall a b. (a -> b) -> a -> b
$
      [(NodeKey, SummaryNode)] -> Map NodeKey SummaryNode
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (ModuleGraphNode -> NodeKey
mkNodeKey ModuleGraphNode
s, SummaryNode
node)
                   | SummaryNode
node <- [SummaryNode]
nodes
                   , let s :: ModuleGraphNode
s = SummaryNode -> ModuleGraphNode
summaryNodeSummary SummaryNode
node
                   ]

    out_edge_keys :: [NodeKey] -> [Int]
    out_edge_keys :: [NodeKey] -> [Int]
out_edge_keys = (NodeKey -> Maybe Int) -> [NodeKey] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe NodeKey -> Maybe Int
lookup_key
        -- If we want keep_hi_boot_nodes, then we do lookup_key with
        -- IsBoot; else False
newtype NodeMap a = NodeMap { NodeMap a -> Map NodeKey a
unNodeMap :: Map.Map NodeKey a }
  deriving (a -> NodeMap b -> NodeMap a
(a -> b) -> NodeMap a -> NodeMap b
(forall a b. (a -> b) -> NodeMap a -> NodeMap b)
-> (forall a b. a -> NodeMap b -> NodeMap a) -> Functor NodeMap
forall a b. a -> NodeMap b -> NodeMap a
forall a b. (a -> b) -> NodeMap a -> NodeMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> NodeMap b -> NodeMap a
$c<$ :: forall a b. a -> NodeMap b -> NodeMap a
fmap :: (a -> b) -> NodeMap a -> NodeMap b
$cfmap :: forall a b. (a -> b) -> NodeMap a -> NodeMap b
Functor, Functor NodeMap
Foldable NodeMap
Functor NodeMap
-> Foldable NodeMap
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> NodeMap a -> f (NodeMap b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    NodeMap (f a) -> f (NodeMap a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> NodeMap a -> m (NodeMap b))
-> (forall (m :: * -> *) a.
    Monad m =>
    NodeMap (m a) -> m (NodeMap a))
-> Traversable NodeMap
(a -> f b) -> NodeMap a -> f (NodeMap b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => NodeMap (m a) -> m (NodeMap a)
forall (f :: * -> *) a.
Applicative f =>
NodeMap (f a) -> f (NodeMap a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NodeMap a -> m (NodeMap b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NodeMap a -> f (NodeMap b)
sequence :: NodeMap (m a) -> m (NodeMap a)
$csequence :: forall (m :: * -> *) a. Monad m => NodeMap (m a) -> m (NodeMap a)
mapM :: (a -> m b) -> NodeMap a -> m (NodeMap b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NodeMap a -> m (NodeMap b)
sequenceA :: NodeMap (f a) -> f (NodeMap a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
NodeMap (f a) -> f (NodeMap a)
traverse :: (a -> f b) -> NodeMap a -> f (NodeMap b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NodeMap a -> f (NodeMap b)
$cp2Traversable :: Foldable NodeMap
$cp1Traversable :: Functor NodeMap
Traversable, NodeMap a -> Bool
(a -> m) -> NodeMap a -> m
(a -> b -> b) -> b -> NodeMap a -> b
(forall m. Monoid m => NodeMap m -> m)
-> (forall m a. Monoid m => (a -> m) -> NodeMap a -> m)
-> (forall m a. Monoid m => (a -> m) -> NodeMap a -> m)
-> (forall a b. (a -> b -> b) -> b -> NodeMap a -> b)
-> (forall a b. (a -> b -> b) -> b -> NodeMap a -> b)
-> (forall b a. (b -> a -> b) -> b -> NodeMap a -> b)
-> (forall b a. (b -> a -> b) -> b -> NodeMap a -> b)
-> (forall a. (a -> a -> a) -> NodeMap a -> a)
-> (forall a. (a -> a -> a) -> NodeMap a -> a)
-> (forall a. NodeMap a -> [a])
-> (forall a. NodeMap a -> Bool)
-> (forall a. NodeMap a -> Int)
-> (forall a. Eq a => a -> NodeMap a -> Bool)
-> (forall a. Ord a => NodeMap a -> a)
-> (forall a. Ord a => NodeMap a -> a)
-> (forall a. Num a => NodeMap a -> a)
-> (forall a. Num a => NodeMap a -> a)
-> Foldable NodeMap
forall a. Eq a => a -> NodeMap a -> Bool
forall a. Num a => NodeMap a -> a
forall a. Ord a => NodeMap a -> a
forall m. Monoid m => NodeMap m -> m
forall a. NodeMap a -> Bool
forall a. NodeMap a -> Int
forall a. NodeMap a -> [a]
forall a. (a -> a -> a) -> NodeMap a -> a
forall m a. Monoid m => (a -> m) -> NodeMap a -> m
forall b a. (b -> a -> b) -> b -> NodeMap a -> b
forall a b. (a -> b -> b) -> b -> NodeMap a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: NodeMap a -> a
$cproduct :: forall a. Num a => NodeMap a -> a
sum :: NodeMap a -> a
$csum :: forall a. Num a => NodeMap a -> a
minimum :: NodeMap a -> a
$cminimum :: forall a. Ord a => NodeMap a -> a
maximum :: NodeMap a -> a
$cmaximum :: forall a. Ord a => NodeMap a -> a
elem :: a -> NodeMap a -> Bool
$celem :: forall a. Eq a => a -> NodeMap a -> Bool
length :: NodeMap a -> Int
$clength :: forall a. NodeMap a -> Int
null :: NodeMap a -> Bool
$cnull :: forall a. NodeMap a -> Bool
toList :: NodeMap a -> [a]
$ctoList :: forall a. NodeMap a -> [a]
foldl1 :: (a -> a -> a) -> NodeMap a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> NodeMap a -> a
foldr1 :: (a -> a -> a) -> NodeMap a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> NodeMap a -> a
foldl' :: (b -> a -> b) -> b -> NodeMap a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> NodeMap a -> b
foldl :: (b -> a -> b) -> b -> NodeMap a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> NodeMap a -> b
foldr' :: (a -> b -> b) -> b -> NodeMap a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> NodeMap a -> b
foldr :: (a -> b -> b) -> b -> NodeMap a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> NodeMap a -> b
foldMap' :: (a -> m) -> NodeMap a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> NodeMap a -> m
foldMap :: (a -> m) -> NodeMap a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> NodeMap a -> m
fold :: NodeMap m -> m
$cfold :: forall m. Monoid m => NodeMap m -> m
Foldable)

mkNodeKey :: ModuleGraphNode -> NodeKey
mkNodeKey :: ModuleGraphNode -> NodeKey
mkNodeKey = \case
  InstantiationNode UnitId
_ InstantiatedUnit
iu -> InstantiatedUnit -> NodeKey
NodeKey_Unit InstantiatedUnit
iu
  ModuleNode [NodeKey]
_ ModSummary
x -> ModNodeKeyWithUid -> NodeKey
NodeKey_Module (ModNodeKeyWithUid -> NodeKey) -> ModNodeKeyWithUid -> NodeKey
forall a b. (a -> b) -> a -> b
$ ModSummary -> ModNodeKeyWithUid
msKey ModSummary
x
  LinkNode [NodeKey]
_ UnitId
uid   -> UnitId -> NodeKey
NodeKey_Link UnitId
uid

msKey :: ModSummary -> ModNodeKeyWithUid
msKey :: ModSummary -> ModNodeKeyWithUid
msKey ModSummary
ms = ModuleNameWithIsBoot -> UnitId -> ModNodeKeyWithUid
ModNodeKeyWithUid (ModSummary -> ModuleNameWithIsBoot
ms_mnwib ModSummary
ms) (ModSummary -> UnitId
ms_unitid ModSummary
ms)

type ModNodeKey = ModuleNameWithIsBoot