@@ -28,92 +28,25 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
2828 Portability : portable
2929
3030A simple templating system with variable substitution and conditionals.
31−The following program illustrates its use:
32−
33−> {-# LANGUAGE OverloadedStrings #-}
34−> import Data.Text
35−> import Data.Aeson
36−> import Text.Pandoc.Templates
37−>
38−> data Employee = Employee { firstName :: String
39−> , lastName :: String
40−> , salary :: Maybe Int }
41−> instance ToJSON Employee where
42−> toJSON e = object [ "name" .= object [ "first" .= firstName e
43−> , "last" .= lastName e ]
44−> , "salary" .= salary e ]
45−>
46−> employees :: [Employee]
47−> employees = [ Employee "John" "Doe" Nothing
48−> , Employee "Omar" "Smith" (Just 30000)
49−> , Employee "Sara" "Chen" (Just 60000) ]
50−>
51−> template :: Template
52−> template = either error id $ compileTemplate
53−> "$for(employee)$Hi, $employee.name.first$. $if(employee.salary)$You make $employee.salary$.$else$No salary data.$endif$$sep$\n$endfor$"
54−>
55−> main = putStrLn $ renderTemplate template $ object ["employee" .= employees ]
56−
57−A slot for an interpolated variable is a variable name surrounded
58−by dollar signs. To include a literal @$@ in your template, use
59−@$$@. Variable names must begin with a letter and can contain letters,
60−numbers, @_@, @-@, and @.@.
61−
62−The values of variables are determined by a JSON object that is
63−passed as a parameter to @renderTemplate@. So, for example,
64−@title@ will return the value of the @title@ field, and
65−@employee.salary@ will return the value of the @salary@ field
66−of the object that is the value of the @employee@ field.
67−
68−The value of a variable will be indented to the same level as the
69−variable.
70−
71−A conditional begins with @$if(variable_name)$@ and ends with @$endif$@.
72−It may optionally contain an @$else$@ section. The if section is
73−used if @variable_name@ has a non-null value, otherwise the else section
74−is used.
75−
76−Conditional keywords should not be indented, or unexpected spacing
77−problems may occur.
78−
79−The @$for$@ keyword can be used to iterate over an array. If
80−the value of the associated variable is not an array, a single
81−iteration will be performed on its value.
82−
83−You may optionally specify separators using @$sep$@, as in the
84−example above.
8531
8632-}
8733
8834module Text.Pandoc.Templates ( renderTemplate
8935 , renderTemplate'
90− , TemplateTarget(..)
36+ , TemplateTarget
9137 , varListToJSON
9238 , compileTemplate
9339 , Template
9440 , getDefaultTemplate ) where
9541
96−import Data.Char (isAlphaNum)
97−import Control.Monad (guard, when)
98−import Data.Aeson (ToJSON(..), Value(..))
99−import qualified Text.Parsec as P
100−import Text.Parsec.Text (Parser)
101−import Data.Monoid ((<>))
42+import Text.DocTemplates (Template, TemplateTarget, compileTemplate,
43+ renderTemplate, applyTemplate,
44+ varListToJSON)
45+import Data.Aeson (ToJSON(..))
10246import qualified Data.Text as T
103−import Data.Text (Text)
104−import Data.Text.Encoding (encodeUtf8)
105−import Data.List (intersperse)
10647import System.FilePath ((</>), (<.>))
107−import qualified Data.Map as M
108−import qualified Data.HashMap.Strict as H
109−import Data.Foldable (toList)
11048import qualified Control.Exception.Extensible as E (try, IOException)
111−import Text.Blaze.Html (Html)
112−import Text.Blaze.Internal (preEscapedText)
113−import Data.ByteString.Lazy (ByteString, fromChunks)
114−import Text.Pandoc.Shared (readDataFileUTF8, ordNub)
115−import Data.Vector ((!?))
116−import Control.Applicative (many, (<|>))
49+import Text.Pandoc.Shared (readDataFileUTF8)
11750
11851-- | Get default template for the specified writer.
11952getDefaultTemplate :: (Maybe FilePath) -- ^ User data directory to search first
@@ -135,191 +68,7 @@ getDefaultTemplate user writer = do
13568 _ -> let fname = "templates" </> "default" <.> format
13669 in E.try $ readDataFileUTF8 user fname
13770
138−newtype Template = Template { unTemplate :: Value -> Text }
139− deriving Monoid
140−
141−type Variable = [Text]
142−
143−class TemplateTarget a where
144− toTarget :: Text -> a
145−
146−instance TemplateTarget Text where
147− toTarget = id
148−
149−instance TemplateTarget String where
150− toTarget = T.unpack
151−
152−instance TemplateTarget ByteString where
153− toTarget = fromChunks . (:[]) . encodeUtf8
154−
155−instance TemplateTarget Html where
156− toTarget = preEscapedText
157−
158−varListToJSON :: [(String, String)] -> Value
159−varListToJSON assoc = toJSON $ M.fromList assoc'
160− where assoc' = [(T.pack k, toVal [T.pack z | (y,z) <- assoc,
161− not (null z),
162− y == k])
163− | k <- ordNub $ map fst assoc ]
164− toVal [x] = toJSON x
165− toVal [] = Null
166− toVal xs = toJSON xs
167−
168−renderTemplate :: (ToJSON a, TemplateTarget b) => Template -> a -> b
169−renderTemplate (Template f) context = toTarget $ f $ toJSON context
170−
171−compileTemplate :: Text -> Either String Template
172−compileTemplate template =
173− case P.parse (pTemplate <* P.eof) "template" template of
174− Left e -> Left (show e)
175− Right x -> Right x
176−
177−-- | Like 'renderTemplate', but compiles the template first,
178−-- raising an error if compilation fails.
71+-- | Like 'applyTemplate', but raising an error if compilation fails.
17972renderTemplate' :: (ToJSON a, TemplateTarget b) => String -> a -> b
180−renderTemplate' template =
181− renderTemplate (either error id $ compileTemplate $ T.pack template)
182−
183−var :: Variable -> Template
184−var = Template . resolveVar
185−
186−resolveVar :: Variable -> Value -> Text
187−resolveVar var' val =
188− case multiLookup var' val of
189− Just (Array vec) -> maybe mempty (resolveVar []) $ vec !? 0
190− Just (String t) -> T.stripEnd t
191− Just (Number n) -> T.pack $ show n
192− Just (Bool True) -> "true"
193− Just (Object _) -> "true"
194− Just _ -> mempty
195− Nothing -> mempty
196−
197−multiLookup :: [Text] -> Value -> Maybe Value
198−multiLookup [] x = Just x
199−multiLookup (v:vs) (Object o) = H.lookup v o >>= multiLookup vs
200−multiLookup _ _ = Nothing
201−
202−lit :: Text -> Template
203−lit = Template . const
204−
205−cond :: Variable -> Template -> Template -> Template
206−cond var' (Template ifyes) (Template ifno) = Template $ \val ->
207− case resolveVar var' val of
208− "" -> ifno val
209− _ -> ifyes val
210−
211−iter :: Variable -> Template -> Template -> Template
212−iter var' template sep = Template $ \val -> unTemplate
213− (case multiLookup var' val of
214− Just (Array vec) -> mconcat $ intersperse sep
215− $ map (setVar template var')
216− $ toList vec
217− Just x -> cond var' (setVar template var' x) mempty
218− Nothing -> mempty) val
219−
220−setVar :: Template -> Variable -> Value -> Template
221−setVar (Template f) var' val = Template $ f . replaceVar var' val
222−
223−replaceVar :: Variable -> Value -> Value -> Value
224−replaceVar [] new _ = new
225−replaceVar (v:vs) new (Object o) =
226− Object $ H.adjust (\x -> replaceVar vs new x) v o
227−replaceVar _ _ old = old
228−
229−--- parsing
230−
231−pTemplate :: Parser Template
232−pTemplate = do
233− sp <- P.option mempty pInitialSpace
234− rest <- mconcat <$> many (pConditional <|>
235− pFor <|>
236− pNewline <|>
237− pVar <|>
238− pLit <|>
239− pEscapedDollar)
240− return $ sp <> rest
241−
242−takeWhile1 :: (Char -> Bool) -> Parser Text
243−takeWhile1 f = T.pack <$> P.many1 (P.satisfy f)
244−
245−pLit :: Parser Template
246−pLit = lit <$> takeWhile1 (\x -> x /='$' && x /= '\n')
247−
248−pNewline :: Parser Template
249−pNewline = do
250− P.char '\n'
251− sp <- P.option mempty pInitialSpace
252− return $ lit "\n" <> sp
253−
254−pInitialSpace :: Parser Template
255−pInitialSpace = do
256− sps <- takeWhile1 (==' ')
257− let indentVar = if T.null sps
258− then id
259− else indent (T.length sps)
260− v <- P.option mempty $ indentVar <$> pVar
261− return $ lit sps <> v
262−
263−pEscapedDollar :: Parser Template
264−pEscapedDollar = lit "$" <$ P.try (P.string "$$")
265−
266−pVar :: Parser Template
267−pVar = var <$> (P.try $ P.char '$' *> pIdent <* P.char '$')
268−
269−pIdent :: Parser [Text]
270−pIdent = do
271− first <- pIdentPart
272− rest <- many (P.char '.' *> pIdentPart)
273− return (first:rest)
274−
275−pIdentPart :: Parser Text
276−pIdentPart = P.try $ do
277− first <- P.letter
278− rest <- T.pack <$> P.many (P.satisfy (\c -> isAlphaNum c || c == '_' || c == '-'))
279− let id' = T.singleton first <> rest
280− guard $ id' `notElem` reservedWords
281− return id'
282−
283−reservedWords :: [Text]
284−reservedWords = ["else","endif","for","endfor","sep"]
285−
286−skipEndline :: Parser ()
287−skipEndline = P.try $ P.skipMany (P.satisfy (`elem` (" \t" :: String))) >> P.char '\n' >> return ()
288−
289−pConditional :: Parser Template
290−pConditional = do
291− P.try $ P.string "$if("
292− id' <- pIdent
293− P.string ")$"
294− -- if newline after the "if", then a newline after "endif" will be swallowed
295− multiline <- P.option False (True <$ skipEndline)
296− ifContents <- pTemplate
297− elseContents <- P.option mempty $ P.try $
298− do P.string "$else$"
299− when multiline $ P.option () skipEndline
300− pTemplate
301− P.string "$endif$"
302− when multiline $ P.option () skipEndline
303− return $ cond id' ifContents elseContents
304−
305−pFor :: Parser Template
306−pFor = do
307− P.try $ P.string "$for("
308− id' <- pIdent
309− P.string ")$"
310− -- if newline after the "for", then a newline after "endfor" will be swallowed
311− multiline <- P.option False $ skipEndline >> return True
312− contents <- pTemplate
313− sep <- P.option mempty $
314− do P.try $ P.string "$sep$"
315− when multiline $ P.option () skipEndline
316− pTemplate
317− P.string "$endfor$"
318− when multiline $ P.option () skipEndline
319− return $ iter id' contents sep
73+renderTemplate' template = either error id . applyTemplate (T.pack template)
32074
321−indent :: Int -> Template -> Template
322−indent 0 x = x
323−indent ind (Template f) = Template $ \val -> indent' (f val)
324− where indent' t = T.concat
325− $ intersperse ("\n" <> T.replicate ind " ") $ T.lines t