on ff8bb31 help sign in
hakyll/src/Hakyll/Core/DirectedGraph.hs
84 lines 2.6 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 , toList
8 , member
9 , nodes
10 , neighbours
11 , reverse
12 , reachableNodes
13 ) where
15import Prelude hiding (reverse)
16import Control.Arrow (second)
17import Data.Monoid (mconcat)
18import Data.Set (Set)
19import Data.Maybe (fromMaybe)
20import qualified Data.Map as M
21import qualified Data.Set as S
23import Hakyll.Core.DirectedGraph.Internal
25-- | Construction of directed graphs
26--
27fromList :: Ord a
28 => [(a, Set a)] -- ^ List of (node, reachable neighbours)
29 -> DirectedGraph a -- ^ Resulting directed graph
30fromList = DirectedGraph . M.fromList . map (\(t, d) -> (t, Node t d))
32-- | Deconstruction of directed graphs
33--
34toList :: DirectedGraph a
35 -> [(a, Set a)]
36toList = map (second nodeNeighbours) . M.toList . unDirectedGraph
38-- | Check if a node lies in the given graph
39--
40member :: Ord a
41 => a -- ^ Node to check for
42 -> DirectedGraph a -- ^ Directed graph to check in
43 -> Bool -- ^ If the node lies in the graph
44member n = M.member n . unDirectedGraph
46-- | Get all nodes in the graph
47--
48nodes :: Ord a
49 => DirectedGraph a -- ^ Graph to get the nodes from
50 -> Set a -- ^ All nodes in the graph
51nodes = M.keysSet . unDirectedGraph
53-- | Get a set of reachable neighbours from a directed graph
54--
55neighbours :: Ord a
56 => a -- ^ Node to get the neighbours of
57 -> DirectedGraph a -- ^ Graph to search in
58 -> Set a -- ^ Set containing the neighbours
59neighbours x = fromMaybe S.empty . fmap nodeNeighbours
60 . M.lookup x . unDirectedGraph
62-- | Reverse a directed graph (i.e. flip all edges)
63--
64reverse :: Ord a
65 => DirectedGraph a
66 -> DirectedGraph a
67reverse = mconcat . map reverse' . M.toList . unDirectedGraph
68 where
69 reverse' (id', Node _ neighbours') = fromList $
70 zip (S.toList neighbours') $ repeat $ S.singleton id'
72-- | Find all reachable nodes from a given set of nodes in the directed graph
73--
74reachableNodes :: Ord a => Set a -> DirectedGraph a -> Set a
75reachableNodes set graph = reachable (setNeighbours set) set
76 where
77 reachable next visited
78 | S.null next = visited
79 | otherwise = reachable (sanitize neighbours') (next `S.union` visited)
80 where
81 sanitize = S.filter (`S.notMember` visited)
82 neighbours' = setNeighbours (sanitize next)
84 setNeighbours = S.unions . map (`neighbours` graph) . S.toList