Add partials to template system

.ghci

@@ -1 +1,2 @@
 :set -isrc -isrc-interval -itests -idist/build/autogen -DPREVIEW_SERVER
+:set -optP-include -optPdist/build/autogen/cabal_macros.h

hakyll.cabal

@@ -1,5 +1,5 @@
 Name:    hakyll
-Version: 4.2.2.0
+Version: 4.3.0.0
 
 Synopsis: A static website compiler library
 Description:

src/Hakyll/Core/Util/Parser.hs

@@ -22,4 +22,4 @@ metadataKey = do
 
 --------------------------------------------------------------------------------
 reservedKeys :: [String]
-reservedKeys = ["if", "else", "endif", "for", "sep", "endfor"]
+reservedKeys = ["if", "else", "endif", "for", "sep", "endfor", "partial"]

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 " ++

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"

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)
 
 
 --------------------------------------------------------------------------------
@@ -64,6 +64,15 @@ for = try $ do
     return $ For i body sep
 
 
+--------------------------------------------------------------------------------
+partial :: Parser TemplateElement
+partial = try $ do
+    void $ string "$partial("
+    i <- stringLiteral
+    void $ string ")$"
+    return $ Partial i
+
+
 --------------------------------------------------------------------------------
 key :: Parser TemplateElement
 key = try $ do
@@ -71,3 +80,14 @@ key = try $ do
     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