diff options
author | Jasper Van der Jeugt <jaspervdj@gmail.com> | 2010-12-23 14:31:45 +0100 |
---|---|---|
committer | Jasper Van der Jeugt <jaspervdj@gmail.com> | 2010-12-23 14:31:45 +0100 |
commit | ad6712121ffc3e41f6bd2a9833267252315b6f65 (patch) | |
tree | a34e2bb9bf726aec69e5362d1d443ff62460b04e /src/Hakyll/Core/DirectedGraph/DependencySolver.hs | |
parent | 9b63052148a140b8ad5fc04b996023d8b8e3796d (diff) | |
download | hakyll-ad6712121ffc3e41f6bd2a9833267252315b6f65.tar.gz |
Add directed graph modules
Diffstat (limited to 'src/Hakyll/Core/DirectedGraph/DependencySolver.hs')
-rw-r--r-- | src/Hakyll/Core/DirectedGraph/DependencySolver.hs | 68 |
1 files changed, 68 insertions, 0 deletions
diff --git a/src/Hakyll/Core/DirectedGraph/DependencySolver.hs b/src/Hakyll/Core/DirectedGraph/DependencySolver.hs new file mode 100644 index 0000000..dce59e0 --- /dev/null +++ b/src/Hakyll/Core/DirectedGraph/DependencySolver.hs @@ -0,0 +1,68 @@ +-- | Given a dependency graph, this module provides a function that will +-- generate an order in which the graph can be visited, so that all the +-- dependencies of a given node have been visited before the node itself is +-- visited. +-- +module Hakyll.Core.DirectedGraph.DependencySolver + ( solveDependencies + ) where + +import Prelude +import qualified Prelude as P +import Data.Set (Set) +import Data.Maybe (catMaybes) +import qualified Data.Map as M +import qualified Data.Set as S + +import Hakyll.Core.DirectedGraph +import qualified Hakyll.Core.DirectedGraph as DG +import Hakyll.Core.DirectedGraph.Internal + +-- | Solve a dependency graph. This function returns an order to run the +-- different nodes +-- +solveDependencies :: Ord a + => DirectedGraph a -- ^ Graph + -> [a] -- ^ Resulting plan +solveDependencies = P.reverse . order [] [] S.empty + +-- | Produce a reversed order using a stack +-- +order :: Ord a + => [a] -- ^ Temporary result + -> [Node a] -- ^ Backtrace stack + -> Set a -- ^ Items in the stack + -> DirectedGraph a -- ^ Graph + -> [a] -- ^ Ordered result +order temp stack set graph@(DirectedGraph graph') + -- Empty graph - return our current result + | M.null graph' = temp + | otherwise = case stack of + + -- Empty stack - pick a node, and add it to the stack + [] -> + let (tag, node) = M.findMin graph' + in order temp (node : stack) (S.insert tag set) graph + + -- At least one item on the stack - continue using this item + (node : stackTail) -> + -- Check which dependencies are still in the graph + let tag = nodeTag node + deps = S.toList $ nodeNeighbours node + unsatisfied = catMaybes $ map (flip M.lookup graph') deps + in case unsatisfied of + + -- All dependencies for node are satisfied, we can return it and + -- remove it from the graph + [] -> order (tag : temp) stackTail (S.delete tag set) + (DG.filter (== tag) graph) + + -- There is at least one dependency left. We need to solve that + -- one first... + (dep : _) -> if (nodeTag dep) `S.member` set + -- The dependency is already in our stack - cycle detected! + then error "order: Cycle detected!" -- TODO: Dump cycle + -- Continue with the dependency + else order temp (dep : node : stackTail) + (S.insert (nodeTag dep) set) + graph |