From 1347b0fa6cdd98986f927368e76e849068f69e1a Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <m@jaspervdj.be>
Date: Sun, 18 Nov 2012 11:22:13 +0100
Subject: Add some time-related fields
---
src/Hakyll/Web/Template/Context.hs | 104 +++++++++++++++++++++++++++++++++++--
1 file changed, 101 insertions(+), 3 deletions(-)
(limited to 'src')
diff --git a/src/Hakyll/Web/Template/Context.hs b/src/Hakyll/Web/Template/Context.hs
index 9c3e412..2ef82e9 100644
--- a/src/Hakyll/Web/Template/Context.hs
+++ b/src/Hakyll/Web/Template/Context.hs
@@ -10,18 +10,32 @@ module Hakyll.Web.Template.Context
, pathField
, categoryField
, titleField
+ , dateField
+ , dateFieldWith
+ , modificationTimeField
+ , modificationTimeFieldWith
) where
--------------------------------------------------------------------------------
-import Control.Applicative (Alternative (..), (<$>))
-import Data.Monoid (Monoid (..))
-import System.FilePath (takeBaseName, takeDirectory)
+import Control.Applicative (Alternative (..), (<$>))
+import Control.Monad (msum)
+import Data.List (intercalate)
+import qualified Data.Map as M
+import Data.Monoid (Monoid (..))
+import Data.Time.Clock (UTCTime (..))
+import Data.Time.Format (formatTime, parseTime)
+import System.FilePath (takeBaseName, takeDirectory,
+ takeFileName)
+import System.Locale (TimeLocale, defaultTimeLocale)
--------------------------------------------------------------------------------
import Hakyll.Core.Compiler
+import Hakyll.Core.Compiler.Internal
import Hakyll.Core.Identifier
+import Hakyll.Core.ResourceProvider
+import Hakyll.Core.Util.String (splitAll)
import Hakyll.Web.Page.Internal
import Hakyll.Web.Urls
@@ -84,6 +98,90 @@ titleField :: String -> Context a
titleField key = mapContext takeBaseName $ pathField key
+--------------------------------------------------------------------------------
+-- | 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)
+--
+-- * @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)
+--
+-- Alternatively, when the metadata has a field called @path@ in a
+-- @folder/yyyy-mm-dd-title.extension@ format (the convention for pages)
+-- and no @published@ metadata field set, this function can render
+-- the date.
+--
+-- > renderDateField "date" "%B %e, %Y" "Date unknown"
+--
+-- Will render something like @January 32, 2010@.
+--
+dateField :: String -- ^ Key in which the rendered date should be placed
+ -> String -- ^ Format to use on the date
+ -> Context a -- ^ Resulting context
+dateField = dateFieldWith defaultTimeLocale
+
+
+--------------------------------------------------------------------------------
+-- | This is an extended version of 'dateField' that allows you to
+-- specify a time locale that is used for outputting the date. For more
+-- details, see 'dateField'.
+dateFieldWith :: TimeLocale -- ^ Output time locale
+ -> String -- ^ Destination key
+ -> String -- ^ Format to use on the date
+ -> Context a -- ^ Resulting context
+dateFieldWith locale key format = field key $ \id' _ -> do
+ time <- getUTC locale id'
+ return $ formatTime locale format time
+
+
+--------------------------------------------------------------------------------
+-- | Parser to try to extract and parse the time from the @published@
+-- field or from the filename. See 'renderDateField' for more information.
+getUTC :: TimeLocale -- ^ Output time locale
+ -> Identifier -- ^ Input page
+ -> Compiler UTCTime -- ^ Parsed UTCTime
+getUTC locale id' = do
+ metadata <- getMetadataFor id'
+ let tryField k fmt = M.lookup k metadata >>= parseTime' fmt
+ fn = takeFileName $ toFilePath id'
+
+ maybe empty return $ msum $
+ [tryField "published" fmt | fmt <- formats] ++
+ [tryField "date" fmt | fmt <- formats] ++
+ [parseTime' "%Y-%m-%d" $ intercalate "-" $ take 3 $ splitAll "-" fn]
+ where
+ parseTime' = parseTime locale
+ formats =
+ [ "%a, %d %b %Y %H:%M:%S UT"
+ , "%Y-%m-%dT%H:%M:%SZ"
+ , "%Y-%m-%d %H:%M:%S"
+ , "%Y-%m-%d"
+ , "%B %e, %Y %l:%M %p"
+ , "%B %e, %Y"
+ ]
+
+
+--------------------------------------------------------------------------------
+modificationTimeField :: String -- ^ Key
+ -> String -- ^ Format
+ -> Context a -- ^ Resuting context
+modificationTimeField = modificationTimeFieldWith defaultTimeLocale
+
+
+--------------------------------------------------------------------------------
+modificationTimeFieldWith :: TimeLocale -- ^ Time output locale
+ -> String -- ^ Key
+ -> String -- ^ Format
+ -> Context a -- ^ Resulting context
+modificationTimeFieldWith locale key fmt = field key $ \id' _ -> do
+ mtime <- compilerUnsafeIO $ resourceModificationTime id'
+ return $ formatTime locale fmt mtime
+
+
--------------------------------------------------------------------------------
missingField :: Context a
missingField = Context $ \k _ _ -> return $ "$" ++ k ++ "$"
--
cgit v1.2.3