git.iko.soy/hakyll
on 9939708 help sign in
hakyll/src/Hakyll/Core/DirectedGraph/DependencySolver.hs
67 lines 2.7 kB history raw
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--
6module Hakyll.Core.DirectedGraph.DependencySolver
7 ( solveDependencies
8 ) where
10import Prelude
11import qualified Prelude as P
12import Data.Set (Set)
13import Data.Maybe (catMaybes)
14import qualified Data.Map as M
15import qualified Data.Set as S
17import Hakyll.Core.DirectedGraph
18import Hakyll.Core.DirectedGraph.Internal
20-- | Solve a dependency graph. This function returns an order to run the
21-- different nodes
22--
23solveDependencies :: Ord a
24 => DirectedGraph a -- ^ Graph
25 -> [a] -- ^ Resulting plan
26solveDependencies = P.reverse . order [] [] S.empty
28-- | Produce a reversed order using a stack
29--
30order :: Ord a
31 => [a] -- ^ Temporary result
32 -> [Node a] -- ^ Backtrace stack
33 -> Set a -- ^ Items in the stack
34 -> DirectedGraph a -- ^ Graph
35 -> [a] -- ^ Ordered result
36order temp stack set graph@(DirectedGraph graph')
37 -- Empty graph - return our current result
38 | M.null graph' = temp
39 | otherwise = case stack of
41 -- Empty stack - pick a node, and add it to the stack
42 [] ->
43 let (tag, node) = M.findMin graph'
44 in order temp (node : stack) (S.insert tag set) graph
46 -- At least one item on the stack - continue using this item
47 (node : stackTail) ->
48 -- Check which dependencies are still in the graph
49 let tag = nodeTag node
50 deps = S.toList $ nodeNeighbours node
51 unsatisfied = catMaybes $ map (flip M.lookup graph') deps
52 in case unsatisfied of
54 -- All dependencies for node are satisfied, we can return it and
55 -- remove it from the graph
56 [] -> order (tag : temp) stackTail (S.delete tag set)
57 (DirectedGraph $ M.delete tag graph')
59 -- There is at least one dependency left. We need to solve that
60 -- one first...
61 (dep : _) -> if (nodeTag dep) `S.member` set
62 -- The dependency is already in our stack - cycle detected!
63 then error "order: Cycle detected!" -- TODO: Dump cycle
64 -- Continue with the dependency
65 else order temp (dep : node : stackTail)
66 (S.insert (nodeTag dep) set)
67 graph