summaryrefslogtreecommitdiff
path: root/src/Hakyll/Web/Template
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll/Web/Template')
-rw-r--r--src/Hakyll/Web/Template/Context.hs35
-rw-r--r--src/Hakyll/Web/Template/Internal.hs7
-rw-r--r--src/Hakyll/Web/Template/Read.hs15
3 files changed, 39 insertions, 18 deletions
diff --git a/src/Hakyll/Web/Template/Context.hs b/src/Hakyll/Web/Template/Context.hs
index 74c2e8d..7b2d920 100644
--- a/src/Hakyll/Web/Template/Context.hs
+++ b/src/Hakyll/Web/Template/Context.hs
@@ -1,10 +1,11 @@
--------------------------------------------------------------------------------
+{-# LANGUAGE ExistentialQuantification #-}
module Hakyll.Web.Template.Context
- ( Context (..)
- , mapContext
+ ( ContextField (..)
+ , Context (..)
, field
, constField
- , functionField
+ , listField
, defaultContext
, teaserContext
@@ -46,8 +47,15 @@ import Hakyll.Web.Html
--------------------------------------------------------------------------------
+-- | Mostly for internal usage
+data ContextField
+ = StringField String
+ | forall a. ListField (Context a) [Item a]
+
+
+--------------------------------------------------------------------------------
newtype Context a = Context
- { unContext :: String -> Item a -> Compiler String
+ { unContext :: String -> Item a -> Compiler ContextField
}
@@ -58,13 +66,13 @@ instance Monoid (Context a) where
--------------------------------------------------------------------------------
-mapContext :: (String -> String) -> Context a -> Context a
-mapContext f (Context g) = Context $ \k i -> f <$> 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 = Context $ \k i -> if k == key then value i else empty
+field key value = field' key (fmap StringField . value)
--------------------------------------------------------------------------------
@@ -73,12 +81,8 @@ 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
+listField :: String -> Context a -> Compiler [Item a] -> Context b
+listField key c xs = field' key $ \_ -> fmap (ListField c) xs
--------------------------------------------------------------------------------
@@ -91,6 +95,7 @@ defaultContext =
titleField "title" `mappend`
missingField
+
--------------------------------------------------------------------------------
-- | A context with "teaser" key which contain a teaser of the item.
-- The item is loaded from the given snapshot (which should be saved
@@ -116,7 +121,7 @@ bodyField key = field key $ return . itemBody
metadataField :: Context String
metadataField = Context $ \k i -> do
value <- getMetadataField (itemIdentifier i) k
- maybe empty return value
+ maybe empty (return . StringField) value
--------------------------------------------------------------------------------
@@ -135,7 +140,7 @@ pathField key = field key $ return . toFilePath . itemIdentifier
--------------------------------------------------------------------------------
-- | This title field takes the basename of the underlying file by default
titleField :: String -> Context a
-titleField key = mapContext takeBaseName $ pathField key
+titleField key = field key $ return . takeBaseName . toFilePath . itemIdentifier
--------------------------------------------------------------------------------
diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs
index f939566..1c81670 100644
--- a/src/Hakyll/Web/Template/Internal.hs
+++ b/src/Hakyll/Web/Template/Internal.hs
@@ -37,7 +37,8 @@ data TemplateElement
= Chunk String
| Key String
| Escaped
- | If String Template (Maybe Template) -- key, then branch, else branch
+ | If String Template (Maybe Template) -- key, then branch, else branch
+ | For String Template (Maybe Template) -- key, body, separator
deriving (Show, Eq, Typeable)
@@ -47,11 +48,13 @@ instance Binary TemplateElement where
put (Key key) = putWord8 1 >> put key
put (Escaped) = putWord8 2
put (If key t f) = putWord8 3 >> put key >> put t >> put f
+ put (For key b s) = putWord8 4 >> put key >> put b >> put s
get = getWord8 >>= \tag -> case tag of
0 -> Chunk <$> get
1 -> Key <$> get
2 -> pure Escaped
- 3 -> If <$> get <*> get <*> get
+ 3 -> If <$> get <*> get <*> get
+ 4 -> For <$> get <*> get <*> get
_ -> error $
"Hakyll.Web.Template.Internal: Error reading cached template"
diff --git a/src/Hakyll/Web/Template/Read.hs b/src/Hakyll/Web/Template/Read.hs
index 620ce14..2dd0fc5 100644
--- a/src/Hakyll/Web/Template/Read.hs
+++ b/src/Hakyll/Web/Template/Read.hs
@@ -26,7 +26,8 @@ readTemplate input = case parse template "" input of
--------------------------------------------------------------------------------
template :: Parser Template
-template = Template <$> (many1 $ chunk <|> escaped <|> conditional <|> key)
+template = Template <$>
+ (many1 $ chunk <|> escaped <|> conditional <|> for <|> key)
--------------------------------------------------------------------------------
@@ -52,6 +53,18 @@ conditional = try $ do
--------------------------------------------------------------------------------
+for :: Parser TemplateElement
+for = try $ do
+ void $ string "$for("
+ i <- metadataKey
+ void $ string ")$"
+ body <- template
+ sep <- optionMaybe $ try (string "$sep$") >> template
+ void $ string "$endfor$"
+ return $ For i body sep
+
+
+--------------------------------------------------------------------------------
key :: Parser TemplateElement
key = try $ do
void $ char '$'