-- (c) 2000 - 2005 by Martin Erwig [see file COPYRIGHT]

-- | Depth-first search algorithms.
--
-- Names consist of:
--
--   1. An optional direction parameter, specifying which nodes to visit next.
--
--      [@u@] undirectional: ignore edge direction
--      [@r@] reversed: walk edges in reverse
--      [@x@] user defined: speciy which paths to follow
--
--   2. "df" for depth-first
--   3. A structure parameter, specifying the type of the result.
--
--       [@s@] Flat list of results
--       [@f@] Structured 'Tree' of results
--
--   4. An optional \"With\", which instead of putting the found nodes directly
--      into the result, adds the result of a computation on them into it.
--   5. An optional prime character, in which case all nodes of the graph will
--      be visited, instead of a user-given subset.
module Data.Graph.Inductive.Query.DFS (

    CFun,

    -- * Standard
    dfs, dfs', dff, dff',
    dfsWith,  dfsWith', dffWith, dffWith',
    xdfsWith, xdfWith, xdffWith,

    -- * Undirected
    udfs, udfs', udff, udff',
    udffWith, udffWith',

    -- * Reversed
    rdff, rdff', rdfs, rdfs',
    rdffWith, rdffWith',

    -- * Applications of depth first search/forest
    topsort, topsort', scc, reachable,

    -- * Applications of undirected depth first search/forest
    components, noComponents, isConnected, condensation

) where

import Data.Graph.Inductive.Basic
import Data.Graph.Inductive.Graph
import Data.Tree
import qualified Data.Map as Map
import Control.Monad (liftM2)
import Data.Tuple (swap)


-- | Many functions take a list of nodes to visit as an explicit argument.
--   fixNodes is a convenience function that adds all the nodes present in a
--   graph as that list.
fixNodes :: (Graph gr) => ([Node] -> gr a b -> c) -> gr a b -> c
fixNodes :: ([Node] -> gr a b -> c) -> gr a b -> c
fixNodes [Node] -> gr a b -> c
f gr a b
g = [Node] -> gr a b -> c
f (gr a b -> [Node]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Node]
nodes gr a b
g) gr a b
g


type CFun a b c = Context a b -> c

-- | Most general DFS algorithm to create a list of results. The other
--   list-returning functions such as 'dfs' are all defined in terms of this
--   one.
--
-- @
-- 'xdfsWith' d f vs = 'preorderF' . 'xdffWith' d f vs
-- @
xdfsWith :: (Graph gr)
    => CFun a b [Node] -- ^ Mapping from a node to its neighbours to be visited
                       --   as well. 'suc'' for example makes 'xdfsWith'
                       --   traverse the graph following the edge directions,
                       --   while 'pre'' means reversed directions.
    -> CFun a b c      -- ^ Mapping from the 'Context' of a node to a result
                       --   value.
    -> [Node]          -- ^ Nodes to be visited.
    -> gr a b
    -> [c]
