module Hakyll.Web.Template.Context
( Context (..)
, mapContext
, field
, constField
, functionField
, defaultContext
, bodyField
, metadataField
, urlField
, pathField
, titleField
, dateField
, dateFieldWith
, getItemUTC
, modificationTimeField
, modificationTimeFieldWith
, missingField
) where
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, takeFileName)
import System.Locale (TimeLocale, defaultTimeLocale)
import Hakyll.Core.Compiler
import Hakyll.Core.Compiler.Internal
import Hakyll.Core.Identifier
import Hakyll.Core.Item
import Hakyll.Core.Metadata
import Hakyll.Core.Provider
import Hakyll.Core.Util.String (splitAll)
import Hakyll.Web.Html
newtype Context a = Context
{ unContext :: String -> Item a -> Compiler String
}
instance Monoid (Context a) where
mempty = missingField
mappend (Context f) (Context g) = Context $ \k i -> f k i <|> g k i
mapContext :: (String -> String) -> Context a -> Context a
mapContext f (Context g) = Context $ \k i -> f <$> g k i
field :: String -> (Item a -> Compiler String) -> Context a
field key value = Context $ \k i -> if k == key then value i else empty
constField :: String -> String -> Context a
constField key = field key . const . return
functionField :: String -> ([String] -> Item a -> Compiler String) -> Context a
functionField name value = Context $ \k i -> case words k of
[] -> empty
(n : args)
| n == name -> value args i
| otherwise -> empty
defaultContext :: Context String
defaultContext =
bodyField "body" `mappend`
metadataField `mappend`
urlField "url" `mappend`
pathField "path" `mappend`
titleField "title" `mappend`
missingField
bodyField :: String -> Context String
bodyField key = field key $ return . itemBody
metadataField :: Context String
metadataField = Context $ \k i -> do
value <- getMetadataField (itemIdentifier i) k
maybe empty return value
urlField :: String -> Context a
urlField key = field key $
fmap (maybe empty toUrl) . getRoute . itemIdentifier
pathField :: String -> Context a
pathField key = field key $ return . toFilePath . itemIdentifier
titleField :: String -> Context a
titleField key = mapContext takeBaseName $ pathField key
dateField :: String
-> String
-> Context a
dateField = dateFieldWith defaultTimeLocale
dateFieldWith :: TimeLocale
-> String
-> String
-> Context a
dateFieldWith locale key format = field key $ \i -> do
time <- getItemUTC locale $ itemIdentifier i
return $ formatTime locale format time
getItemUTC :: MonadMetadata m
=> TimeLocale
-> Identifier
-> m UTCTime
getItemUTC locale id' = do
metadata <- getMetadata 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
empty' = fail $ "Hakyll.Web.Template.Context.getItemUTC: " ++
"could not parse time for " ++ show id'
parseTime' = parseTime locale
formats =
[ "%a, %d %b %Y %H:%M:%S %Z"
, "%Y-%m-%dT%H:%M:%S%Z"
, "%Y-%m-%d %H:%M:%S%Z"
, "%Y-%m-%d"
, "%B %e, %Y %l:%M %p"
, "%B %e, %Y"
]
modificationTimeField :: String
-> String
-> Context a
modificationTimeField = modificationTimeFieldWith defaultTimeLocale
modificationTimeFieldWith :: TimeLocale
-> String
-> String
-> Context a
modificationTimeFieldWith locale key fmt = field key $ \i -> do
provider <- compilerProvider <$> compilerAsk
let mtime = resourceModificationTime provider $ itemIdentifier i
return $ formatTime locale fmt mtime
missingField :: Context a
missingField = Context $ \k i -> compilerThrow $
"Missing field $" ++ k ++ "$ in context for item " ++
show (itemIdentifier i)