on f104f91 help sign in
hakyll/src/Hakyll/Core/DirectedGraph.hs
85 lines 2.8 kB history raw
1-- | Representation of a directed graph. In Hakyll, this is used for dependency
2-- tracking.
3--
4module Hakyll.Core.DirectedGraph
5 ( DirectedGraph
6 , fromList
7 , member
8 , nodes
9 , neighbours
10 , reverse
11 , reachableNodes
12 , sanitize
13 ) where
15import Prelude hiding (reverse)
16import Data.Monoid (mconcat)
17import Data.Set (Set)
18import Data.Maybe (fromMaybe)
19import qualified Data.Map as M
20import qualified Data.Set as S
22import Hakyll.Core.DirectedGraph.Internal
24-- | Construction of directed graphs
25--
26fromList :: Ord a
27 => [(a, Set a)] -- ^ List of (node, reachable neighbours)
28 -> DirectedGraph a -- ^ Resulting directed graph
29fromList = DirectedGraph . M.fromList . map (\(t, d) -> (t, Node t d))
31-- | Check if a node lies in the given graph
32--
33member :: Ord a
34 => a -- ^ Node to check for
35 -> DirectedGraph a -- ^ Directed graph to check in
36 -> Bool -- ^ If the node lies in the graph
37member n = M.member n . unDirectedGraph
39-- | Get all nodes in the graph
40--
41nodes :: Ord a
42 => DirectedGraph a -- ^ Graph to get the nodes from
43 -> Set a -- ^ All nodes in the graph
44nodes = M.keysSet . unDirectedGraph
46-- | Get a set of reachable neighbours from a directed graph
47--
48neighbours :: Ord a
49 => a -- ^ Node to get the neighbours of
50 -> DirectedGraph a -- ^ Graph to search in
51 -> Set a -- ^ Set containing the neighbours
52neighbours x = fromMaybe S.empty . fmap nodeNeighbours
53 . M.lookup x . unDirectedGraph
55-- | Reverse a directed graph (i.e. flip all edges)
56--
57reverse :: Ord a
58 => DirectedGraph a
59 -> DirectedGraph a
60reverse = mconcat . map reverse' . M.toList . unDirectedGraph
61 where
62 reverse' (id', Node _ neighbours') = fromList $
63 zip (S.toList neighbours') $ repeat $ S.singleton id'
65-- | Find all reachable nodes from a given set of nodes in the directed graph
66--
67reachableNodes :: Ord a => Set a -> DirectedGraph a -> Set a
68reachableNodes set graph = reachable (setNeighbours set) set
69 where
70 reachable next visited
71 | S.null next = visited
72 | otherwise = reachable (sanitize' neighbours') (next `S.union` visited)
73 where
74 sanitize' = S.filter (`S.notMember` visited)
75 neighbours' = setNeighbours (sanitize' next)
77 setNeighbours = S.unions . map (`neighbours` graph) . S.toList
79-- | Remove all dangling pointers, i.e. references to notes that do
80-- not actually exist in the graph.
81--
82sanitize :: Ord a => DirectedGraph a -> DirectedGraph a
83sanitize (DirectedGraph graph) = DirectedGraph $ M.map sanitize' graph
84 where
85 sanitize' (Node t n) = Node t $ S.filter (`M.member` graph) n