xdfsWith :: CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [c]
xdfsWith CFun a b [Node]
_ CFun a b c
_ []     gr a b
_             = []
xdfsWith CFun a b [Node]
_ CFun a b c
_ [Node]
_      gr a b
g | gr a b -> Bool
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty gr a b
g = []
xdfsWith CFun a b [Node]
d CFun a b c
f (Node
v:[Node]
vs) gr a b
g = case Node -> gr a b -> Decomp gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> Decomp gr a b
match Node
v gr a b
g of
                         (Just Context a b
c,gr a b
g')  -> CFun a b c
f Context a b
cc -> [c] -> [c]
forall a. a -> [a] -> [a]
:CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [c]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [c]
xdfsWith CFun a b [Node]
d CFun a b c
f (CFun a b [Node]
d Context a b
c[Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++[Node]
vs) gr a b
g'
                         (Maybe (Context a b)
Nothing,gr a b
g') -> CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [c]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [c]
xdfsWith CFun a b [Node]
d CFun a b c
f [Node]
vs gr a b
g'


-- | Depth-first search.
dfs :: (Graph gr) => [Node] -> gr a b -> [Node]
dfs :: [Node] -> gr a b -> [Node]
dfs = CFun a b Node -> [Node] -> gr a b -> [Node]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> [Node] -> gr a b -> [c]
dfsWith CFun a b Node
forall a b. Context a b -> Node
node'

dfsWith :: (Graph gr) => CFun a b c -> [Node] -> gr a b -> [c]
dfsWith :: CFun a b c -> [Node] -> gr a b -> [c]
dfsWith = CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [c]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [c]
xdfsWith CFun a b [Node]
forall a b. Context a b -> [Node]
suc'

dfsWith' :: (Graph gr) => CFun a b c -> gr a b -> [c]
dfsWith' :: CFun a b c -> gr a b -> [c]
dfsWith' CFun a b c
f = ([Node] -> gr a b -> [c]) -> gr a b -> [c]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
([Node] -> gr a b -> c) -> gr a b -> c
fixNodes (CFun a b c -> [Node] -> gr a b -> [c]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> [Node] -> gr a b -> [c]
dfsWith CFun a b c
f)

dfs' :: (Graph gr) => gr a b -> [Node]
dfs' :: gr a b -> [Node]
dfs' = CFun a b Node -> gr a b -> [Node]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> gr a b -> [c]
dfsWith' CFun a b Node
forall a b. Context a b -> Node
node'


-- | Undirected depth-first search, obtained by following edges regardless
--   of their direction.
udfs :: (Graph gr) => [Node] -> gr a b -> [Node]
udfs :: [Node] -> gr a b -> [Node]
udfs = CFun a b [Node] -> CFun a b Node -> [Node] -> gr a b -> [Node]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [c]
xdfsWith CFun a b [Node]
forall a b. Context a b -> [Node]
neighbors' CFun a b Node
forall a b. Context a b -> Node
node'

udfs' :: (Graph gr) => gr a b -> [Node]
udfs' :: gr a b -> [Node]
udfs' = ([Node] -> gr a b -> [Node]) -> gr a b -> [Node]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
([Node] -> gr a b -> c) -> gr a b -> c
fixNodes [Node] -> gr a b -> [Node]
forall (gr :: * -> * -> *) a b.
Graph gr =>
[Node] -> gr a b -> [Node]
udfs


-- | Reverse depth-first search, obtained by following predecessors.
rdfs :: (Graph gr) => [Node] -> gr a b -> [Node]
rdfs :: [Node] -> gr a b -> [Node]
rdfs = CFun a b [Node] -> CFun a b Node -> [Node] -> gr a b -> [Node]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [c]
xdfsWith CFun a b [Node]
forall a b. Context a b -> [Node]
pre' CFun a b Node
forall a b. Context a b -> Node
node'

rdfs' :: (Graph gr) => gr a b -> [Node]
rdfs' :: gr a b -> [Node]
rdfs' = ([Node] -> gr a b -> [Node]) -> gr a b -> [Node]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
([Node] -> gr a b -> c) -> gr a b -> c
fixNodes [Node] -> gr a b -> [Node]
forall (gr :: * -> * -> *) a b.
Graph gr =>
[Node] -> gr a b -> [Node]
rdfs


-- | Most general DFS algorithm to create a forest of results, otherwise very
--   similar to 'xdfsWith'. The other forest-returning functions such as 'dff'
--   are all defined in terms of this one.
xdfWith :: (Graph gr)
    => CFun a b [Node]
    -> CFun a b c
    -> [Node]
    -> gr a b
    -> ([Tree c],gr a b)
xdfWith :: CFun a b [Node]
-> CFun a b c -> [Node] -> gr a b -> ([Tree c], gr a b)
xdfWith CFun a b [Node]
_ CFun a b c
_ []     gr a b
g             = ([],gr a b
g)
xdfWith CFun a b [Node]
_ CFun a b c
_ [Node]
_      gr a b
g | gr a b -> Bool
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty gr a b
g = ([],gr a b
g)
xdfWith CFun a b [Node]
d CFun a b c
f (Node
v:[Node]
vs) gr a b
g = case Node -> gr a b -> Decomp gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> Decomp gr a b
match Node
v gr a b
g of
                        (Maybe (Context a b)
Nothing,gr a b
g1) -> CFun a b [Node]
-> CFun a b c -> [Node] -> gr a b -> ([Tree c], gr a b)
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node]
-> CFun a b c -> [Node] -> gr a b -> ([Tree c], gr a b)
xdfWith CFun a b [Node]
d CFun a b c
f [Node]
vs gr a b
g1
                        (Just Context a b
c,gr a b
g1)  -> (c -> [Tree c] -> Tree c
forall a. a -> Forest a -> Tree a
Node (CFun a b c
f Context a b
c) [Tree c]
tsTree c -> [Tree c] -> [Tree c]
forall a. a -> [a] -> [a]
:[Tree c]
ts',gr a b
g3)
                                 where ([Tree c]
ts,gr a b
g2)  = CFun a b [Node]
-> CFun a b c -> [Node] -> gr a b -> ([Tree c], gr a b)
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node]
-> CFun a b c -> [Node] -> gr a b -> ([Tree c], gr a b)
xdfWith CFun a b [Node]
d CFun a b c
f (CFun a b [Node]
d Context a b
c) gr a b
g1
                                       ([Tree c]
ts',gr a b
g3) = CFun a b [Node]
-> CFun a b c -> [Node] -> gr a b -> ([Tree c], gr a b)
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node]
-> CFun a b c -> [Node] -> gr a b -> ([Tree c], gr a b)
xdfWith CFun a b [Node]
d CFun a b c
f [Node]
vs gr a b
g2

