@@ -12,23 +12,27 @@ module Hakyll.Web.Page.Metadata
12 , copyField
12 , copyField
13 , renderDateField
13 , renderDateField
14 , renderDateFieldWith
14 , renderDateFieldWith
16 , renderModificationTime
15 , renderModificationTime
17 , renderModificationTimeWith
16 , renderModificationTimeWith
18 , copyBodyToField
17 , copyBodyToField
19 , copyBodyFromField
18 , copyBodyFromField
22−import Prelude hiding (id)
23−import Control.Category (id)
24import Control.Arrow (Arrow, arr, (>>>), (***), (&&&))
22import Control.Arrow (Arrow, arr, (>>>), (***), (&&&))
23+import Control.Category (id)
24+import Control.Monad (msum)
25import Data.List (intercalate)
25import Data.List (intercalate)
26−import Data.Maybe (fromMaybe, fromJust, isJust)
26+import Data.Maybe (fromMaybe)
27−import Data.Time.Clock (UTCTime)
27+import Data.Ord (comparing)
28−import Data.Time.Format (parseTime, formatTime)
28+import Prelude hiding (id)
29−import qualified Data.Map as M
30import System.FilePath (takeFileName)
29import System.FilePath (takeFileName)
31import System.Locale (TimeLocale, defaultTimeLocale)
30import System.Locale (TimeLocale, defaultTimeLocale)
31+import qualified Data.Map as M
33+import Data.Time.Calendar (Day (..))
34+import Data.Time.Clock (UTCTime (..))
35+import Data.Time.Format (parseTime, formatTime)
33import Hakyll.Web.Page.Internal
37import Hakyll.Web.Page.Internal
34import Hakyll.Core.Util.String
38import Hakyll.Core.Util.String
@@ -122,10 +126,10 @@ copyField src dst = renderField src dst id
122-- | When the metadata has a field called @published@ in one of the
126-- | When the metadata has a field called @published@ in one of the
123-- following formats then this function can render the date.
127-- following formats then this function can render the date.
125−-- * @Sun, 01 Feb 2000 13:00:00 UT@ (RSS date format)
129+-- * @Sun, 01 Feb 2000 13:00:00 UT@ (RSS date format)
131+-- * @2000-02-01T13:00:00Z@ (Atom date format)
127−-- * @2000-02-01T13:00:00Z@ (Atom date format)
129-- * @February 1, 2000 1:00 PM@ (PM is usually uppercase)
133-- * @February 1, 2000 1:00 PM@ (PM is usually uppercase)
131-- * @February 1, 2000@ (assumes 12:00 AM for the time)
135-- * @February 1, 2000@ (assumes 12:00 AM for the time)
@@ -168,33 +172,17 @@ renderDateFieldWith locale key format defaultValue page =
168getUTCMaybe :: TimeLocale -- ^ Output time locale
172getUTCMaybe :: TimeLocale -- ^ Output time locale
169 -> Page a -- ^ Input page
173 -> Page a -- ^ Input page
170 -> Maybe UTCTime -- ^ Parsed UTCTime
174 -> 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
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"
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
185− else getUTCMaybe' fs
186− where timeMaybe = do dateString <- getFieldMaybe "published" page
184+ fromPublished f = getFieldMaybe "published" page >>= parseTime' f
187− parseTime locale f dateString :: Maybe UTCTime
185+ parseTime' f str = parseTime locale f str
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"
199-- | Set the modification time as a field in the page
187-- | Set the modification time as a field in the page
200renderModificationTime :: String
188renderModificationTime :: String
@@ -230,3 +218,11 @@ copyBodyFromField :: String -- ^ Source key
230 -> Page String -- ^ Target page
218 -> Page String -- ^ Target page
231 -> Page String -- ^ Resulting page
219 -> Page String -- ^ Resulting page
232copyBodyFromField key page = fmap (const $ getField key page) page
220copyBodyFromField key page = fmap (const $ getField key page) page
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
228+ zero = UTCTime (ModifiedJulianDay 0) 0