@@ -12,6 +12,7 @@ module Hakyll.Web.Page.Metadata
1212 , copyField
1313 , renderDateField
1414 , renderDateFieldWith
15+ , comparePagesByDate
1516 , renderModificationTime
1617 , renderModificationTimeWith
1718 , copyBodyToField
@@ -22,7 +23,7 @@ import Prelude hiding (id)
2223import Control.Category (id)
2324import Control.Arrow (Arrow, arr, (>>>), (***), (&&&))
2425import Data.List (intercalate)
25−import Data.Maybe (fromMaybe)
26+import Data.Maybe (fromMaybe, fromJust, isJust)
2627import Data.Time.Clock (UTCTime)
2728import Data.Time.Format (parseTime, formatTime)
2829import qualified Data.Map as M
@@ -118,11 +119,23 @@ copyField :: String -- ^ Key to copy
118119 -> Page a -- ^ Resulting page
119120copyField src dst = renderField src dst id
120121
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.
122+-- | When the metadata has a field called @published@ in one of the
123+-- following formats then this function can render the date.
124124--
125−-- > renderDate "date" "%B %e, %Y" "Date unknown"
125+-- * @Sun, 01 Feb 2000 13:00:00 UT@ (RSS date format)
126+--
127+-- * @2000-02-01T13:00:00Z@ (Atom date format)
128+--
129+-- * @February 1, 2000 1:00 PM@ (PM is usually uppercase)
130+--
131+-- * @February 1, 2000@ (assumes 12:00 AM for the time)
132+--
133+-- Alternatively, when the metadata has a field called @path@ in a
134+-- @folder/yyyy-mm-dd-title.extension@ format (the convention for pages)
135+-- and no @published@ metadata field set, this function can render
136+-- the date.
137+--
138+-- > renderDateField "date" "%B %e, %Y" "Date unknown"
126139--
127140-- Will render something like @January 32, 2010@.
128141--
@@ -143,19 +156,47 @@ renderDateFieldWith :: TimeLocale -- ^ Output time locale
143156 -> String -- ^ Default value
144157 -> Page a -- ^ Target page
145158 -> Page a -- ^ Resulting page
146−renderDateFieldWith locale key format defaultValue =
147− renderField "path" key renderDate'
159+renderDateFieldWith locale key format defaultValue page =
160+ setField key renderTimeString page
148161 where
149− renderDate' filePath = fromMaybe defaultValue $ do
162+ renderTimeString = fromMaybe defaultValue $ do
163+ time <- getUTCMaybe locale page
164+ return $ formatTime locale format time
165+
166+-- | Parser to try to extract and parse the time from the @published@
167+-- field or from the filename. See 'renderDateField' for more information.
168+getUTCMaybe :: TimeLocale -- ^ Output time locale
169+ -> Page a -- ^ Input page
170+ -> Maybe UTCTime -- ^ Parsed UTCTime
171+getUTCMaybe locale page = getUTCMaybe' formats
172+ where
173+ formats = [ "%a, %d %b %Y %H:%M:%S UT" -- RSS format
174+ , "%Y-%m-%dT%H:%M:%SZ" -- Atom format
175+ , "%B %e, %Y %l:%M %p"
176+ , "%B %e, %Y"
177+ ]
178+ getUTCMaybe' [] = do
179+ filePath <- getFieldMaybe "path" page
150180 let dateString = intercalate "-" $ take 3
151181 $ splitAll "-" $ takeFileName filePath
152− time <- parseTime defaultTimeLocale
153− "%Y-%m-%d"
154− dateString :: Maybe UTCTime
155− return $ formatTime locale format time
182+ parseTime locale "%Y-%m-%d" dateString :: Maybe UTCTime
183+ getUTCMaybe' (f:fs) = if isJust timeMaybe
184+ then timeMaybe
185+ else getUTCMaybe' fs
186+ where timeMaybe = do dateString <- getFieldMaybe "published" page
187+ parseTime locale f dateString :: Maybe UTCTime
188+
189+-- | Compare pages by the date and time parsed as in 'renderDateField',
190+-- where 'LT' implies earlier, and 'GT' implies later. For more details,
191+-- see 'renderDateField'.
192+comparePagesByDate :: Page a -> Page a -> Ordering
193+comparePagesByDate p1 p2 = compare p1UTC p2UTC
194+ where p1UTC = fromMaybe defaultTime $ getUTCMaybe defaultTimeLocale p1
195+ p2UTC = fromMaybe defaultTime $ getUTCMaybe defaultTimeLocale p2
196+ defaultTime = fromJust $ parseTime defaultTimeLocale
197+ "%B %e, %Y %l:%M %p" "January 1, 1900 12:00 AM"
156198
157199-- | Set the modification time as a field in the page
158−--
159200renderModificationTime :: String
160201 -- ^ Destination key
161202 -> String