Implement foreach structure

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 '$'