module Hakyll.Web.Template.Context
( ContextField (..)
, Context (..)
, field
, constField
, listField
, defaultContext
, bodyField
, metadataField
, urlField
, pathField
, titleField
, dateField
, dateFieldWith
, getItemUTC
, modificationTimeField
, modificationTimeFieldWith
, teaserField
, 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, needlePrefix)
import Hakyll.Web.Html
data ContextField
= StringField String
| forall a. ListField (Context a) [Item a]
newtype Context a = Context
{ unContext :: String -> Item a -> Compiler ContextField
}
instance Monoid (Context a) where
mempty = missingField
mappend (Context f) (Context g) = Context $ \k i -> f k i <|> g k i
field' :: String -> (Item a -> Compiler ContextField) -> Context a
field' key value = Context $ \k i -> if k == key then value i else empty
field :: String -> (Item a -> Compiler String) -> Context a
field key value = field' key (fmap StringField . value)
constField :: String -> String -> Context a
constField key = field key . const . return
listField :: String -> Context a -> Compiler [Item a] -> Context b
listField key c xs = field' key $ \_ -> fmap (ListField c) xs
defaultContext :: Context String
defaultContext =
bodyField "body" `mappend`
metadataField `mappend`
urlField "url" `mappend`
pathField "path" `mappend`
titleField "title" `mappend`
missingField
teaserSeparator :: String
teaserSeparator = "<!--more-->"
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 . StringField) 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 = field key $ return . takeBaseName . toFilePath . itemIdentifier
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"
, "%b %d, %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
teaserField :: String
-> Snapshot
-> Context String
teaserField key snapshot = field key $ \item ->
(needlePrefix teaserSeparator . itemBody) <$>
loadSnapshot (itemIdentifier item) snapshot
missingField :: Context a
missingField = Context $ \k i -> fail $
"Missing field $" ++ k ++ "$ in context for item " ++
show (itemIdentifier i)