-- | Discard the graph part of the result of 'xdfWith'.
--
-- @
-- xdffWith d f vs g = fst (xdfWith d f vs g)
-- @
xdffWith :: (Graph gr)
    => CFun a b [Node]
    -> CFun a b c
    -> [Node]
    -> gr a b
    -> [Tree c]
xdffWith :: CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [Tree c]
xdffWith CFun a b [Node]
d CFun a b c
f [Node]
vs gr a b
g = ([Tree c], gr a b) -> [Tree c]
forall a b. (a, b) -> a
fst (CFun a b [Node]
-> CFun a b c -> [Node] -> gr a b -> ([Tree c], gr a b)
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node]
-> CFun a b c -> [Node] -> gr a b -> ([Tree c], gr a b)
xdfWith CFun a b [Node]
d CFun a b c
f [Node]
vs gr a b
g)



-- | Directed depth-first forest.
dff :: (Graph gr) => [Node] -> gr a b -> [Tree Node]
dff :: [Node] -> gr a b -> [Tree Node]
dff = CFun a b Node -> [Node] -> gr a b -> [Tree Node]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> [Node] -> gr a b -> [Tree c]
dffWith CFun a b Node
forall a b. Context a b -> Node
node'

dffWith :: (Graph gr) => CFun a b c -> [Node] -> gr a b -> [Tree c]
dffWith :: CFun a b c -> [Node] -> gr a b -> [Tree c]
dffWith = CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [Tree c]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [Tree c]
xdffWith CFun a b [Node]
forall a b. Context a b -> [Node]
suc'

dffWith' :: (Graph gr) => CFun a b c -> gr a b -> [Tree c]
dffWith' :: CFun a b c -> gr a b -> [Tree c]
dffWith' CFun a b c
f = ([Node] -> gr a b -> [Tree c]) -> gr a b -> [Tree c]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
([Node] -> gr a b -> c) -> gr a b -> c
fixNodes (CFun a b c -> [Node] -> gr a b -> [Tree c]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> [Node] -> gr a b -> [Tree c]
dffWith CFun a b c
f)

dff' :: (Graph gr) => gr a b -> [Tree Node]
dff' :: gr a b -> [Tree Node]
dff' = CFun a b Node -> gr a b -> [Tree Node]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> gr a b -> [Tree c]
dffWith' CFun a b Node
forall a b. Context a b -> Node
node'



-- | Undirected depth-first forest, obtained by following edges regardless
--   of their direction.
udff :: (Graph gr) => [Node] -> gr a b -> [Tree Node]
udff :: [Node] -> gr a b -> [Tree Node]
udff = CFun a b Node -> [Node] -> gr a b -> [Tree Node]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> [Node] -> gr a b -> [Tree c]
udffWith CFun a b Node
forall a b. Context a b -> Node
node'

udffWith :: (Graph gr) => CFun a b c -> [Node] -> gr a b -> [Tree c]
udffWith :: CFun a b c -> [Node] -> gr a b -> [Tree c]
udffWith = CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [Tree c]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [Tree c]
xdffWith CFun a b [Node]
forall a b. Context a b -> [Node]
neighbors'

