1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
-- | Representation of a directed graph. In Hakyll, this is used for dependency
-- tracking.
--
module Hakyll.Core.DirectedGraph
( DirectedGraph
, fromList
, nodes
, neighbours
, reverse
, filter
, reachableNodes
) where
import Prelude hiding (reverse, filter)
import Data.Monoid (mconcat)
import Data.Set (Set)
import Data.Maybe (fromMaybe)
import qualified Data.Map as M
import qualified Data.Set as S
import Hakyll.Core.DirectedGraph.Internal
-- | Construction of directed graphs
--
fromList :: Ord a
=> [(a, Set a)] -- ^ List of (node, reachable neighbours)
-> DirectedGraph a -- ^ Resulting directed graph
fromList = DirectedGraph . M.fromList . map (\(t, d) -> (t, Node t d))
-- | Get all nodes in the graph
--
nodes :: Ord a
=> DirectedGraph a -- ^ Graph to get the nodes from
-> Set a -- ^ All nodes in the graph
nodes = M.keysSet . unDirectedGraph
-- | Get a set of reachable neighbours from a directed graph
--
neighbours :: Ord a
=> a -- ^ Node to get the neighbours of
-> DirectedGraph a -- ^ Graph to search in
-> Set a -- ^ Set containing the neighbours
neighbours x = fromMaybe S.empty . fmap nodeNeighbours
. M.lookup x . unDirectedGraph
-- | Reverse a directed graph (i.e. flip all edges)
--
reverse :: Ord a
=> DirectedGraph a
-> DirectedGraph a
reverse = mconcat . map reverse' . M.toList . unDirectedGraph
where
reverse' (id', Node _ neighbours') = fromList $
zip (S.toList neighbours') $ repeat $ S.singleton id'
-- | Filter a directed graph (i.e. remove nodes based on a predicate)
--
filter :: Ord a
=> (a -> Bool) -- ^ Predicate
-> DirectedGraph a -- ^ Graph
-> DirectedGraph a -- ^ Resulting graph
filter predicate =
DirectedGraph . M.filterWithKey (\k _ -> predicate k) . unDirectedGraph
-- | Find all reachable nodes from a given node in the directed graph
--
reachableNodes :: Ord a => a -> DirectedGraph a -> Set a
reachableNodes x graph = reachable (neighbours x graph) (S.singleton x)
where
reachable next visited
| S.null next = visited
| otherwise = reachable (sanitize neighbours') (next `S.union` visited)
where
sanitize = S.filter (`S.notMember` visited)
neighbours' = S.unions $ map (flip neighbours graph)
$ S.toList $ sanitize next
|
