summaryrefslogtreecommitdiff
path: root/src/Hakyll/Web
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll/Web')
-rw-r--r--src/Hakyll/Web/Template.hs14
-rw-r--r--src/Hakyll/Web/Template/Internal.hs5
-rw-r--r--src/Hakyll/Web/Template/Read.hs22
3 files changed, 36 insertions, 5 deletions
diff --git a/src/Hakyll/Web/Template.hs b/src/Hakyll/Web/Template.hs
index 45d1b92..76911e0 100644
--- a/src/Hakyll/Web/Template.hs
+++ b/src/Hakyll/Web/Template.hs
@@ -87,14 +87,18 @@ applyTemplate' tpl context x = go tpl
context' = unContext (context `mappend` missingField)
go = liftM concat . mapM applyElem . unTemplate
- applyElem (Chunk c) = return c
- applyElem Escaped = return "$"
- applyElem (Key k) = context' k x >>= getString k
+ applyElem (Chunk c) = return c
+
+ applyElem Escaped = return "$"
+
+ applyElem (Key k) = context' k x >>= getString k
+
applyElem (If k t mf) = (context' k x >> go t) `catchError` handler
where
handler _ = case mf of
Nothing -> return ""
Just f -> go f
+
applyElem (For k b s) = context' k x >>= \cf -> case cf of
StringField _ -> fail $
"Hakyll.Web.Template.applyTemplateWith: expected ListField but " ++
@@ -104,6 +108,10 @@ applyTemplate' tpl context x = go tpl
bs <- mapM (applyTemplate' b c) xs
return $ intercalate sep bs
+ applyElem (Partial p) = do
+ tpl' <- loadBody (fromFilePath p)
+ applyTemplate' tpl' context x
+
getString _ (StringField s) = return s
getString k (ListField _ _) = fail $
"Hakyll.Web.Template.applyTemplateWith: expected StringField but " ++
diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs
index 1c81670..138010e 100644
--- a/src/Hakyll/Web/Template/Internal.hs
+++ b/src/Hakyll/Web/Template/Internal.hs
@@ -39,6 +39,7 @@ data TemplateElement
| Escaped
| If String Template (Maybe Template) -- key, then branch, else branch
| For String Template (Maybe Template) -- key, body, separator
+ | Partial String -- filename
deriving (Show, Eq, Typeable)
@@ -49,12 +50,14 @@ instance Binary TemplateElement where
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
+ put (Partial p) = putWord8 5 >> put p
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
+ 5 -> Partial <$> 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 2dd0fc5..bb5c8c2 100644
--- a/src/Hakyll/Web/Template/Read.hs
+++ b/src/Hakyll/Web/Template/Read.hs
@@ -27,7 +27,7 @@ readTemplate input = case parse template "" input of
--------------------------------------------------------------------------------
template :: Parser Template
template = Template <$>
- (many1 $ chunk <|> escaped <|> conditional <|> for <|> key)
+ (many1 $ chunk <|> escaped <|> conditional <|> for <|> partial <|> key)
--------------------------------------------------------------------------------
@@ -65,9 +65,29 @@ for = try $ do
--------------------------------------------------------------------------------
+partial :: Parser TemplateElement
+partial = try $ do
+ void $ string "$partial("
+ i <- stringLiteral
+ void $ string ")$"
+ return $ Partial i
+
+
+--------------------------------------------------------------------------------
key :: Parser TemplateElement
key = try $ do
void $ char '$'
k <- metadataKey
void $ char '$'
return $ Key k
+
+
+--------------------------------------------------------------------------------
+stringLiteral :: Parser String
+stringLiteral = do
+ void $ char '\"'
+ str <- many $ do
+ x <- noneOf "\""
+ if x == '\\' then anyChar else return x
+ void $ char '\"'
+ return str