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

module GHC.Unit.Module.Graph
   ( ModuleGraph
   , ModuleGraphNode(..)
   , nodeDependencies
   , emptyMG
   , mkModuleGraph
   , extendMG
   , extendMGInst
   , extendMG'
   , 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, HscSource (HsBootFile) )

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

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

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
  }

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 = Map NodeKey (Set NodeKey)
td
  , 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
  }
  where
    (Graph SummaryNode
gg, NodeKey -> Maybe SummaryNode
_lookup_node) = Bool
-> [ModuleGraphNode]
-> (Graph SummaryNode, NodeKey -> Maybe SummaryNode)
moduleGraphNodes Bool
False ([NodeKey] -> ModSummary -> ModuleGraphNode
ModuleNode [NodeKey]
deps ModSummary
ms ModuleGraphNode -> [ModuleGraphNode] -> [ModuleGraphNode]
forall a. a -> [a] -> [a]
: [ModuleGraphNode]
mg_mss)
    td :: Map NodeKey (Set NodeKey)
td = 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 ->
      [ ModNodeKeyWithUid -> NodeKey
NodeKey_Module (ModNodeKeyWithUid -> NodeKey) -> ModNodeKeyWithUid -> NodeKey
forall a b. (a -> b) -> a -> b
$ (ModuleNameWithIsBoot -> UnitId -> ModNodeKeyWithUid
ModNodeKeyWithUid (ModuleName -> IsBootInterface -> ModuleNameWithIsBoot
forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
GWIB (ModSummary -> ModuleName
ms_mod_name ModSummary
ms) IsBootInterface
IsBoot) (ModSummary -> UnitId
ms_unitid ModSummary
ms))
      | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool
drop_hs_boot_nodes Bool -> Bool -> Bool
|| ModSummary -> HscSource
ms_hsc_src ModSummary
ms HscSource -> HscSource -> Bool
forall a. Eq a => a -> a -> Bool
== HscSource
HsBootFile
      ] [NodeKey] -> [NodeKey] -> [NodeKey]
forall a. [a] -> [a] -> [a]
++ (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

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
    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
                   ]

    -- We use integers as the keys for the SCC algorithm
    nodes :: [SummaryNode]
    nodes :: [SummaryNode]
nodes = [ 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
$ Bool -> ModuleGraphNode -> [NodeKey]
nodeDependencies Bool
drop_hs_boot_nodes ModuleGraphNode
s
            | (ModuleGraphNode
s, Int
key) <- [(ModuleGraphNode, Int)]
numbered_summaries
             -- Drop the hi-boot ones if told to do so
            , case ModuleGraphNode
s of
                InstantiationNode {} -> Bool
True
                LinkNode {} -> Bool
True
                ModuleNode [NodeKey]
_ ModSummary
ms -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ModSummary -> IsBootInterface
isBootSummary ModSummary
ms IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot Bool -> Bool -> Bool
&& Bool
drop_hs_boot_nodes
            ]

    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