@@ -39,13 +39,13 @@ module Hakyll.Web.Template
3939 , applyTemplate
4040 , loadAndApplyTemplate
4141 , applyAsTemplate
42− , applyTemplateWith
4342 ) where
4443
4544
4645--------------------------------------------------------------------------------
4746import Control.Monad (liftM)
48−import Control.Monad.Error (MonadError(..))
47+import Control.Monad.Error (MonadError (..))
48+import Data.List (intercalate)
4949import Data.Monoid (mappend)
5050import Prelude hiding (id)
5151
@@ -73,12 +73,43 @@ applyTemplate :: Template -- ^ Template
7373 -> Item a -- ^ Page
7474 -> Compiler (Item String) -- ^ Resulting item
7575applyTemplate tpl context item = do
76− -- Appending missingField gives better error messages
77− let context' k x = unContext (context `mappend` missingField) k x
78− body <- applyTemplateWith context' tpl item
76+ body <- applyTemplate' tpl context item
7977 return $ itemSetBody body item
8078
8179
80+--------------------------------------------------------------------------------
81+applyTemplate' :: Template -- ^ Template
82+ -> Context a -- ^ Context
83+ -> Item a -- ^ Page
84+ -> Compiler String -- ^ Resulting item
85+applyTemplate' tpl context x = go tpl
86+ where
87+ context' = unContext (context `mappend` missingField)
88+ go = liftM concat . mapM applyElem . unTemplate
89+
90+ applyElem (Chunk c) = return c
91+ applyElem Escaped = return "$"
92+ applyElem (Key k) = context' k x >>= getString k
93+ applyElem (If k t mf) = (context' k x >> go t) `catchError` handler
94+ where
95+ handler _ = case mf of
96+ Nothing -> return ""
97+ Just f -> go f
98+ applyElem (For k b s) = context' k x >>= \cf -> case cf of
99+ StringField _ -> fail $
100+ "Hakyll.Web.Template.applyTemplateWith: expected ListField but " ++
101+ "got StringField for key " ++ show k
102+ ListField c xs -> do
103+ sep <- maybe (return "") go s
104+ bs <- mapM (applyTemplate' b c) xs
105+ return $ intercalate sep bs
106+
107+ getString _ (StringField s) = return s
108+ getString k (ListField _ _) = fail $
109+ "Hakyll.Web.Template.applyTemplateWith: expected StringField but " ++
110+ "got ListField for key " ++ show k
111+
112+
82113--------------------------------------------------------------------------------
83114-- | The following pattern is so common:
84115--
@@ -109,22 +140,3 @@ applyAsTemplate :: Context String -- ^ Context
109140applyAsTemplate context item =
110141 let tpl = readTemplate $ itemBody item
111142 in applyTemplate tpl context item
112−
113−
114−--------------------------------------------------------------------------------
115−-- | Overloaded apply template function to work in an arbitrary Monad.
116−applyTemplateWith :: MonadError e m
117− => (String -> a -> m String)
118− -> Template -> a -> m String
119−applyTemplateWith context tpl x = go tpl
120− where
121− go = liftM concat . mapM applyElem . unTemplate
122−
123− applyElem (Chunk c) = return c
124− applyElem Escaped = return "$"
125− applyElem (Key k) = context k x
126− applyElem (If k t mf) = (context k x >> go t) `catchError` handler
127− where
128− handler _ = case mf of
129− Nothing -> return ""
130− Just f -> go f