module Text.Hakyll.ContextManipulations
( renderValue
, changeValue
, changeUrl
, copyValue
, renderDate
, renderDateWithLocale
, changeExtension
, renderBody
) where
import Control.Monad (liftM)
import Control.Arrow (arr)
import System.Locale (TimeLocale, defaultTimeLocale)
import System.FilePath (takeFileName, addExtension, dropExtension)
import Data.Time.Format (parseTime, formatTime)
import Data.Time.Clock (UTCTime)
import Data.Maybe (fromMaybe)
import qualified Data.Map as M
import Text.Hakyll.Regex (substituteRegex)
import Text.Hakyll.HakyllAction (HakyllAction (..))
import Text.Hakyll.Context (Context (..))
renderValue :: String
-> String
-> (String -> String)
-> HakyllAction Context Context
renderValue source destination f = arr $ \(Context context) -> Context $
case M.lookup source context of
Nothing -> context
(Just value) -> M.insert destination (f value) context
changeValue :: String
-> (String -> String)
-> HakyllAction Context Context
changeValue key = renderValue key key
changeUrl :: (String -> String)
-> HakyllAction Context Context
changeUrl f = let action = changeValue "url" f
in action {actionUrl = Right $ liftM f}
copyValue :: String
-> String
-> HakyllAction Context Context
copyValue source destination = renderValue source destination id
renderDate :: String
-> String
-> String
-> HakyllAction Context Context
renderDate = renderDateWithLocale defaultTimeLocale
renderDateWithLocale :: TimeLocale
-> String
-> String
-> String
-> HakyllAction Context Context
renderDateWithLocale locale key format defaultValue =
renderValue "path" key renderDate'
where
renderDate' filePath = fromMaybe defaultValue $ do
let dateString = substituteRegex "^([0-9]*-[0-9]*-[0-9]*).*" "\\1"
(takeFileName filePath)
time <- parseTime defaultTimeLocale
"%Y-%m-%d"
dateString :: Maybe UTCTime
return $ formatTime locale format time
changeExtension :: String
-> HakyllAction Context Context
changeExtension extension = changeValue "url" changeExtension'
where
changeExtension' = flip addExtension extension . dropExtension
renderBody :: (String -> String)
-> HakyllAction Context Context
renderBody = renderValue "body" "body"