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
|
--------------------------------------------------------------------------------
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.Urls
--------------------------------------------------------------------------------
type Context a = Compiler (String, a) String
--------------------------------------------------------------------------------
field :: String -> Compiler a String -> Context a
field key value = arr checkKey >>> empty ||| value
where
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
|
