diff --git a/src/Hakyll/Web/Template.hs b/src/Hakyll/Web/Template.hs
index 07a8ff3..371ccef 100644
--- a/src/Hakyll/Web/Template.hs
+++ b/src/Hakyll/Web/Template.hs
@@ -44,7 +44,8 @@ module Hakyll.Web.Template
--------------------------------------------------------------------------------
-import Control.Monad (forM, liftM)
+import Control.Monad (liftM)
+import Control.Monad.Error (MonadError(..))
import Data.Monoid (mappend)
import Prelude hiding (id)
@@ -112,11 +113,17 @@ applyAsTemplate context item =
--------------------------------------------------------------------------------
-- | Overloaded apply template function to work in an arbitrary Monad.
-applyTemplateWith :: Monad m
+applyTemplateWith :: MonadError e m
=> (String -> a -> m String)
-> Template -> a -> m String
-applyTemplateWith context tpl x = liftM concat $
- forM (unTemplate tpl) $ \e -> case e of
- Chunk c -> return c
- Escaped -> return "$"
- Key k -> context k x
+applyTemplateWith context tpl x = go tpl where
+
+ go = liftM concat . mapM applyElem . unTemplate
+
+ applyElem (Chunk c) = return c
+ applyElem Escaped = return "$"
+ applyElem (Key k) = context k x
+ applyElem (If k t mf) = (context k x >> go t) `catchError` handler where
+ handler _ = case mf of
+ Nothing -> return ""
+ Just f -> go f
diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs
index e264731..0bd999e 100644
--- a/src/Hakyll/Web/Template/Internal.hs
+++ b/src/Hakyll/Web/Template/Internal.hs
@@ -9,7 +9,7 @@ module Hakyll.Web.Template.Internal
--------------------------------------------------------------------------------
-import Control.Applicative ((<$>))
+import Control.Applicative (pure, (<$>), (<*>))
import Data.Binary (Binary, get, getWord8, put, putWord8)
import Data.Typeable (Typeable)
@@ -38,18 +38,20 @@ data TemplateElement
= Chunk String
| Key String
| Escaped
+ | If String Template (Maybe Template) -- key, then branch, else branch
deriving (Show, Eq, Typeable)
-
--------------------------------------------------------------------------------
instance Binary TemplateElement where
- put (Chunk string) = putWord8 0 >> put string
- put (Key key) = putWord8 1 >> put key
+ put (Chunk string) = putWord8 0 >> put string
+ put (Key key) = putWord8 1 >> put key
put (Escaped) = putWord8 2
+ put (If key t f) = putWord8 3 >> put key >> put t >> put f
get = getWord8 >>= \tag -> case tag of
0 -> Chunk <$> get
1 -> Key <$> get
- 2 -> return Escaped
+ 2 -> pure Escaped
+ 3 -> If <$> 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 7dfe003..4ef5f2f 100644
--- a/src/Hakyll/Web/Template/Read.hs
+++ b/src/Hakyll/Web/Template/Read.hs
@@ -4,38 +4,56 @@ module Hakyll.Web.Template.Read
( readTemplate
) where
-
--------------------------------------------------------------------------------
-import Data.List (isPrefixOf)
-
+import Control.Applicative ((<$>), (<$), (<*>))
+import Control.Monad (void, mzero, guard)
+import Text.Parsec
+import Text.Parsec.String
--------------------------------------------------------------------------------
import Hakyll.Web.Template.Internal
-
--------------------------------------------------------------------------------
--- | Construct a @Template@ from a string.
+
readTemplate :: String -> Template
-readTemplate = Template . readTemplate'
- where
- readTemplate' [] = []
- readTemplate' string
- | "$$" `isPrefixOf` string =
- Escaped : readTemplate' (drop 2 string)
- | "$" `isPrefixOf` string =
- case readKey (drop 1 string) of
- Just (key, rest) -> Key key : readTemplate' rest
- Nothing -> Chunk "$" : readTemplate' (drop 1 string)
- | otherwise =
- let (chunk, rest) = break (== '$') string
- in Chunk chunk : readTemplate' rest
+readTemplate input =
+ case parse template "" input of
+ Left err -> error $ "Cannot parse template: " ++ show err
+ Right t -> t
- -- Parse an key into (key, rest) if it's valid, and return
- -- Nothing otherwise
- readKey string =
- let (key, rest) = span validKeyChar string
- in if not (null key) && "$" `isPrefixOf` rest
- then Just (key, drop 1 rest)
- else Nothing
+template :: Parser Template
+template = Template <$>
+ (many1 $ chunk <|> escaped <|> conditional <|> key)
- validKeyChar x = x `notElem` ['$', '\n', '\r']
+chunk :: Parser TemplateElement
+chunk = Chunk <$> (many1 $ noneOf "$")
+
+escaped :: Parser TemplateElement
+escaped = Escaped <$ (try $ string "$$")
+
+conditional :: Parser TemplateElement
+conditional = try $ do
+ void $ string "$if("
+ i <- ident
+ void $ string ")$"
+ thenBranch <- template
+ elseBranch <- optionMaybe $ try (string "$else$") >> template
+ void $ string "$endif$"
+ return $ If i thenBranch elseBranch
+
+ident :: Parser String
+ident = do
+ i <- (:) <$> letter <*> (many $ alphaNum <|> oneOf " _-.")
+ if i `elem` reserved
+ then mzero
+ else return i
+
+reserved :: [String]
+reserved = ["if", "else","endif"]
+
+key :: Parser TemplateElement
+key = try $ do
+ void $ char '$'
+ k <- ident
+ void $ char '$'
+ return $ Key k
diff --git a/tests/data/template.html b/tests/data/template.html
index 153303c..a8d78eb 100644
--- a/tests/data/template.html
+++ b/tests/data/template.html
@@ -1,5 +1,5 @@
I'm so rich I have $$3.
- $echo test!$
+ $echo test$
$body$
diff --git a/tests/data/template.html.out b/tests/data/template.html.out
index 07b0851..8bd1879 100644
--- a/tests/data/template.html.out
+++ b/tests/data/template.html.out
@@ -1,5 +1,5 @@
I'm so rich I have $3.
- test!
+ test
This is an example.