udffWith' :: (Graph gr) => CFun a b c -> gr a b -> [Tree c]
udffWith' :: CFun a b c -> gr a b -> [Tree c]
udffWith' CFun a b c
f = ([Node] -> gr a b -> [Tree c]) -> gr a b -> [Tree c]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
([Node] -> gr a b -> c) -> gr a b -> c
fixNodes (CFun a b c -> [Node] -> gr a b -> [Tree c]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> [Node] -> gr a b -> [Tree c]
udffWith CFun a b c
f)

udff' :: (Graph gr) => gr a b -> [Tree Node]
udff' :: gr a b -> [Tree Node]
udff' = CFun a b Node -> gr a b -> [Tree Node]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> gr a b -> [Tree c]
udffWith' CFun a b Node
forall a b. Context a b -> Node
node'


-- | Reverse depth-first forest, obtained by following predecessors.
rdff :: (Graph gr) => [Node] -> gr a b -> [Tree Node]
rdff :: [Node] -> gr a b -> [Tree Node]
rdff = CFun a b Node -> [Node] -> gr a b -> [Tree Node]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> [Node] -> gr a b -> [Tree c]
rdffWith CFun a b Node
forall a b. Context a b -> Node
node'

rdffWith :: (Graph gr) => CFun a b c -> [Node] -> gr a b -> [Tree c]
rdffWith :: CFun a b c -> [Node] -> gr a b -> [Tree c]
rdffWith = CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [Tree c]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [Tree c]
xdffWith CFun a b [Node]
forall a b. Context a b -> [Node]
pre'

rdffWith' :: (Graph gr) => CFun a b c -> gr a b -> [Tree c]
rdffWith' :: CFun a b c -> gr a b -> [Tree c]
rdffWith' CFun a b c
f = ([Node] -> gr a b -> [Tree c]) -> gr a b -> [Tree c]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
([Node] -> gr a b -> c) -> gr a b -> c
fixNodes (CFun a b c -> [Node] -> gr a b -> [Tree c]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> [Node] -> gr a b -> [Tree c]
rdffWith CFun a b c
f)

rdff' :: (Graph gr) => gr a b -> [Tree Node]
rdff' :: gr a b -> [Tree Node]
rdff' = CFun a b Node -> gr a b -> [Tree Node]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> gr a b -> [Tree c]
rdffWith' CFun a b Node
forall a b. Context a b -> Node
node'


----------------------------------------------------------------------
-- ALGORITHMS BASED ON DFS
----------------------------------------------------------------------

-- | Collection of connected components
components :: (Graph gr) => gr a b -> [[Node]]
components :: gr a b -> [[Node]]
components = (Tree Node -> [Node]) -> [Tree Node] -> [[Node]]
forall a b. (a -> b) -> [a] -> [b]
map Tree Node -> [Node]
forall a. Tree a -> [a]
preorder ([Tree Node] -> [[Node]])
-> (gr a b -> [Tree Node]) -> gr a b -> [[Node]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. gr a b -> [Tree Node]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Tree Node]
udff'

-- | Number of connected components
noComponents :: (Graph gr) => gr a b -> Int
noComponents :: gr a b -> Node
noComponents = [[Node]] -> Node
forall (t :: * -> *) a. Foldable t => t a -> Node
length ([[Node]] -> Node) -> (gr a b -> [[Node]]) -> gr a b -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. gr a b -> [[Node]]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [[Node]]
components

-- | Is the graph connected?
isConnected :: (Graph gr) => gr a b -> Bool
isConnected :: gr a b -> Bool
isConnected = (Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
==Node
1) (Node -> Bool) -> (gr a b -> Node) -> gr a b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. gr a b -> Node
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Node
noComponents

-- | Flatten a 'Tree' in reverse order
postflatten :: Tree a -> [a]
postflatten :: Tree a -> [a]
postflatten (Node a
v Forest a
ts) = Forest a -> [a]
forall a. [Tree a] -> [a]
postflattenF Forest a
ts [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
v]

