blob: 9c3e412d43662bd413dbf4ccc5a84b30e1db4ef1 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
--------------------------------------------------------------------------------
module Hakyll.Web.Template.Context
( Context (..)
, mapContext
, field
, defaultContext
, bodyField
, urlField
, pathField
, categoryField
, titleField
) where
--------------------------------------------------------------------------------
import Control.Applicative (Alternative (..), (<$>))
import Data.Monoid (Monoid (..))
import System.FilePath (takeBaseName, takeDirectory)
--------------------------------------------------------------------------------
import Hakyll.Core.Compiler
import Hakyll.Core.Identifier
import Hakyll.Web.Page.Internal
import Hakyll.Web.Urls
--------------------------------------------------------------------------------
newtype Context a = Context
{ unContext :: String -> Identifier -> a -> Compiler String
}
--------------------------------------------------------------------------------
instance Monoid (Context a) where
mempty = Context $ \_ _ _ -> empty
mappend (Context f) (Context g) = Context $ \k i x -> f k i x <|> g k i x
--------------------------------------------------------------------------------
mapContext :: (String -> String) -> Context a -> Context a
mapContext f (Context g) = Context $ \k i x -> f <$> g k i x
--------------------------------------------------------------------------------
field :: String -> (Identifier -> a -> Compiler String) -> Context a
field key value = Context $ \k i x -> if k == key then value i x else empty
--------------------------------------------------------------------------------
defaultContext :: Context Page
defaultContext =
bodyField "body" `mappend`
urlField "url" `mappend`
pathField "path" `mappend`
categoryField "category" `mappend`
titleField "title" `mappend`
missingField
--------------------------------------------------------------------------------
bodyField :: String -> Context Page
bodyField key = field key $ \_ x -> return x
--------------------------------------------------------------------------------
urlField :: String -> Context a
urlField key = field key $ \i _ -> maybe empty toUrl <$> getRouteFor i
--------------------------------------------------------------------------------
pathField :: String -> Context a
pathField key = field key $ \i _ -> return $ toFilePath i
--------------------------------------------------------------------------------
categoryField :: String -> Context a
categoryField key = mapContext (takeBaseName . takeDirectory) $ pathField key
--------------------------------------------------------------------------------
titleField :: String -> Context a
titleField key = mapContext takeBaseName $ pathField key
--------------------------------------------------------------------------------
missingField :: Context a
missingField = Context $ \k _ _ -> return $ "$" ++ k ++ "$"
|
