git.iko.soy/hakyll
on 877cb21 help sign in
hakyll/src/Hakyll/Web/Page/Metadata.hs
239 lines 9.0 kB history raw
1-- | Provides various functions to manipulate the metadata fields of a page
2-- TODO: PORT
3module Hakyll.Web.Page.Metadata
4 (
5 {- getField
6 , getFieldMaybe
7 , setField
8 , trySetField
9 , setFieldA
10 , setFieldPage
11 , renderField
12 , changeField
13 , copyField
14 , renderDateField
15 , renderDateFieldWith
16 , renderModificationTime
17 , renderModificationTimeWith
18 , copyBodyToField
19 , copyBodyFromField
20 , comparePagesByDate
21 -}
22 ) where
24{-
25import Control.Arrow (Arrow, arr, (>>>), (***), (&&&))
26import Control.Category (id)
27import Control.Monad (msum)
28import Data.List (intercalate)
29import Data.Maybe (fromMaybe)
30import Data.Ord (comparing)
31import Prelude hiding (id)
32import System.FilePath (takeFileName)
33import System.Locale (TimeLocale, defaultTimeLocale)
34import qualified Data.Map as M
36import Data.Time.Calendar (Day (..))
37import Data.Time.Clock (UTCTime (..))
38import Data.Time.Format (parseTime, formatTime)
40import Hakyll.Web.Page.Internal
41import Hakyll.Core.Util.String
42import Hakyll.Core.Identifier
43import Hakyll.Core.Compiler
44import Hakyll.Core.ResourceProvider
46-- | Get a metadata field. If the field does not exist, the empty string is
47-- returned.
48--
49getField :: String -- ^ Key
50 -> Page a -- ^ Page
51 -> String -- ^ Value
52getField key = fromMaybe "" . getFieldMaybe key
54-- | Get a field in a 'Maybe' wrapper
55--
56getFieldMaybe :: String -- ^ Key
57 -> Page a -- ^ Page
58 -> Maybe String -- ^ Value, if found
59getFieldMaybe key = M.lookup key . pageMetadata
61-- | Version of 'trySetField' which overrides any previous value
62--
63setField :: String -- ^ Key
64 -> String -- ^ Value
65 -> Page a -- ^ Page to add it to
66 -> Page a -- ^ Resulting page
67setField k v (Page m b) = Page (M.insert k v m) b
69-- | Add a metadata field. If the field already exists, it is not overwritten.
70--
71trySetField :: String -- ^ Key
72 -> String -- ^ Value
73 -> Page a -- ^ Page to add it to
74 -> Page a -- ^ Resulting page
75trySetField k v (Page m b) = Page (M.insertWith (flip const) k v m) b
77-- | Arrow-based variant of 'setField'. Because of it's type, this function is
78-- very usable together with the different 'require' functions.
79--
80setFieldA :: Arrow a
81 => String -- ^ Key
82 -> a x String -- ^ Value arrow
83 -> a (Page b, x) (Page b) -- ^ Resulting arrow
84setFieldA k v = id *** v >>> arr (uncurry $ flip $ setField k)
86-- | Set a field of a page to the contents of another page
87--
88setFieldPage :: String -- ^ Key to add the page under
89 -> Identifier (Page String) -- ^ Page to add
90 -> Compiler (Page a) (Page a) -- ^ Page compiler
91setFieldPage key page = id &&& require_ page >>> setFieldA key (arr pageBody)
93-- | Do something with a metadata value, but keep the old value as well. If the
94-- key given is not present in the metadata, nothing will happen. If the source
95-- and destination keys are the same, the value will be changed (but you should
96-- use 'changeField' for this purpose).
97--
98renderField :: String -- ^ Key of which the value should be copied
99 -> String -- ^ Key the value should be copied to
100 -> (String -> String) -- ^ Function to apply on the value
101 -> Page a -- ^ Page on which this should be applied
102 -> Page a -- ^ Resulting page
103renderField src dst f page = case M.lookup src (pageMetadata page) of
104 Nothing -> page
105 Just value -> setField dst (f value) page
107-- | Change a metadata value.
108--
109-- > import Data.Char (toUpper)
110-- > changeField "title" (map toUpper)
111--
112-- Will put the title in UPPERCASE.
113--
114changeField :: String -- ^ Key to change.
115 -> (String -> String) -- ^ Function to apply on the value.
116 -> Page a -- ^ Page to change
117 -> Page a -- ^ Resulting page
118changeField key = renderField key key
120-- | Make a copy of a metadata field (put the value belonging to a certain key
121-- under some other key as well)
122--
123copyField :: String -- ^ Key to copy
124 -> String -- ^ Destination to copy to
125 -> Page a -- ^ Page on which this should be applied
126 -> Page a -- ^ Resulting page
127copyField src dst = renderField src dst id
129-- | When the metadata has a field called @published@ in one of the
130-- following formats then this function can render the date.
131--
132-- * @Sun, 01 Feb 2000 13:00:00 UT@ (RSS date format)
133--
134-- * @2000-02-01T13:00:00Z@ (Atom date format)
135--
136-- * @February 1, 2000 1:00 PM@ (PM is usually uppercase)
137--
138-- * @February 1, 2000@ (assumes 12:00 AM for the time)
139--
140-- Alternatively, when the metadata has a field called @path@ in a
141-- @folder/yyyy-mm-dd-title.extension@ format (the convention for pages)
142-- and no @published@ metadata field set, this function can render
143-- the date.
144--
145-- > renderDateField "date" "%B %e, %Y" "Date unknown"
146--
147-- Will render something like @January 32, 2010@.
148--
149renderDateField :: String -- ^ Key in which the rendered date should be placed
150 -> String -- ^ Format to use on the date
151 -> String -- ^ Default value, in case the date cannot be parsed
152 -> Page a -- ^ Page on which this should be applied
153 -> Page a -- ^ Resulting page
154renderDateField = renderDateFieldWith defaultTimeLocale
156-- | This is an extended version of 'renderDateField' that allows you to
157-- specify a time locale that is used for outputting the date. For more
158-- details, see 'renderDateField'.
159--
160renderDateFieldWith :: TimeLocale -- ^ Output time locale
161 -> String -- ^ Destination key
162 -> String -- ^ Format to use on the date
163 -> String -- ^ Default value
164 -> Page a -- ^ Target page
165 -> Page a -- ^ Resulting page
166renderDateFieldWith locale key format defaultValue page =
167 setField key renderTimeString page
168 where
169 renderTimeString = fromMaybe defaultValue $ do
170 time <- getUTCMaybe locale page
171 return $ formatTime locale format time
173-- | Parser to try to extract and parse the time from the @published@
174-- field or from the filename. See 'renderDateField' for more information.
175getUTCMaybe :: TimeLocale -- ^ Output time locale
176 -> Page a -- ^ Input page
177 -> Maybe UTCTime -- ^ Parsed UTCTime
178getUTCMaybe locale page = msum $
179 [fromField "published" fmt | fmt <- formats] ++
180 [fromField "date" fmt | fmt <- formats] ++
181 [ getFieldMaybe "path" page >>= parseTime' "%Y-%m-%d" .
182 intercalate "-" . take 3 . splitAll "-" . takeFileName
183 ]
184 where
185 parseTime' f str = parseTime locale f str
186 fromField k fmt = getFieldMaybe k page >>= parseTime' fmt
188 formats =
189 [ "%a, %d %b %Y %H:%M:%S UT"
190 , "%Y-%m-%dT%H:%M:%SZ"
191 , "%Y-%m-%d %H:%M:%S"
192 , "%Y-%m-%d"
193 , "%B %e, %Y %l:%M %p"
194 , "%B %e, %Y"
195 ]
197-- | Set the modification time as a field in the page
198renderModificationTime :: String
199 -- ^ Destination key
200 -> String
201 -- ^ Format to use on the time
202 -> Compiler (Page String) (Page String)
203 -- ^ Resulting compiler
204renderModificationTime = renderModificationTimeWith defaultTimeLocale
206renderModificationTimeWith :: TimeLocale
207 -- ^ Output time locale
208 -> String
209 -- ^ Destination key
210 -> String
211 -- ^ Format to use on the time
212 -> Compiler (Page String) (Page String)
213 -- ^ Resulting compiler
214renderModificationTimeWith locale key format =
215 id &&& (getResourceWith $ const resourceModificationTime) >>>
216 setFieldA key (arr (formatTime locale format))
218-- | Copy the body of a page to a metadata field
219--
220copyBodyToField :: String -- ^ Destination key
221 -> Page String -- ^ Target page
222 -> Page String -- ^ Resulting page
223copyBodyToField key page = setField key (pageBody page) page
225-- | Copy a metadata field to the page body
226--
227copyBodyFromField :: String -- ^ Source key
228 -> Page String -- ^ Target page
229 -> Page String -- ^ Resulting page
230copyBodyFromField key page = fmap (const $ getField key page) page
232-- | Compare pages by the date and time parsed as in 'renderDateField',
233-- where 'LT' implies earlier, and 'GT' implies later. For more details,
234-- see 'renderDateField'.
235comparePagesByDate :: Page a -> Page a -> Ordering
236comparePagesByDate = comparing $ fromMaybe zero . getUTCMaybe defaultTimeLocale
237 where
238 zero = UTCTime (ModifiedJulianDay 0) 0
239-}