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
|
--------------------------------------------------------------------------------
module Hakyll.Web.Template.Context
( Context
, field
, defaultContext
, bodyField
, urlField
, pathField
, categoryField
, titleField
) where
--------------------------------------------------------------------------------
import Control.Applicative (empty, (<|>))
import Control.Arrow
import System.FilePath (takeBaseName, takeDirectory)
--------------------------------------------------------------------------------
import Hakyll.Core.Compiler
import Hakyll.Core.Identifier
import Hakyll.Web.Page.Internal
import Hakyll.Web.Urls
--------------------------------------------------------------------------------
type Context a = Compiler (String, (Identifier a, a)) String
--------------------------------------------------------------------------------
field :: String -> Compiler (Identifier a, a) String -> Context a
field key value = arr checkKey >>> (empty ||| value)
where
checkKey (k, x)
| k /= key = Left ()
| otherwise = Right x
--------------------------------------------------------------------------------
defaultContext :: Context Page
defaultContext =
bodyField "body" <|>
urlField "url" <|>
pathField "path" <|>
categoryField "category" <|>
titleField "title" <|>
missingField
--------------------------------------------------------------------------------
bodyField :: String -> Context Page
bodyField key = field key $ arr snd
--------------------------------------------------------------------------------
urlField :: String -> Context a
urlField key = field key $ fst ^>> getRouteFor >>^ maybe empty toUrl
--------------------------------------------------------------------------------
pathField :: String -> Context a
pathField key = field key $ arr $ toFilePath . fst
--------------------------------------------------------------------------------
categoryField :: String -> Context a
categoryField key = pathField key >>^ (takeBaseName . takeDirectory)
--------------------------------------------------------------------------------
titleField :: String -> Context a
titleField key = pathField key >>^ takeBaseName
--------------------------------------------------------------------------------
missingField :: Context a
missingField = arr $ \(k, _) -> "$" ++ k ++ "$"
|
