git.iko.soy/hakyll
on master help sign in
Add directed graph modules
ad67121Jasper Van der Jeugt
src/Hakyll/Core/DirectedGraph.hsnew file+87
compare with master
unifiedsplit
@@ -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+-}
src/Hakyll/Core/DirectedGraph/DependencySolver.hsnew file+68
@@ -0,0 +1,68 @@
1+-- | Given a dependency graph, this module provides a function that will
2+-- generate an order in which the graph can be visited, so that all the
3+-- dependencies of a given node have been visited before the node itself is
4+-- visited.
5+--
6+module Hakyll.Core.DirectedGraph.DependencySolver
7+ ( solveDependencies
8+ ) where
9+
10+import Prelude
11+import qualified Prelude as P
12+import Data.Set (Set)
13+import Data.Maybe (catMaybes)
14+import qualified Data.Map as M
15+import qualified Data.Set as S
16+
17+import Hakyll.Core.DirectedGraph
18+import qualified Hakyll.Core.DirectedGraph as DG
19+import Hakyll.Core.DirectedGraph.Internal
20+
21+-- | Solve a dependency graph. This function returns an order to run the
22+-- different nodes
23+--
24+solveDependencies :: Ord a
25+ => DirectedGraph a -- ^ Graph
26+ -> [a] -- ^ Resulting plan
27+solveDependencies = P.reverse . order [] [] S.empty
28+
29+-- | Produce a reversed order using a stack
30+--
31+order :: Ord a
32+ => [a] -- ^ Temporary result
33+ -> [Node a] -- ^ Backtrace stack
34+ -> Set a -- ^ Items in the stack
35+ -> DirectedGraph a -- ^ Graph
36+ -> [a] -- ^ Ordered result
37+order temp stack set graph@(DirectedGraph graph')
38+ -- Empty graph - return our current result
39+ | M.null graph' = temp
40+ | otherwise = case stack of
41+
42+ -- Empty stack - pick a node, and add it to the stack
43+ [] ->
44+ let (tag, node) = M.findMin graph'
45+ in order temp (node : stack) (S.insert tag set) graph
46+
47+ -- At least one item on the stack - continue using this item
48+ (node : stackTail) ->
49+ -- Check which dependencies are still in the graph
50+ let tag = nodeTag node
51+ deps = S.toList $ nodeNeighbours node
52+ unsatisfied = catMaybes $ map (flip M.lookup graph') deps
53+ in case unsatisfied of
54+
55+ -- All dependencies for node are satisfied, we can return it and
56+ -- remove it from the graph
57+ [] -> order (tag : temp) stackTail (S.delete tag set)
58+ (DG.filter (== tag) graph)
59+
60+ -- There is at least one dependency left. We need to solve that
61+ -- one first...
62+ (dep : _) -> if (nodeTag dep) `S.member` set
63+ -- The dependency is already in our stack - cycle detected!
64+ then error "order: Cycle detected!" -- TODO: Dump cycle
65+ -- Continue with the dependency
66+ else order temp (dep : node : stackTail)
67+ (S.insert (nodeTag dep) set)
68+ graph
src/Hakyll/Core/DirectedGraph/Internal.hsnew file+39
@@ -0,0 +1,39 @@
1+-- | Internal structure of the DirectedGraph type. Not exported in the library.
2+--
3+module Hakyll.Core.DirectedGraph.Internal
4+ ( Node (..)
5+ , DirectedGraph (..)
6+ ) where
7+
8+import Prelude hiding (reverse, filter)
9+import Data.Monoid (Monoid, mempty, mappend)
10+import Data.Set (Set)
11+import Data.Map (Map)
12+import qualified Data.Map as M
13+import qualified Data.Set as S
14+
15+-- | A node in the directed graph
16+--
17+data Node a = Node
18+ { nodeTag :: a -- ^ Tag identifying the node
19+ , nodeNeighbours :: (Set a) -- ^ Edges starting at this node
20+ } deriving (Show)
21+
22+-- | Append two nodes. Useful for joining graphs.
23+--
24+appendNodes :: Ord a => Node a -> Node a -> Node a
25+appendNodes (Node t1 n1) (Node t2 n2)
26+ | t1 /= t2 = error "appendNodes: Appending differently tagged nodes"
27+ | otherwise = Node t1 (n1 `S.union` n2)
28+
29+-- | Type used to represent a directed graph
30+--
31+newtype DirectedGraph a = DirectedGraph {unDirectedGraph :: Map a (Node a)}
32+ deriving (Show)
33+
34+-- | Allow users to concatenate different graphs
35+--
36+instance Ord a => Monoid (DirectedGraph a) where
37+ mempty = DirectedGraph M.empty
38+ mappend (DirectedGraph m1) (DirectedGraph m2) = DirectedGraph $
39+ M.unionWith appendNodes m1 m2
src/Hakyll/Core/DirectedGraph/ObsoleteFilter.hsnew file+25
@@ -0,0 +1,25 @@
1+-- | Module exporting a function that works as a filter on a dependency graph.
2+-- Given a list of obsolete nodes, this filter will reduce the graph so it only
3+-- contains obsolete nodes and nodes that depend (directly or indirectly) on
4+-- obsolete nodes.
5+--
6+module Hakyll.Core.DirectedGraph.ObsoleteFilter
7+ ( obsoleteFilter
8+ ) where
9+
10+import qualified Data.Set as S
11+
12+import Hakyll.Core.DirectedGraph
13+import qualified Hakyll.Core.DirectedGraph as DG
14+
15+-- | Given a list of obsolete items, filter the dependency graph so it only
16+-- contains these items
17+--
18+obsoleteFilter :: Ord a
19+ => [a] -- ^ List of obsolete items
20+ -> DirectedGraph a -- ^ Dependency graph
21+ -> DirectedGraph a -- ^ Resulting dependency graph
22+obsoleteFilter obsolete graph =
23+ let reversed = DG.reverse graph
24+ allObsolete = S.unions $ map (flip reachableNodes reversed) obsolete
25+ in DG.filter (`S.member` allObsolete) graph