@@ -12,23 +12,27 @@ module Hakyll.Web.Page.Metadata
1212 , copyField
1313 , renderDateField
1414 , renderDateFieldWith
15− , comparePagesByDate
1615 , renderModificationTime
1716 , renderModificationTimeWith
1817 , copyBodyToField
1918 , copyBodyFromField
19+ , comparePagesByDate
2020 ) where
2121
22−import Prelude hiding (id)
23−import Control.Category (id)
2422import Control.Arrow (Arrow, arr, (>>>), (***), (&&&))
23+import Control.Category (id)
24+import Control.Monad (msum)
2525import Data.List (intercalate)
26−import Data.Maybe (fromMaybe, fromJust, isJust)
27−import Data.Time.Clock (UTCTime)
28−import Data.Time.Format (parseTime, formatTime)
29−import qualified Data.Map as M
26+import Data.Maybe (fromMaybe)
27+import Data.Ord (comparing)
28+import Prelude hiding (id)
3029import System.FilePath (takeFileName)
3130import System.Locale (TimeLocale, defaultTimeLocale)
31+import qualified Data.Map as M
32+
33+import Data.Time.Calendar (Day (..))
34+import Data.Time.Clock (UTCTime (..))
35+import Data.Time.Format (parseTime, formatTime)
3236
3337import Hakyll.Web.Page.Internal
3438import Hakyll.Core.Util.String
@@ -122,10 +126,10 @@ copyField src dst = renderField src dst id
122126-- | When the metadata has a field called @published@ in one of the
123127-- following formats then this function can render the date.
124128--
125−-- * @Sun, 01 Feb 2000 13:00:00 UT@ (RSS date format)
129+-- * @Sun, 01 Feb 2000 13:00:00 UT@ (RSS date format)
130+--
131+-- * @2000-02-01T13:00:00Z@ (Atom date format)
126132--
127−-- * @2000-02-01T13:00:00Z@ (Atom date format)
128−--
129133-- * @February 1, 2000 1:00 PM@ (PM is usually uppercase)
130134--
131135-- * @February 1, 2000@ (assumes 12:00 AM for the time)
@@ -168,33 +172,17 @@ renderDateFieldWith locale key format defaultValue page =
168172getUTCMaybe :: TimeLocale -- ^ Output time locale
169173 -> Page a -- ^ Input page
170174 -> Maybe UTCTime -- ^ Parsed UTCTime
171−getUTCMaybe locale page = getUTCMaybe' formats
175+getUTCMaybe locale page = msum
176+ [ fromPublished "%a, %d %b %Y %H:%M:%S UT"
177+ , fromPublished "%Y-%m-%dT%H:%M:%SZ"
178+ , fromPublished "%B %e, %Y %l:%M %p"
179+ , fromPublished "%B %e, %Y"
180+ , getFieldMaybe "path" page >>= parseTime' "%Y-%m-%d" .
181+ intercalate "-" . take 3 . splitAll "-" . takeFileName
182+ ]
172183 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
180− let dateString = intercalate "-" $ take 3
181− $ splitAll "-" $ takeFileName filePath
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"
184+ fromPublished f = getFieldMaybe "published" page >>= parseTime' f
185+ parseTime' f str = parseTime locale f str
198186
199187-- | Set the modification time as a field in the page
200188renderModificationTime :: String
@@ -230,3 +218,11 @@ copyBodyFromField :: String -- ^ Source key
230218 -> Page String -- ^ Target page
231219 -> Page String -- ^ Resulting page
232220copyBodyFromField key page = fmap (const $ getField key page) page
221+
222+-- | Compare pages by the date and time parsed as in 'renderDateField',
223+-- where 'LT' implies earlier, and 'GT' implies later. For more details,
224+-- see 'renderDateField'.
225+comparePagesByDate :: Page a -> Page a -> Ordering
226+comparePagesByDate = comparing $ fromMaybe zero . getUTCMaybe defaultTimeLocale
227+ where
228+ zero = UTCTime (ModifiedJulianDay 0) 0