Write getUTCMaybe using mplus, minor cleanup

See #53

1 files changed, 32 insertions, 36 deletions

diff --git a/src/Hakyll/Web/Page/Metadata.hs b/src/Hakyll/Web/Page/Metadata.hs
index 948c349..8873afc 100644
--- a/src/Hakyll/Web/Page/Metadata.hs
+++ b/src/Hakyll/Web/Page/Metadata.hs
@@ -12,23 +12,27 @@ module Hakyll.Web.Page.Metadata
     , copyField
     , renderDateField
     , renderDateFieldWith
-    , comparePagesByDate
     , renderModificationTime
     , renderModificationTimeWith
     , copyBodyToField
     , copyBodyFromField
+    , comparePagesByDate
     ) where
 
-import Prelude hiding (id)
-import Control.Category (id)
 import Control.Arrow (Arrow, arr, (>>>), (***), (&&&))
+import Control.Category (id)
+import Control.Monad (msum)
 import Data.List (intercalate)
-import Data.Maybe (fromMaybe, fromJust, isJust)
-import Data.Time.Clock (UTCTime)
-import Data.Time.Format (parseTime, formatTime)
-import qualified Data.Map as M
+import Data.Maybe (fromMaybe)
+import Data.Ord (comparing)
+import Prelude hiding (id)
 import System.FilePath (takeFileName)
 import System.Locale (TimeLocale, defaultTimeLocale)
+import qualified Data.Map as M
+
+import Data.Time.Calendar (Day (..))
+import Data.Time.Clock (UTCTime (..))
+import Data.Time.Format (parseTime, formatTime)
 
 import Hakyll.Web.Page.Internal
 import Hakyll.Core.Util.String
@@ -122,10 +126,10 @@ copyField src dst = renderField src dst id
 -- | When the metadata has a field called @published@ in one of the
 -- following formats then this function can render the date.
 --
---   * @Sun, 01 Feb 2000 13:00:00 UT@ (RSS date format)                                  
+--   * @Sun, 01 Feb 2000 13:00:00 UT@ (RSS date format)
+--
+--   * @2000-02-01T13:00:00Z@ (Atom date format)
 --
---   * @2000-02-01T13:00:00Z@ (Atom date format)                                         
--- 
 --   * @February 1, 2000 1:00 PM@ (PM is usually uppercase)
 --
 --   * @February 1, 2000@ (assumes 12:00 AM for the time)
@@ -168,33 +172,17 @@ renderDateFieldWith locale key format defaultValue page =
 getUTCMaybe :: TimeLocale     -- ^ Output time locale
             -> Page a         -- ^ Input page
             -> Maybe UTCTime  -- ^ Parsed UTCTime
-getUTCMaybe locale page = getUTCMaybe' formats
+getUTCMaybe locale page = msum
+    [ fromPublished "%a, %d %b %Y %H:%M:%S UT"
+    , fromPublished "%Y-%m-%dT%H:%M:%SZ"
+    , fromPublished "%B %e, %Y %l:%M %p"
+    , fromPublished "%B %e, %Y"
+    , getFieldMaybe "path" page >>= parseTime' "%Y-%m-%d" .
+        intercalate "-" . take 3 . splitAll "-" . takeFileName
+    ]
   where
-    formats = [ "%a, %d %b %Y %H:%M:%S UT" -- RSS format
-              , "%Y-%m-%dT%H:%M:%SZ"       -- Atom format
-              , "%B %e, %Y %l:%M %p" 
-              , "%B %e, %Y" 
-              ]
-    getUTCMaybe' [] = do
-        filePath <- getFieldMaybe "path" page
-        let dateString = intercalate "-" $ take 3
-                       $ splitAll "-" $ takeFileName filePath
-        parseTime locale "%Y-%m-%d" dateString :: Maybe UTCTime
-    getUTCMaybe' (f:fs) = if isJust timeMaybe
-                             then timeMaybe
-                             else getUTCMaybe' fs
-        where timeMaybe = do dateString <- getFieldMaybe "published" page
-                             parseTime locale f dateString :: Maybe UTCTime
-
--- | Compare pages by the date and time parsed as in 'renderDateField',
--- where 'LT' implies earlier, and 'GT' implies later. For more details,
--- see 'renderDateField'.
-comparePagesByDate :: Page a -> Page a -> Ordering
-comparePagesByDate p1 p2 = compare p1UTC p2UTC
-  where p1UTC       = fromMaybe defaultTime $ getUTCMaybe defaultTimeLocale p1
-        p2UTC       = fromMaybe defaultTime $ getUTCMaybe defaultTimeLocale p2
-        defaultTime = fromJust $ parseTime defaultTimeLocale
-            "%B %e, %Y %l:%M %p" "January 1, 1900 12:00 AM"
+    fromPublished f  = getFieldMaybe "published" page >>= parseTime' f
+    parseTime' f str = parseTime locale f str
 
 -- | Set the modification time as a field in the page
 renderModificationTime :: String
@@ -230,3 +218,11 @@ copyBodyFromField :: String       -- ^ Source key
                   -> Page String  -- ^ Target page
                   -> Page String  -- ^ Resulting page
 copyBodyFromField key page = fmap (const $ getField key page) page
+
+-- | Compare pages by the date and time parsed as in 'renderDateField',
+-- where 'LT' implies earlier, and 'GT' implies later. For more details,
+-- see 'renderDateField'.
+comparePagesByDate :: Page a -> Page a -> Ordering
+comparePagesByDate = comparing $ fromMaybe zero . getUTCMaybe defaultTimeLocale
+  where
+    zero = UTCTime (ModifiedJulianDay 0) 0