3 files changed, 132 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
diff --git a/src/Hakyll/Core/DirectedGraph/Internal.hs b/src/Hakyll/Core/DirectedGraph/Internal.hs
new file mode 100644
index 0000000..9890fc0
--- /dev/null
+++ b/src/Hakyll/Core/DirectedGraph/Internal.hs
@@ -0,0 +1,39 @@
+-- | Internal structure of the DirectedGraph type. Not exported in the library.
+--
+module Hakyll.Core.DirectedGraph.Internal
+    ( Node (..)
+    , DirectedGraph (..)
+    ) where
+
+import Prelude hiding (reverse, filter)
+import Data.Monoid (Monoid, mempty, mappend)
+import Data.Set (Set)
+import Data.Map (Map)
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+-- | A node in the directed graph
+--
+data Node a = Node
+    { nodeTag        :: a        -- ^ Tag identifying the node
+    , nodeNeighbours :: (Set a)  -- ^ Edges starting at this node
+    } deriving (Show)
+
+-- | Append two nodes. Useful for joining graphs.
+--
+appendNodes :: Ord a => Node a -> Node a -> Node a
+appendNodes (Node t1 n1) (Node t2 n2)
+    | t1 /= t2 = error "appendNodes: Appending differently tagged nodes"
+    | otherwise = Node t1 (n1 `S.union` n2)
+
+-- | Type used to represent a directed graph
+--
+newtype DirectedGraph a = DirectedGraph {unDirectedGraph :: Map a (Node a)}
+                        deriving (Show)
+
+-- | Allow users to concatenate different graphs
+--
+instance Ord a => Monoid (DirectedGraph a) where
+    mempty = DirectedGraph M.empty
+    mappend (DirectedGraph m1) (DirectedGraph m2) = DirectedGraph $
+        M.unionWith appendNodes m1 m2
diff --git a/src/Hakyll/Core/DirectedGraph/ObsoleteFilter.hs b/src/Hakyll/Core/DirectedGraph/ObsoleteFilter.hs
new file mode 100644
index 0000000..a3bc57a
--- /dev/null
+++ b/src/Hakyll/Core/DirectedGraph/ObsoleteFilter.hs
@@ -0,0 +1,25 @@
+-- | Module exporting a function that works as a filter on a dependency graph.
+-- Given a list of obsolete nodes, this filter will reduce the graph so it only
+-- contains obsolete nodes and nodes that depend (directly or indirectly) on
+-- obsolete nodes.
+--
+module Hakyll.Core.DirectedGraph.ObsoleteFilter
+    ( obsoleteFilter
+    ) where
+
+import qualified Data.Set as S
+
+import Hakyll.Core.DirectedGraph
+import qualified Hakyll.Core.DirectedGraph as DG
+
+-- | Given a list of obsolete items, filter the dependency graph so it only
+-- contains these items
+--
+obsoleteFilter :: Ord a
+               => [a]              -- ^ List of obsolete items
+               -> DirectedGraph a  -- ^ Dependency graph
+               -> DirectedGraph a  -- ^ Resulting dependency graph
+obsoleteFilter obsolete graph =
+    let reversed = DG.reverse graph
+        allObsolete = S.unions $ map (flip reachableNodes reversed) obsolete
+    in DG.filter (`S.member` allObsolete) graph