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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
|
-- | Provides various functions to manipulate the metadata fields of a page
--
module Hakyll.Web.Page.Metadata
( getField
, getFieldMaybe
, setField
, trySetField
, setFieldA
, setFieldPage
, renderField
, changeField
, copyField
, renderDateField
, renderDateFieldWith
, copyBodyToField
, copyBodyFromField
) where
import Prelude hiding (id)
import Control.Category (id)
import Control.Arrow (Arrow, arr, (>>>), (***), (&&&))
import Data.List (intercalate)
import Data.Maybe (fromMaybe)
import Data.Time.Clock (UTCTime)
import Data.Time.Format (parseTime, formatTime)
import qualified Data.Map as M
import System.FilePath (takeFileName)
import System.Locale (TimeLocale, defaultTimeLocale)
import Hakyll.Web.Page.Internal
import Hakyll.Core.Util.String
import Hakyll.Core.Identifier
import Hakyll.Core.Compiler
-- | Get a metadata field. If the field does not exist, the empty string is
-- returned.
--
getField :: String -- ^ Key
-> Page a -- ^ Page
-> String -- ^ Value
getField key = fromMaybe "" . getFieldMaybe key
-- | Get a field in a 'Maybe' wrapper
--
getFieldMaybe :: String -- ^ Key
-> Page a -- ^ Page
-> Maybe String -- ^ Value, if found
getFieldMaybe key = M.lookup key . pageMetadata
-- | Version of 'trySetField' which overrides any previous value
--
setField :: String -- ^ Key
-> String -- ^ Value
-> Page a -- ^ Page to add it to
-> Page a -- ^ Resulting page
setField k v (Page m b) = Page (M.insert k v m) b
-- | Add a metadata field. If the field already exists, it is not overwritten.
--
trySetField :: String -- ^ Key
-> String -- ^ Value
-> Page a -- ^ Page to add it to
-> Page a -- ^ Resulting page
trySetField k v (Page m b) = Page (M.insertWith (flip const) k v m) b
-- | Arrow-based variant of 'setField'. Because of it's type, this function is
-- very usable together with the different 'require' functions.
--
setFieldA :: Arrow a
=> String -- ^ Key
-> a x String -- ^ Value arrow
-> a (Page b, x) (Page b) -- ^ Resulting arrow
setFieldA k v = id *** v >>> arr (uncurry $ flip $ setField k)
-- | Set a field of a page to the contents of another page
--
setFieldPage :: String -- ^ Key to add the page under
-> Identifier (Page String) -- ^ Page to add
-> Compiler (Page a) (Page a) -- ^ Page compiler
setFieldPage key page = id &&& require_ page >>> setFieldA key (arr pageBody)
-- | Do something with a metadata value, but keep the old value as well. If the
-- key given is not present in the metadata, nothing will happen. If the source
-- and destination keys are the same, the value will be changed (but you should
-- use 'changeField' for this purpose).
--
renderField :: String -- ^ Key of which the value should be copied
-> String -- ^ Key the value should be copied to
-> (String -> String) -- ^ Function to apply on the value
-> Page a -- ^ Page on which this should be applied
-> Page a -- ^ Resulting page
renderField src dst f page = case M.lookup src (pageMetadata page) of
Nothing -> page
Just value -> setField dst (f value) page
-- | Change a metadata value.
--
-- > import Data.Char (toUpper)
-- > changeField "title" (map toUpper)
--
-- Will put the title in UPPERCASE.
--
changeField :: String -- ^ Key to change.
-> (String -> String) -- ^ Function to apply on the value.
-> Page a -- ^ Page to change
-> Page a -- ^ Resulting page
changeField key = renderField key key
-- | Make a copy of a metadata field (put the value belonging to a certain key
-- under some other key as well)
--
copyField :: String -- ^ Key to copy
-> String -- ^ Destination to copy to
-> Page a -- ^ Page on which this should be applied
-> Page a -- ^ Resulting page
copyField src dst = renderField src dst id
-- | When the metadata has a field called @path@ in a
-- @folder/yyyy-mm-dd-title.extension@ format (the convention for pages),
-- this function can render the date.
--
-- > renderDate "date" "%B %e, %Y" "Date unknown"
--
-- Will render something like @January 32, 2010@.
--
renderDateField :: String -- ^ Key in which the rendered date should be placed
-> String -- ^ Format to use on the date
-> String -- ^ Default value, in case the date cannot be parsed
-> Page a -- ^ Page on which this should be applied
-> Page a -- ^ Resulting page
renderDateField = renderDateFieldWith defaultTimeLocale
-- | This is an extended version of 'renderDateField' that allows you to
-- specify a time locale that is used for outputting the date. For more
-- details, see 'renderDateField'.
--
renderDateFieldWith :: TimeLocale -- ^ Output time locale
-> String -- ^ Destination key
-> String -- ^ Format to use on the date
-> String -- ^ Default value
-> Page a -- ^ Target page
-> Page a -- ^ Resulting page
renderDateFieldWith locale key format defaultValue =
renderField "path" key renderDate'
where
renderDate' filePath = fromMaybe defaultValue $ do
let dateString = intercalate "-" $ take 3
$ splitAll "-" $ takeFileName filePath
time <- parseTime defaultTimeLocale
"%Y-%m-%d"
dateString :: Maybe UTCTime
return $ formatTime locale format time
-- | Copy the body of a page to a metadata field
--
copyBodyToField :: String -- ^ Destination key
-> Page String -- ^ Target page
-> Page String -- ^ Resulting page
copyBodyToField key page = setField key (pageBody page) page
-- | Copy a metadata field to the page body
--
copyBodyFromField :: String -- ^ Source key
-> Page String -- ^ Target page
-> Page String -- ^ Resulting page
copyBodyFromField key page = fmap (const $ getField key page) page
|
