git.iko.soy/hakyll
on c8a970d help sign in
hakyll/src/Hakyll/Web/Page/Metadata.hs
191 lines 7.4 kB history raw
1-- | Provides various functions to manipulate the metadata fields of a page
2--
3module Hakyll.Web.Page.Metadata
4 ( getField
5 , getFieldMaybe
6 , setField
7 , trySetField
8 , setFieldA
9 , setFieldPage
10 , renderField
11 , changeField
12 , copyField
13 , renderDateField
14 , renderDateFieldWith
15 , renderModificationTime
16 , renderModificationTimeWith
17 , copyBodyToField
18 , copyBodyFromField
19 ) where
21import Prelude hiding (id)
22import Control.Category (id)
23import Control.Arrow (Arrow, arr, (>>>), (***), (&&&))
24import Data.List (intercalate)
25import Data.Maybe (fromMaybe)
26import Data.Time.Clock (UTCTime)
27import Data.Time.Format (parseTime, formatTime)
28import qualified Data.Map as M
29import System.FilePath (takeFileName)
30import System.Locale (TimeLocale, defaultTimeLocale)
32import Hakyll.Web.Page.Internal
33import Hakyll.Core.Util.String
34import Hakyll.Core.Identifier
35import Hakyll.Core.Compiler
36import Hakyll.Core.Resource.Provider
38-- | Get a metadata field. If the field does not exist, the empty string is
39-- returned.
40--
41getField :: String -- ^ Key
42 -> Page a -- ^ Page
43 -> String -- ^ Value
44getField key = fromMaybe "" . getFieldMaybe key
46-- | Get a field in a 'Maybe' wrapper
47--
48getFieldMaybe :: String -- ^ Key
49 -> Page a -- ^ Page
50 -> Maybe String -- ^ Value, if found
51getFieldMaybe key = M.lookup key . pageMetadata
53-- | Version of 'trySetField' which overrides any previous value
54--
55setField :: String -- ^ Key
56 -> String -- ^ Value
57 -> Page a -- ^ Page to add it to
58 -> Page a -- ^ Resulting page
59setField k v (Page m b) = Page (M.insert k v m) b
61-- | Add a metadata field. If the field already exists, it is not overwritten.
62--
63trySetField :: String -- ^ Key
64 -> String -- ^ Value
65 -> Page a -- ^ Page to add it to
66 -> Page a -- ^ Resulting page
67trySetField k v (Page m b) = Page (M.insertWith (flip const) k v m) b
69-- | Arrow-based variant of 'setField'. Because of it's type, this function is
70-- very usable together with the different 'require' functions.
71--
72setFieldA :: Arrow a
73 => String -- ^ Key
74 -> a x String -- ^ Value arrow
75 -> a (Page b, x) (Page b) -- ^ Resulting arrow
76setFieldA k v = id *** v >>> arr (uncurry $ flip $ setField k)
78-- | Set a field of a page to the contents of another page
79--
80setFieldPage :: String -- ^ Key to add the page under
81 -> Identifier (Page String) -- ^ Page to add
82 -> Compiler (Page a) (Page a) -- ^ Page compiler
83setFieldPage key page = id &&& require_ page >>> setFieldA key (arr pageBody)
85-- | Do something with a metadata value, but keep the old value as well. If the
86-- key given is not present in the metadata, nothing will happen. If the source
87-- and destination keys are the same, the value will be changed (but you should
88-- use 'changeField' for this purpose).
89--
90renderField :: String -- ^ Key of which the value should be copied
91 -> String -- ^ Key the value should be copied to
92 -> (String -> String) -- ^ Function to apply on the value
93 -> Page a -- ^ Page on which this should be applied
94 -> Page a -- ^ Resulting page
95renderField src dst f page = case M.lookup src (pageMetadata page) of
96 Nothing -> page
97 Just value -> setField dst (f value) page
99-- | Change a metadata value.
100--
101-- > import Data.Char (toUpper)
102-- > changeField "title" (map toUpper)
103--
104-- Will put the title in UPPERCASE.
105--
106changeField :: String -- ^ Key to change.
107 -> (String -> String) -- ^ Function to apply on the value.
108 -> Page a -- ^ Page to change
109 -> Page a -- ^ Resulting page
110changeField key = renderField key key
112-- | Make a copy of a metadata field (put the value belonging to a certain key
113-- under some other key as well)
114--
115copyField :: String -- ^ Key to copy
116 -> String -- ^ Destination to copy to
117 -> Page a -- ^ Page on which this should be applied
118 -> Page a -- ^ Resulting page
119copyField src dst = renderField src dst id
121-- | When the metadata has a field called @path@ in a
122-- @folder/yyyy-mm-dd-title.extension@ format (the convention for pages),
123-- this function can render the date.
124--
125-- > renderDate "date" "%B %e, %Y" "Date unknown"
126--
127-- Will render something like @January 32, 2010@.
128--
129renderDateField :: String -- ^ Key in which the rendered date should be placed
130 -> String -- ^ Format to use on the date
131 -> String -- ^ Default value, in case the date cannot be parsed
132 -> Page a -- ^ Page on which this should be applied
133 -> Page a -- ^ Resulting page
134renderDateField = renderDateFieldWith defaultTimeLocale
136-- | This is an extended version of 'renderDateField' that allows you to
137-- specify a time locale that is used for outputting the date. For more
138-- details, see 'renderDateField'.
139--
140renderDateFieldWith :: TimeLocale -- ^ Output time locale
141 -> String -- ^ Destination key
142 -> String -- ^ Format to use on the date
143 -> String -- ^ Default value
144 -> Page a -- ^ Target page
145 -> Page a -- ^ Resulting page
146renderDateFieldWith locale key format defaultValue =
147 renderField "path" key renderDate'
148 where
149 renderDate' filePath = fromMaybe defaultValue $ do
150 let dateString = intercalate "-" $ take 3
151 $ splitAll "-" $ takeFileName filePath
152 time <- parseTime defaultTimeLocale
153 "%Y-%m-%d"
154 dateString :: Maybe UTCTime
155 return $ formatTime locale format time
157-- | Set the modification time as a field in the page
158--
159renderModificationTime :: String
160 -- ^ Destination key
161 -> String
162 -- ^ Format to use on the time
163 -> Compiler (Page String) (Page String)
164 -- ^ Resulting compiler
165renderModificationTime = renderModificationTimeWith defaultTimeLocale
167renderModificationTimeWith :: TimeLocale
168 -- ^ Output time locale
169 -> String
170 -- ^ Destination key
171 -> String
172 -- ^ Format to use on the time
173 -> Compiler (Page String) (Page String)
174 -- ^ Resulting compiler
175renderModificationTimeWith locale key format =
176 id &&& (getResource >>> getResourceWith resourceModificationTime) >>>
177 setFieldA key (arr (formatTime locale format))
179-- | Copy the body of a page to a metadata field
180--
181copyBodyToField :: String -- ^ Destination key
182 -> Page String -- ^ Target page
183 -> Page String -- ^ Resulting page
184copyBodyToField key page = setField key (pageBody page) page
186-- | Copy a metadata field to the page body
187--
188copyBodyFromField :: String -- ^ Source key
189 -> Page String -- ^ Target page
190 -> Page String -- ^ Resulting page
191copyBodyFromField key page = fmap (const $ getField key page) page