@@ -1,6 +1,7 @@
1−{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, CPP #-}
1+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, CPP,
2+ OverloadedStrings, GeneralizedNewtypeDeriving #-}
3−Copyright (C) 2009-2010 John MacFarlane <jgm@berkeley.edu>
4+Copyright (C) 2009-2013 John MacFarlane <jgm@berkeley.edu>
5This program is free software; you can redistribute it and/or modify
6This program is free software; you can redistribute it and/or modify
6it under the terms of the GNU General Public License as published by
7it under the terms of the GNU General Public License as published by
@@ -19,7 +20,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 Module : Text.Pandoc.Templates
22 Module : Text.Pandoc.Templates
22− Copyright : Copyright (C) 2009-2010 John MacFarlane
23+ Copyright : Copyright (C) 2009-2013 John MacFarlane
23 License : GNU GPL, version 2 or above
24 License : GNU GPL, version 2 or above
25 Maintainer : John MacFarlane <jgm@berkeley.edu>
26 Maintainer : John MacFarlane <jgm@berkeley.edu>
@@ -27,16 +28,42 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
27 Portability : portable
28 Portability : portable
29A simple templating system with variable substitution and conditionals.
30A simple templating system with variable substitution and conditionals.
30−Example:
31+The following program illustrates its use:
32−> renderTemplate [("name","Sam"),("salary","50,000")] $
33+> {-# LANGUAGE OverloadedStrings #-}
36+> import Text.Pandoc.Templates
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 ]
46+> employees :: [Employee]
47+> employees = [ Employee "John" "Doe" Nothing
48+> , Employee "Omar" "Smith" (Just 30000)
49+> , Employee "Sara" "Chen" (Just 60000) ]
51+> template :: Template
52+> template = either error id $ compileTemplate
33−> "Hi, $name$. $if(salary)$You make $$$salary$.$else$No salary data.$endif$"
53+> "$for(employee)$Hi, $employee.name.first$. $if(employee.salary)$You make $employee.salary$.$else$No salary data.$endif$$sep$\n$endfor$"
34−> "Hi, John. You make $50,000."
54+>
55+> main = putStrLn $ renderTemplate template $ object ["employee" .= employees ]
36A slot for an interpolated variable is a variable name surrounded
57A slot for an interpolated variable is a variable name surrounded
37by dollar signs. To include a literal @$@ in your template, use
58by dollar signs. To include a literal @$@ in your template, use
38@$$@. Variable names must begin with a letter and can contain letters,
59@$$@. Variable names must begin with a letter and can contain letters,
39−numbers, @_@, and @-@.
60+numbers, @_@, @-@, and @.@.
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.
41The value of a variable will be indented to the same level as the
68The value of a variable will be indented to the same level as the
@@ -49,39 +76,46 @@ is used.
49Conditional keywords should not be indented, or unexpected spacing
76Conditional keywords should not be indented, or unexpected spacing
50problems may occur.
77problems may occur.
52−If a variable name is associated with multiple values in the association
79+The @$for$@ keyword can be used to iterate over an array. If
53−list passed to 'renderTemplate', you may use the @$for$@ keyword to
80+the value of the associated variable is not an array, a single
54−iterate over them:
81+iteration will be performed on its value.
56−> renderTemplate [("name","Sam"),("name","Joe")] $
57−> "$for(name)$\nHi, $name$.\n$endfor$"
58−> "Hi, Sam.\nHi, Joe."
60−You may optionally specify separators using @$sep$@:
83+You may optionally specify separators using @$sep$@, as in the
62−> renderTemplate [("name","Sam"),("name","Joe"),("name","Lynn")] $
63−> "Hi, $for(name)$$name$$sep$, $endfor$"
64−> "Hi, Sam, Joe, Lynn."
67module Text.Pandoc.Templates ( renderTemplate
88module Text.Pandoc.Templates ( renderTemplate
68− , TemplateTarget
89+ , TemplateTarget(..)
69 , getDefaultTemplate ) where
93 , getDefaultTemplate ) where
71−import Text.Parsec
95+import Data.Char (isAlphaNum)
72−import Control.Monad (liftM, when, forM, mzero)
96+import Control.Monad (guard, when)
73−import System.FilePath
97+import Data.Aeson (ToJSON(..), Value(..))
98+import qualified Data.Attoparsec.Text as A
99+import Data.Attoparsec.Text (Parser)
100+import Control.Applicative
101+import qualified Data.Text as T
102+import Data.Text (Text)
103+import Data.Text.Encoding (encodeUtf8)
104+import Data.Monoid ((<>), Monoid(..))
74−import Data.List (intercalate, intersperse)
105+import Data.List (intersperse, nub)
106+import System.FilePath ((</>), (<.>))
107+import qualified Data.Map as M
108+import qualified Data.HashMap.Strict as H
109+import Data.Foldable (toList)
110+import qualified Control.Exception.Extensible as E (try, IOException)
75#if MIN_VERSION_blaze_html(0,5,0)
111#if MIN_VERSION_blaze_html(0,5,0)
76import Text.Blaze.Html (Html)
112import Text.Blaze.Html (Html)
77−import Text.Blaze.Internal (preEscapedString)
113+import Text.Blaze.Internal (preEscapedText)
79−import Text.Blaze (preEscapedString, Html)
115+import Text.Blaze (preEscapedText, Html)
81−import Text.Pandoc.UTF8 (fromStringLazy)
82−import Data.ByteString.Lazy (ByteString)
117+import Data.ByteString.Lazy (ByteString, fromChunks)
83import Text.Pandoc.Shared (readDataFileUTF8)
118import Text.Pandoc.Shared (readDataFileUTF8)
84−import qualified Control.Exception.Extensible as E (try, IOException)
86-- | Get default template for the specified writer.
120-- | Get default template for the specified writer.
87getDefaultTemplate :: (Maybe FilePath) -- ^ User data directory to search first
121getDefaultTemplate :: (Maybe FilePath) -- ^ User data directory to search first
@@ -100,119 +134,180 @@ getDefaultTemplate user writer = do
100 _ -> let fname = "templates" </> "default" <.> format
134 _ -> let fname = "templates" </> "default" <.> format
101 in E.try $ readDataFileUTF8 user fname
135 in E.try $ readDataFileUTF8 user fname
103−data TemplateState = TemplateState Int [(String,String)]
137+newtype Template = Template { unTemplate :: Value -> Text }
105−adjustPosition :: String -> Parsec [Char] TemplateState String
140+type Variable = [Text]
106−adjustPosition str = do
107− let lastline = takeWhile (/= '\n') $ reverse str
108− updateState $ \(TemplateState pos x) ->
110− then TemplateState (pos + length lastline) x
111− else TemplateState (length lastline) x
114class TemplateTarget a where
142class TemplateTarget a where
115− toTarget :: String -> a
143+ toTarget :: Text -> a
117−instance TemplateTarget String where
145+instance TemplateTarget Text where
118 toTarget = id
146 toTarget = id
148+instance TemplateTarget String where
120instance TemplateTarget ByteString where
151instance TemplateTarget ByteString where
121− toTarget = fromStringLazy
152+ toTarget = fromChunks . (:[]) . encodeUtf8
123instance TemplateTarget Html where
154instance TemplateTarget Html where
124− toTarget = preEscapedString
155+ toTarget = preEscapedText
126−-- | Renders a template
157+varListToJSON :: [(String, String)] -> Value
158+varListToJSON assoc = toJSON $ M.fromList assoc'
159+ where assoc' = [(T.pack k, toVal [T.pack z | (y,z) <- assoc,
162+ | k <- nub $ map fst assoc ]
163+ toVal [x] = toJSON x
165+ toVal xs = toJSON xs
127−renderTemplate :: TemplateTarget a
167+renderTemplate :: (ToJSON a, TemplateTarget b) => Template -> a -> b
128− => [(String,String)] -- ^ Assoc. list of values for variables
168+renderTemplate template context =
169+ toTarget $ renderTemplate' template (toJSON context)
170+ where renderTemplate' (Template f) val = f val
172+compileTemplate :: Text -> Either String Template
173+compileTemplate template = A.parseOnly pTemplate template
129− -> String -- ^ Template
175+var :: Variable -> Template
130− -> a
176+var = Template . resolveVar
131−renderTemplate vals templ =
177+
132− case runParser (do x <- parseTemplate; eof; return x) (TemplateState 0 vals) "template" templ of
178+resolveVar :: Variable -> Value -> Text
133− Left e -> error $ show e
179+resolveVar var' val =
134− Right r -> toTarget $ concat r
180+ case multiLookup var' val of
135−
181+ Just (Array vec) -> mconcat $ map (resolveVar []) $ toList vec
182+ Just (String t) -> T.stripEnd t
183+ Just (Number n) -> T.pack $ show n
184+ Just (Bool True) -> "true"
188+multiLookup :: [Text] -> Value -> Maybe Value
189+multiLookup [] x = Just x
190+multiLookup (v:vs) (Object o) = H.lookup v o >>= multiLookup vs
191+multiLookup _ _ = Nothing
193+lit :: Text -> Template
194+lit = Template . const
196+cond :: Variable -> Template -> Template -> Template
197+cond var' (Template ifyes) (Template ifno) = Template $ \val ->
198+ case resolveVar var' val of
202+iter :: Variable -> Template -> Template -> Template
203+iter var' template sep = Template $ \val -> unTemplate
204+ (case multiLookup var' val of
205+ Just (Array vec) -> mconcat $ intersperse sep
206+ $ map (setVar template var')
208+ Just x -> setVar template var' x
209+ Nothing -> mempty) val
211+setVar :: Template -> Variable -> Value -> Template
212+setVar (Template f) var' val = Template $ f . replaceVar var' val
214+replaceVar :: Variable -> Value -> Value -> Value
215+replaceVar [] new _ = new
216+replaceVar (v:vs) new (Object o) =
217+ Object $ H.adjust (\x -> replaceVar vs new x) v o
218+replaceVar _ _ old = old
222+pTemplate :: Parser Template
224+ sp <- A.option mempty pInitialSpace
225+ rest <- mconcat <$> many (pConditional <|>
233+pLit :: Parser Template
234+pLit = lit <$> A.takeWhile1 (\x -> x /='$' && x /= '\n')
236+pNewline :: Parser Template
239+ sp <- A.option mempty pInitialSpace
240+ return $ lit "\n" <> sp
242+pInitialSpace :: Parser Template
244+ sps <- A.takeWhile1 (==' ')
245+ let indentVar = if T.null sps
247+ else indent (T.length sps)
248+ v <- A.option mempty $ indentVar <$> pVar
249+ return $ lit sps <> v
251+pEscapedDollar :: Parser Template
252+pEscapedDollar = lit "$" <$ A.string "$$"
254+pVar :: Parser Template
255+pVar = var <$> (A.char '$' *> pIdent <* A.char '$')
257+pIdent :: Parser [Text]
260+ rest <- many (A.char '.' *> pIdentPart)
263+pIdentPart :: Parser Text
266+ rest <- A.takeWhile (\c -> isAlphaNum c || c == '_' || c == '-')
267+ let id' = T.singleton first <> rest
268+ guard $ id' `notElem` reservedWords
136−reservedWords :: [String]
271+reservedWords :: [Text]
137reservedWords = ["else","endif","for","endfor","sep"]
272reservedWords = ["else","endif","for","endfor","sep"]
139−parseTemplate :: Parsec [Char] TemplateState [String]
141− many $ (plaintext <|> escapedDollar <|> conditional <|> for <|> variable)
144−plaintext :: Parsec [Char] TemplateState String
145−plaintext = many1 $ noneOf "$"
147−escapedDollar :: Parsec [Char] TemplateState String
148−escapedDollar = try $ string "$$" >> return "$"
150−skipEndline :: Parsec [Char] st ()
274+skipEndline :: Parser ()
151−skipEndline = try $ skipMany (oneOf " \t") >> newline >> return ()
275+skipEndline = A.skipWhile (`elem` " \t") >> A.char '\n' >> return ()
153−conditional :: Parsec [Char] TemplateState String
277+pConditional :: Parser Template
154−conditional = try $ do
278+pConditional = do
155− TemplateState pos vars <- getState
156− string "$if("
279+ A.string "$if("
157− id' <- ident
280+ id' <- pIdent
158− string ")$"
281+ A.string ")$"
159 -- if newline after the "if", then a newline after "endif" will be swallowed
282 -- if newline after the "if", then a newline after "endif" will be swallowed
160− multiline <- option False $ try $ skipEndline >> return True
283+ multiline <- A.option False (True <$ skipEndline)
161− ifContents <- liftM concat parseTemplate
284+ ifContents <- pTemplate
162− -- reset state for else block
163− setState $ TemplateState pos vars
164− elseContents <- option "" $ do try (string "$else$")
285+ elseContents <- A.option mempty $
286+ do A.string "$else$"
165− when multiline $ optional skipEndline
287+ when multiline $ A.option () skipEndline
166− liftM concat parseTemplate
288+ pTemplate
167− string "$endif$"
289+ A.string "$endif$"
168− when multiline $ optional skipEndline
290+ when multiline $ A.option () skipEndline
169− let conditionSatisfied = case lookup id' vars of
173− return $ if conditionSatisfied
175− else elseContents
291+ return $ cond id' ifContents elseContents
177−for :: Parsec [Char] TemplateState String
293+pFor :: Parser Template
178−for = try $ do
294+pFor = do
179− TemplateState pos vars <- getState
180− string "$for("
295+ A.string "$for("
181− id' <- ident
296+ id' <- pIdent
182− string ")$"
297+ A.string ")$"
183 -- if newline after the "for", then a newline after "endfor" will be swallowed
298 -- if newline after the "for", then a newline after "endfor" will be swallowed
184− multiline <- option False $ try $ skipEndline >> return True
299+ multiline <- A.option False $ skipEndline >> return True
185− let matches = filter (\(k,_) -> k == id') vars
186− let indent = replicate pos ' '
187− contents <- forM matches $ \m -> do
300+ contents <- pTemplate
188− updateState $ \(TemplateState p v) -> TemplateState p (m:v)
301+ sep <- A.option mempty $
189− raw <- liftM concat $ lookAhead parseTemplate
190− return $ intercalate ('\n':indent) $ lines $ raw ++ "\n"
192− sep <- option "" $ do try (string "$sep$")
302+ do A.string "$sep$"
193− when multiline $ optional skipEndline
303+ when multiline $ A.option () skipEndline
194− liftM concat parseTemplate
304+ pTemplate
195− string "$endfor$"
305+ A.string "$endfor$"
196− when multiline $ optional skipEndline
306+ when multiline $ A.option () skipEndline
197− setState $ TemplateState pos vars
307+ return $ iter id' contents sep
198− return $ concat $ intersperse sep contents
308+
199−
309+indent :: Int -> Template -> Template
200−ident :: Parsec [Char] TemplateState String
310+indent 0 x = x
201−ident = do
311+indent ind (Template f) = Template $ \val -> indent' (f val)
202− first <- letter
312+ where indent' t = T.concat
203− rest <- many (alphaNum <|> oneOf "_-")
313+ $ intersperse ("\n" <> T.replicate ind " ") $ T.lines t
204− let id' = first : rest
205− if id' `elem` reservedWords
209−variable :: Parsec [Char] TemplateState String
214− TemplateState pos vars <- getState
215− let indent = replicate pos ' '
216− return $ case lookup id' vars of
217− Just val -> intercalate ('\n' : indent) $ lines val