diff options
Diffstat (limited to 'src/Hakyll/Web')
| -rw-r--r-- | src/Hakyll/Web/Template/Context.hs | 104 |
1 files changed, 101 insertions, 3 deletions
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 @@ -85,5 +99,89 @@ 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 ++ "$" |