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
|
-- | Provides various functions to manipulate the metadata fields of a page
--
module Hakyll.Web.Page.Metadata
( getField
, setField
, setFieldA
, renderField
, changeField
, copyField
, renderDateField
, renderDateFieldWith
) 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.Web.Util.String
-- | 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 "" . M.lookup key . pageMetadata
-- | Add a metadata field. If the field already exists, it is not overwritten.
--
setField :: String -- ^ Key
-> String -- ^ Value
-> Page a -- ^ Page to add it to
-> Page a -- ^ Resulting page
setField 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 String, x) (Page String) -- ^ Resulting arrow
setFieldA k v = id *** v >>> arr (uncurry $ flip $ setField k)
-- | 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
|
