git.iko.soy/hakyll
on master help sign in
Context?
commit260e4e2e8936f756d2f3a2e6e788f05ca28e4324 authorJasper Van der Jeugt <m@jaspervdj.be> dateSat 10 Nov 2012, 16:30 (14 years ago) parent6078e69
3 files changed+79−16
compare with master
unifiedsplit
src/Hakyll/Core/DirectedGraph.hs+21−10 src/Hakyll/Core/DirectedGraph/Dot.hs+9−5 src/Hakyll/Web/Template/Context.hs+49−1
src/Hakyll/Core/DirectedGraph.hs+21−10
@@ -1,6 +1,6 @@
1+--------------------------------------------------------------------------------
12-- | Representation of a directed graph. In Hakyll, this is used for dependency
23-- tracking.
3−--
44module Hakyll.Core.DirectedGraph
55 ( DirectedGraph
66 , fromList
@@ -12,6 +12,8 @@ module Hakyll.Core.DirectedGraph
1212 , reachableNodes
1313 ) where
1414
15+
16+--------------------------------------------------------------------------------
1517import Prelude hiding (reverse)
1618import Control.Arrow (second)
1719import Data.Monoid (mconcat)
@@ -20,47 +22,55 @@ import Data.Maybe (fromMaybe)
2022import qualified Data.Map as M
2123import qualified Data.Set as S
2224
25+
26+--------------------------------------------------------------------------------
2327import Hakyll.Core.DirectedGraph.Internal
2428
29+
30+--------------------------------------------------------------------------------
2531-- | Construction of directed graphs
26−--
2732fromList :: Ord a
2833 => [(a, Set a)] -- ^ List of (node, reachable neighbours)
2934 -> DirectedGraph a -- ^ Resulting directed graph
3035fromList = DirectedGraph . M.fromList . map (\(t, d) -> (t, Node t d))
3136
37+
38+--------------------------------------------------------------------------------
3239-- | Deconstruction of directed graphs
33−--
3440toList :: DirectedGraph a
3541 -> [(a, Set a)]
3642toList = map (second nodeNeighbours) . M.toList . unDirectedGraph
3743
44+
45+--------------------------------------------------------------------------------
3846-- | Check if a node lies in the given graph
39−--
4047member :: Ord a
4148 => a -- ^ Node to check for
4249 -> DirectedGraph a -- ^ Directed graph to check in
4350 -> Bool -- ^ If the node lies in the graph
4451member n = M.member n . unDirectedGraph
4552
53+
54+--------------------------------------------------------------------------------
4655-- | Get all nodes in the graph
47−--
4856nodes :: Ord a
4957 => DirectedGraph a -- ^ Graph to get the nodes from
5058 -> Set a -- ^ All nodes in the graph
5159nodes = M.keysSet . unDirectedGraph
5260
61+
62+--------------------------------------------------------------------------------
5363-- | Get a set of reachable neighbours from a directed graph
54−--
5564neighbours :: Ord a
5665 => a -- ^ Node to get the neighbours of
5766 -> DirectedGraph a -- ^ Graph to search in
5867 -> Set a -- ^ Set containing the neighbours
59−neighbours x = fromMaybe S.empty . fmap nodeNeighbours
60− . M.lookup x . unDirectedGraph
68+neighbours x = fromMaybe S.empty . fmap nodeNeighbours .
69+ M.lookup x . unDirectedGraph
6170
71+
72+--------------------------------------------------------------------------------
6273-- | Reverse a directed graph (i.e. flip all edges)
63−--
6474reverse :: Ord a
6575 => DirectedGraph a
6676 -> DirectedGraph a
@@ -69,8 +79,9 @@ reverse = mconcat . map reverse' . M.toList . unDirectedGraph
6979 reverse' (id', Node _ neighbours') = fromList $
7080 zip (S.toList neighbours') $ repeat $ S.singleton id'
7181
82+
83+--------------------------------------------------------------------------------
7284-- | Find all reachable nodes from a given set of nodes in the directed graph
73−--
7485reachableNodes :: Ord a => Set a -> DirectedGraph a -> Set a
7586reachableNodes set graph = reachable (setNeighbours set) set
7687 where
src/Hakyll/Core/DirectedGraph/Dot.hs+9−5
@@ -1,15 +1,18 @@
1+--------------------------------------------------------------------------------
12-- | Dump a directed graph in dot format. Used for debugging purposes
2−--
33module Hakyll.Core.DirectedGraph.Dot
44 ( toDot
55 , writeDot
66 ) where
77
8−import Hakyll.Core.DirectedGraph
9−import qualified Data.Set as S
108
9+--------------------------------------------------------------------------------
10+import qualified Data.Set as S
11+import Hakyll.Core.DirectedGraph
12+
13+
14+--------------------------------------------------------------------------------
1115-- | Convert a directed graph into dot format for debugging purposes
12−--
1316toDot :: Ord a
1417 => (a -> String) -- ^ Convert nodes to dot names
1518 -> DirectedGraph a -- ^ Graph to dump
@@ -25,8 +28,9 @@ toDot showTag graph = unlines $ concat
2528 showEdges node = map (showEdge node) $ S.toList $ neighbours node graph
2629 showEdge x y = " \"" ++ showTag x ++ "\" -> \"" ++ showTag y ++ "\";"
2730
31+
32+--------------------------------------------------------------------------------
2833-- | Write out the @.dot@ file to a given file path. See 'toDot' for more
2934-- information.
30−--
3135writeDot :: Ord a => FilePath -> (a -> String) -> DirectedGraph a -> IO ()
3236writeDot path showTag = writeFile path . toDot showTag
src/Hakyll/Web/Template/Context.hs+49−1
@@ -2,13 +2,26 @@
22module Hakyll.Web.Template.Context
33 ( Context
44 , field
5+
6+ , defaultContext
7+ , bodyField
8+ , urlField
9+ , pathField
10+ , categoryField
11+ , titleField
512 ) where
613
714
815--------------------------------------------------------------------------------
9−import Control.Applicative (empty)
16+import Control.Applicative (empty, (<|>))
1017import Control.Arrow
18+import System.FilePath (takeBaseName, takeDirectory)
19+
20+
21+--------------------------------------------------------------------------------
1122import Hakyll.Core.Compiler
23+import Hakyll.Core.Identifier
24+import Hakyll.Web.Urls
1225
1326
1427--------------------------------------------------------------------------------
@@ -22,3 +35,38 @@ field key value = arr checkKey >>> empty ||| value
2235 checkKey (k, x)
2336 | k == key = Left ()
2437 | otherwise = Right x
38+
39+
40+--------------------------------------------------------------------------------
41+defaultContext :: Context (Identifier String, String)
42+defaultContext =
43+ bodyField "body" <|>
44+ urlField "url" <|>
45+ pathField "path" <|>
46+ categoryField "category" <|>
47+ titleField "title"
48+
49+
50+--------------------------------------------------------------------------------
51+bodyField :: String -> Context (Identifier String, String)
52+bodyField key = field key $ arr snd
53+
54+
55+--------------------------------------------------------------------------------
56+urlField :: String -> Context (Identifier a, a)
57+urlField key = field key $ fst ^>> getRouteFor >>^ maybe empty toUrl
58+
59+
60+--------------------------------------------------------------------------------
61+pathField :: String -> Context (Identifier a, a)
62+pathField key = field key $ arr $ toFilePath . fst
63+
64+
65+--------------------------------------------------------------------------------
66+categoryField :: String -> Context (Identifier a, a)
67+categoryField key = pathField key >>^ (takeBaseName . takeDirectory)
68+
69+
70+--------------------------------------------------------------------------------
71+titleField :: String -> Context (Identifier a, a)
72+titleField key = pathField key >>^ takeBaseName