Merge branch 'hakyll3'

Conflicts:
	hakyll.cabal
	src/Text/Hakyll/Tags.hs

3 files changed, 143 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..54826ff
--- /dev/null
+++ b/src/Hakyll/Core/DirectedGraph/DependencySolver.hs
@@ -0,0 +1,70 @@
+-- | 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 (mapMaybe)
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+import Hakyll.Core.DirectedGraph
+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 = mapMaybe (`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)
+                            (DirectedGraph $ M.delete 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 cycleError
+                    -- Continue with the dependency
+                    else order temp (dep : node : stackTail)
+                                    (S.insert (nodeTag dep) set)
+                                    graph
+  where
+    cycleError = error $  "Hakyll.Core.DirectedGraph.DependencySolver.order: "
+                       ++ "Cycle detected!"  -- TODO: Dump cycle
diff --git a/src/Hakyll/Core/DirectedGraph/Dot.hs b/src/Hakyll/Core/DirectedGraph/Dot.hs
new file mode 100644
index 0000000..8289992
--- /dev/null
+++ b/src/Hakyll/Core/DirectedGraph/Dot.hs
@@ -0,0 +1,30 @@
+-- | Dump a directed graph in dot format. Used for debugging purposes
+--
+module Hakyll.Core.DirectedGraph.Dot
+    ( toDot
+    , writeDot
+    ) where
+
+import Hakyll.Core.DirectedGraph
+import qualified Data.Set as S
+
+-- | Convert a directed graph into dot format for debugging purposes
+--
+toDot :: Ord a
+      => (a -> String)    -- ^ Convert nodes to dot names
+      -> DirectedGraph a  -- ^ Graph to dump
+      -> String           -- ^ Resulting string
+toDot showTag graph = unlines $ concat
+    [ return "digraph dependencies {"
+    , concatMap showNode (S.toList $ nodes graph)
+    , return "}"
+    ]
+  where
+    showNode node = map (showEdge node) $ S.toList $ neighbours node graph
+    showEdge x y = "    \"" ++ showTag x ++ "\" -> \"" ++ showTag y ++ "\";"
+
+-- | Write out the @.dot@ file to a given file path. See 'toDot' for more
+-- information.
+--
+writeDot :: Ord a => FilePath -> (a -> String) -> DirectedGraph a -> IO ()
+writeDot path showTag = writeFile path . toDot showTag
diff --git a/src/Hakyll/Core/DirectedGraph/Internal.hs b/src/Hakyll/Core/DirectedGraph/Internal.hs
new file mode 100644
index 0000000..5b02ad6
--- /dev/null
+++ b/src/Hakyll/Core/DirectedGraph/Internal.hs
@@ -0,0 +1,43 @@
+-- | Internal structure of the DirectedGraph type. Not exported outside of 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'
+    | otherwise = Node t1 (n1 `S.union` n2)
+  where
+    error' = error $  "Hakyll.Core.DirectedGraph.Internal.appendNodes: "
+                   ++ "Appending differently tagged nodes"
+
+-- | 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