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