module Hakyll.Web.Page.Metadata
( getField
, getFieldMaybe
, setField
, trySetField
, setFieldA
, setFieldPage
, renderField
, changeField
, copyField
, renderDateField
, renderDateFieldWith
, renderModificationTime
, renderModificationTimeWith
, copyBodyToField
, copyBodyFromField
) where
import Prelude hiding (id)
import Control.Category (id)
import Control.Arrow (Arrow, arr, (>>>), (***), (&&&))
import Data.List (intercalate)
import Data.Maybe (fromMaybe)
import Data.Time.Clock (UTCTime)
import Data.Time.Format (parseTime, formatTime)
import qualified Data.Map as M
import System.FilePath (takeFileName)
import System.Locale (TimeLocale, defaultTimeLocale)
import Hakyll.Web.Page.Internal
import Hakyll.Core.Util.String
import Hakyll.Core.Identifier
import Hakyll.Core.Compiler
import Hakyll.Core.Resource.Provider
getField :: String
-> Page a
-> String
getField key = fromMaybe "" . getFieldMaybe key
getFieldMaybe :: String
-> Page a
-> Maybe String
getFieldMaybe key = M.lookup key . pageMetadata
setField :: String
-> String
-> Page a
-> Page a
setField k v (Page m b) = Page (M.insert k v m) b
trySetField :: String
-> String
-> Page a
-> Page a
trySetField k v (Page m b) = Page (M.insertWith (flip const) k v m) b
setFieldA :: Arrow a
=> String
-> a x String
-> a (Page b, x) (Page b)
setFieldA k v = id *** v >>> arr (uncurry $ flip $ setField k)
setFieldPage :: String
-> Identifier (Page String)
-> Compiler (Page a) (Page a)
setFieldPage key page = id &&& require_ page >>> setFieldA key (arr pageBody)
renderField :: String
-> String
-> (String -> String)
-> Page a
-> Page a
renderField src dst f page = case M.lookup src (pageMetadata page) of
Nothing -> page
Just value -> setField dst (f value) page
changeField :: String
-> (String -> String)
-> Page a
-> Page a
changeField key = renderField key key
copyField :: String
-> String
-> Page a
-> Page a
copyField src dst = renderField src dst id
renderDateField :: String
-> String
-> String
-> Page a
-> Page a
renderDateField = renderDateFieldWith defaultTimeLocale
renderDateFieldWith :: TimeLocale
-> String
-> String
-> String
-> Page a
-> Page a
renderDateFieldWith locale key format defaultValue =
renderField "path" key renderDate'
where
renderDate' filePath = fromMaybe defaultValue $ do
let dateString = intercalate "-" $ take 3
$ splitAll "-" $ takeFileName filePath
time <- parseTime defaultTimeLocale
"%Y-%m-%d"
dateString :: Maybe UTCTime
return $ formatTime locale format time
renderModificationTime :: String
-> String
-> Compiler (Page String) (Page String)
renderModificationTime = renderModificationTimeWith defaultTimeLocale
renderModificationTimeWith :: TimeLocale
-> String
-> String
-> Compiler (Page String) (Page String)
renderModificationTimeWith locale key format =
id &&& (getResource >>> getResourceWith resourceModificationTime) >>>
setFieldA key (arr (formatTime locale format))
copyBodyToField :: String
-> Page String
-> Page String
copyBodyToField key page = setField key (pageBody page) page
copyBodyFromField :: String
-> Page String
-> Page String
copyBodyFromField key page = fmap (const $ getField key page) page