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
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
|
-- | 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
, renderModificationTime
, renderModificationTimeWith
, copyBodyToField
, copyBodyFromField
, comparePagesByDate
) where
import Control.Arrow (Arrow, arr, (>>>), (***), (&&&))
import Control.Category (id)
import Control.Monad (msum)
import Data.List (intercalate)
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)
import Prelude hiding (id)
import System.FilePath (takeFileName)
import System.Locale (TimeLocale, defaultTimeLocale)
import qualified Data.Map as M
import Data.Time.Calendar (Day (..))
import Data.Time.Clock (UTCTime (..))
import Data.Time.Format (parseTime, formatTime)
import Hakyll.Web.Page.Internal
import Hakyll.Core.Util.String
import Hakyll.Core.Identifier
import Hakyll.Core.Compiler
import Hakyll.Core.Resource.Provider
-- | 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 @published@ in one of the
-- following formats then this function can render the date.
--
-- * @Sun, 01 Feb 2000 13:00:00 UT@ (RSS date format)
--
-- * @2000-02-01T13:00:00Z@ (Atom date format)
--
-- * @February 1, 2000 1:00 PM@ (PM is usually uppercase)
--
-- * @February 1, 2000@ (assumes 12:00 AM for the time)
--
-- Alternatively, when the metadata has a field called @path@ in a
-- @folder/yyyy-mm-dd-title.extension@ format (the convention for pages)
-- and no @published@ metadata field set, this function can render
-- the date.
--
-- > renderDateField "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 page =
setField key renderTimeString page
where
renderTimeString = fromMaybe defaultValue $ do
time <- getUTCMaybe locale page
return $ formatTime locale format time
-- | Parser to try to extract and parse the time from the @published@
-- field or from the filename. See 'renderDateField' for more information.
getUTCMaybe :: TimeLocale -- ^ Output time locale
-> Page a -- ^ Input page
-> Maybe UTCTime -- ^ Parsed UTCTime
getUTCMaybe locale page = msum
[ fromPublished "%a, %d %b %Y %H:%M:%S UT"
, fromPublished "%Y-%m-%dT%H:%M:%SZ"
, fromPublished "%B %e, %Y %l:%M %p"
, fromPublished "%B %e, %Y"
, getFieldMaybe "path" page >>= parseTime' "%Y-%m-%d" .
intercalate "-" . take 3 . splitAll "-" . takeFileName
]
where
fromPublished f = getFieldMaybe "published" page >>= parseTime' f
parseTime' f str = parseTime locale f str
-- | Set the modification time as a field in the page
renderModificationTime :: String
-- ^ Destination key
-> String
-- ^ Format to use on the time
-> Compiler (Page String) (Page String)
-- ^ Resulting compiler
renderModificationTime = renderModificationTimeWith defaultTimeLocale
renderModificationTimeWith :: TimeLocale
-- ^ Output time locale
-> String
-- ^ Destination key
-> String
-- ^ Format to use on the time
-> Compiler (Page String) (Page String)
-- ^ Resulting compiler
renderModificationTimeWith locale key format =
id &&& (getResource >>> getResourceWith resourceModificationTime) >>>
setFieldA key (arr (formatTime locale format))
-- | 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
-- | Compare pages by the date and time parsed as in 'renderDateField',
-- where 'LT' implies earlier, and 'GT' implies later. For more details,
-- see 'renderDateField'.
comparePagesByDate :: Page a -> Page a -> Ordering
comparePagesByDate = comparing $ fromMaybe zero . getUTCMaybe defaultTimeLocale
where
zero = UTCTime (ModifiedJulianDay 0) 0
|
