2012-11-10 12:26:39 +00:00
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
|
module Hakyll.Web.Template.Context
|
|
|
|
|
( Context
|
|
|
|
|
, field
|
2012-11-10 15:30:38 +00:00
|
|
|
|
|
|
|
|
, defaultContext
|
|
|
|
|
, bodyField
|
|
|
|
|
, urlField
|
|
|
|
|
, pathField
|
|
|
|
|
, categoryField
|
|
|
|
|
, titleField
|
2012-11-10 12:26:39 +00:00
|
|
|
) where
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2012-11-10 15:30:38 +00:00
|
|
|
import Control.Applicative (empty, (<|>))
|
2012-11-10 12:26:39 +00:00
|
|
|
import Control.Arrow
|
2012-11-10 15:30:38 +00:00
|
|
|
import System.FilePath (takeBaseName, takeDirectory)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2012-11-10 12:26:39 +00:00
|
|
|
import Hakyll.Core.Compiler
|
2012-11-10 15:30:38 +00:00
|
|
|
import Hakyll.Core.Identifier
|
|
|
|
|
import Hakyll.Web.Urls
|
2012-11-10 12:26:39 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
|
type Context a = Compiler (String, a) String
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
|
field :: String -> Compiler a String -> Context a
|
|
|
|
|
field key value = arr checkKey >>> empty ||| value
|
|
|
|
|
where
|
|
|
|
|
checkKey (k, x)
|
|
|
|
|
| k == key = Left ()
|
|
|
|
|
| otherwise = Right x
|
2012-11-10 15:30:38 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
|
defaultContext :: Context (Identifier String, String)
|
|
|
|
|
defaultContext =
|
|
|
|
|
bodyField "body" <|>
|
|
|
|
|
urlField "url" <|>
|
|
|
|
|
pathField "path" <|>
|
|
|
|
|
categoryField "category" <|>
|
|
|
|
|
titleField "title"
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
|
bodyField :: String -> Context (Identifier String, String)
|
|
|
|
|
bodyField key = field key $ arr snd
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
|
urlField :: String -> Context (Identifier a, a)
|
|
|
|
|
urlField key = field key $ fst ^>> getRouteFor >>^ maybe empty toUrl
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
|
pathField :: String -> Context (Identifier a, a)
|
|
|
|
|
pathField key = field key $ arr $ toFilePath . fst
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
|
categoryField :: String -> Context (Identifier a, a)
|
|
|
|
|
categoryField key = pathField key >>^ (takeBaseName . takeDirectory)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
|
titleField :: String -> Context (Identifier a, a)
|
|
|
|
|
titleField key = pathField key >>^ takeBaseName
|