-- | Flatten a forest in reverse order
postflattenF :: [Tree a] -> [a]
postflattenF :: [Tree a] -> [a]
postflattenF = (Tree a -> [a]) -> [Tree a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree a -> [a]
forall a. Tree a -> [a]
postflatten

-- | <http://en.wikipedia.org/wiki/Topological_sorting Topological sorting>,
--   i.e. a list of 'Node's so that if there's an edge between a source and a
--   target node, the source appears earlier in the result.
topsort :: (Graph gr) => gr a b -> [Node]
topsort :: gr a b -> [Node]
topsort = [Node] -> [Node]
forall a. [a] -> [a]
reverse ([Node] -> [Node]) -> (gr a b -> [Node]) -> gr a b -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tree Node] -> [Node]
forall a. [Tree a] -> [a]
postflattenF ([Tree Node] -> [Node])
-> (gr a b -> [Tree Node]) -> gr a b -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. gr a b -> [Tree Node]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Tree Node]
dff'

-- | 'topsort', returning only the labels of the nodes.
topsort' :: (Graph gr) => gr a b -> [a]
topsort' :: gr a b -> [a]
topsort' = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> (gr a b -> [a]) -> gr a b -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tree a] -> [a]
forall a. [Tree a] -> [a]
postorderF ([Tree a] -> [a]) -> (gr a b -> [Tree a]) -> gr a b -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFun a b a -> gr a b -> [Tree a]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> gr a b -> [Tree c]
dffWith' CFun a b a
forall a b. Context a b -> a
lab'

-- | Collection of strongly connected components
scc :: (Graph gr) => gr a b -> [[Node]]
scc :: gr a b -> [[Node]]
scc gr a b
g = (Tree Node -> [Node]) -> [Tree Node] -> [[Node]]
forall a b. (a -> b) -> [a] -> [b]
map Tree Node -> [Node]
forall a. Tree a -> [a]
preorder ([Node] -> gr a b -> [Tree Node]
forall (gr :: * -> * -> *) a b.
Graph gr =>
[Node] -> gr a b -> [Tree Node]
rdff (gr a b -> [Node]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Node]
topsort gr a b
g) gr a b
g)

-- | Collection of nodes reachable from a starting point.
reachable :: (Graph gr) => Node -> gr a b -> [Node]
reachable :: Node -> gr a b -> [Node]
reachable Node
v gr a b
g = [Tree Node] -> [Node]
forall a. [Tree a] -> [a]
preorderF ([Node] -> gr a b -> [Tree Node]
forall (gr :: * -> * -> *) a b.
Graph gr =>
[Node] -> gr a b -> [Tree Node]
dff [Node
v] gr a b
g)

-- | The condensation of the given graph, i.e., the graph of its
-- strongly connected components.
condensation :: Graph gr => gr a b -> gr [Node] ()
condensation :: gr a b -> gr [Node] ()
condensation gr a b
gr = [LNode [Node]] -> [LEdge ()] -> gr [Node] ()
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph [LNode [Node]]
vs [LEdge ()]
es
  where
    sccs :: [[Node]]
sccs = gr a b -> [[Node]]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [[Node]]
scc gr a b
gr
    vs :: [LNode [Node]]
vs = [Node] -> [[Node]] -> [LNode [Node]]
forall a b. [a] -> [b] -> [(a, b)]
zip [Node
1..] [[Node]]
sccs
    vMap :: Map [Node] Node
vMap = [([Node], Node)] -> Map [Node] Node
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([([Node], Node)] -> Map [Node] Node)
-> [([Node], Node)] -> Map [Node] Node
forall a b. (a -> b) -> a -> b
$ (LNode [Node] -> ([Node], Node))
-> [LNode [Node]] -> [([Node], Node)]
forall a b. (a -> b) -> [a] -> [b]
map LNode [Node] -> ([Node], Node)
forall a b. (a, b) -> (b, a)
swap [LNode [Node]]
vs

    getN :: [Node] -> Node
getN = (Map [Node] Node
vMap Map [Node] Node -> [Node] -> Node
forall k a. Ord k => Map k a -> k -> a
Map.!)
    es :: [LEdge ()]
es = [ ([Node] -> Node
getN [Node]
c1, [Node] -> Node
getN [Node]
c2, ()) | [Node]
c1 <- [[Node]]
sccs, [Node]
c2 <- [[Node]]
sccs
                                  , ([Node]
c1 [Node] -> [Node] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Node]
c2) Bool -> Bool -> Bool
&& (Edge -> Bool) -> [Edge] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (gr a b -> Edge -> Bool
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Edge -> Bool
hasEdge gr a b
gr) ((Node -> Node -> Edge) -> [Node] -> [Node] -> [Edge]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) [Node]
c1 [Node]
c2) ]