Context?

3 files changed, 79 insertions, 16 deletions

diff --git a/src/Hakyll/Core/DirectedGraph.hs b/src/Hakyll/Core/DirectedGraph.hs
index ff9121a..66cb84d 100644
--- a/src/Hakyll/Core/DirectedGraph.hs
+++ b/src/Hakyll/Core/DirectedGraph.hs
@@ -1,6 +1,6 @@
+--------------------------------------------------------------------------------
 -- | Representation of a directed graph. In Hakyll, this is used for dependency
 -- tracking.
---
 module Hakyll.Core.DirectedGraph
     ( DirectedGraph
     , fromList
@@ -12,6 +12,8 @@ module Hakyll.Core.DirectedGraph
     , reachableNodes
     ) where
 
+
+--------------------------------------------------------------------------------
 import Prelude hiding (reverse)
 import Control.Arrow (second)
 import Data.Monoid (mconcat)
@@ -20,47 +22,55 @@ import Data.Maybe (fromMaybe)
 import qualified Data.Map as M
 import qualified Data.Set as S
 
+
+--------------------------------------------------------------------------------
 import Hakyll.Core.DirectedGraph.Internal
 
+
+--------------------------------------------------------------------------------
 -- | Construction of directed graphs
---
 fromList :: Ord a
          => [(a, Set a)]     -- ^ List of (node, reachable neighbours)
          -> DirectedGraph a  -- ^ Resulting directed graph
 fromList = DirectedGraph . M.fromList . map (\(t, d) -> (t, Node t d))
 
+
+--------------------------------------------------------------------------------
 -- | Deconstruction of directed graphs
---
 toList :: DirectedGraph a
        -> [(a, Set a)]
 toList = map (second nodeNeighbours) . M.toList . unDirectedGraph
 
+
+--------------------------------------------------------------------------------
 -- | Check if a node lies in the given graph
---
 member :: Ord a
        => a                -- ^ Node to check for
        -> DirectedGraph a  -- ^ Directed graph to check in
        -> Bool             -- ^ If the node lies in the graph
 member n = M.member n . unDirectedGraph
 
+
+--------------------------------------------------------------------------------
 -- | Get all nodes in the graph
---
 nodes :: Ord a
       => DirectedGraph a  -- ^ Graph to get the nodes from
       -> Set a            -- ^ All nodes in the graph
 nodes = M.keysSet . unDirectedGraph
 
+
+--------------------------------------------------------------------------------
 -- | Get a set of reachable neighbours from a directed graph
---
 neighbours :: Ord a
            => a                -- ^ Node to get the neighbours of
            -> DirectedGraph a  -- ^ Graph to search in
            -> Set a            -- ^ Set containing the neighbours
-neighbours x = fromMaybe S.empty . fmap nodeNeighbours
-             . M.lookup x . unDirectedGraph
+neighbours x = fromMaybe S.empty . fmap nodeNeighbours .
+    M.lookup x . unDirectedGraph
 
+
+--------------------------------------------------------------------------------
 -- | Reverse a directed graph (i.e. flip all edges)
---
 reverse :: Ord a
         => DirectedGraph a
         -> DirectedGraph a
@@ -69,8 +79,9 @@ reverse = mconcat . map reverse' . M.toList . unDirectedGraph
     reverse' (id', Node _ neighbours') = fromList $
         zip (S.toList neighbours') $ repeat $ S.singleton id'
 
+
+--------------------------------------------------------------------------------
 -- | Find all reachable nodes from a given set of nodes in the directed graph
---
 reachableNodes :: Ord a => Set a -> DirectedGraph a -> Set a
 reachableNodes set graph = reachable (setNeighbours set) set
   where
diff --git a/src/Hakyll/Core/DirectedGraph/Dot.hs b/src/Hakyll/Core/DirectedGraph/Dot.hs
index 58f375c..94e2444 100644
--- a/src/Hakyll/Core/DirectedGraph/Dot.hs
+++ b/src/Hakyll/Core/DirectedGraph/Dot.hs
@@ -1,15 +1,18 @@
+--------------------------------------------------------------------------------
 -- | 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
 
+--------------------------------------------------------------------------------
+import qualified Data.Set                  as S
+import           Hakyll.Core.DirectedGraph
+
+
+--------------------------------------------------------------------------------
 -- | 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
@@ -25,8 +28,9 @@ toDot showTag graph = unlines $ concat
     showEdges 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/Web/Template/Context.hs b/src/Hakyll/Web/Template/Context.hs
index 5ca1556..17db7ca 100644
--- a/src/Hakyll/Web/Template/Context.hs
+++ b/src/Hakyll/Web/Template/Context.hs
@@ -2,13 +2,26 @@
 module Hakyll.Web.Template.Context
     ( Context
     , field
+
+    , defaultContext
+    , bodyField
+    , urlField
+    , pathField
+    , categoryField
+    , titleField
     ) where
 
 
 --------------------------------------------------------------------------------
-import           Control.Applicative  (empty)
+import           Control.Applicative    (empty, (<|>))
 import           Control.Arrow
+import           System.FilePath        (takeBaseName, takeDirectory)
+
+
+--------------------------------------------------------------------------------
 import           Hakyll.Core.Compiler
+import           Hakyll.Core.Identifier
+import           Hakyll.Web.Urls
 
 
 --------------------------------------------------------------------------------
@@ -22,3 +35,38 @@ field key value = arr checkKey >>> empty ||| value
     checkKey (k, x)
         | k == key  = Left ()
         | otherwise = Right x
+
+
+--------------------------------------------------------------------------------
+defaultContext :: Context (Identifier String, String)
+defaultContext =
+    bodyField     "body"     <|>
+    urlField      "url"      <|>
+    pathField     "path"     <|>
+    categoryField "category" <|>
+    titleField    "title"
+
+
+--------------------------------------------------------------------------------
+bodyField :: String -> Context (Identifier String, String)
+bodyField key = field key $ arr snd
+
+
+--------------------------------------------------------------------------------
+urlField :: String -> Context (Identifier a, a)
+urlField key = field key $ fst ^>> getRouteFor >>^ maybe empty toUrl
+
+
+--------------------------------------------------------------------------------
+pathField :: String -> Context (Identifier a, a)
+pathField key = field key $ arr $ toFilePath . fst
+
+
+--------------------------------------------------------------------------------
+categoryField :: String -> Context (Identifier a, a)
+categoryField key = pathField key >>^ (takeBaseName . takeDirectory)
+
+
+--------------------------------------------------------------------------------
+titleField :: String -> Context (Identifier a, a)
+titleField key = pathField key >>^ takeBaseName