@@ -1,6 +1,7 @@
1−{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, CPP #-}
1+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, CPP,
2+ OverloadedStrings, GeneralizedNewtypeDeriving #-}
23{-
3−Copyright (C) 2009-2010 John MacFarlane <jgm@berkeley.edu>
4+Copyright (C) 2009-2013 John MacFarlane <jgm@berkeley.edu>
45
56This program is free software; you can redistribute it and/or modify
67it 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
1920
2021{- |
2122 Module : Text.Pandoc.Templates
22− Copyright : Copyright (C) 2009-2010 John MacFarlane
23+ Copyright : Copyright (C) 2009-2013 John MacFarlane
2324 License : GNU GPL, version 2 or above
2425
2526 Maintainer : John MacFarlane <jgm@berkeley.edu>
@@ -27,16 +28,42 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
2728 Portability : portable
2829
2930A simple templating system with variable substitution and conditionals.
30−Example:
31−
32−> renderTemplate [("name","Sam"),("salary","50,000")] $
33−> "Hi, $name$. $if(salary)$You make $$$salary$.$else$No salary data.$endif$"
34−> "Hi, John. You make $50,000."
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 ]
3556
3657A slot for an interpolated variable is a variable name surrounded
3758by dollar signs. To include a literal @$@ in your template, use
3859@$$@. Variable names must begin with a letter and can contain letters,
39−numbers, @_@, and @-@.
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.
4067
4168The value of a variable will be indented to the same level as the
4269variable.
@@ -49,39 +76,46 @@ is used.
4976Conditional keywords should not be indented, or unexpected spacing
5077problems may occur.
5178
52−If a variable name is associated with multiple values in the association
53−list passed to 'renderTemplate', you may use the @$for$@ keyword to
54−iterate over them:
55−
56−> renderTemplate [("name","Sam"),("name","Joe")] $
57−> "$for(name)$\nHi, $name$.\n$endfor$"
58−> "Hi, Sam.\nHi, Joe."
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.
5982
60−You may optionally specify separators using @$sep$@:
83+You may optionally specify separators using @$sep$@, as in the
84+example above.
6185
62−> renderTemplate [("name","Sam"),("name","Joe"),("name","Lynn")] $
63−> "Hi, $for(name)$$name$$sep$, $endfor$"
64−> "Hi, Sam, Joe, Lynn."
6586-}
6687
6788module Text.Pandoc.Templates ( renderTemplate
68− , TemplateTarget
89+ , TemplateTarget(..)
90+ , varListToJSON
91+ , compileTemplate
92+ , Template
6993 , getDefaultTemplate ) where
7094
71−import Text.Parsec
72−import Control.Monad (liftM, when, forM, mzero)
73−import System.FilePath
74−import Data.List (intercalate, intersperse)
95+import Data.Char (isAlphaNum)
96+import Control.Monad (guard, when)
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(..))
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)
75111#if MIN_VERSION_blaze_html(0,5,0)
76112import Text.Blaze.Html (Html)
77−import Text.Blaze.Internal (preEscapedString)
113+import Text.Blaze.Internal (preEscapedText)
78114#else
79−import Text.Blaze (preEscapedString, Html)
115+import Text.Blaze (preEscapedText, Html)
80116#endif
81−import Text.Pandoc.UTF8 (fromStringLazy)
82−import Data.ByteString.Lazy (ByteString)
117+import Data.ByteString.Lazy (ByteString, fromChunks)
83118import Text.Pandoc.Shared (readDataFileUTF8)
84−import qualified Control.Exception.Extensible as E (try, IOException)
85119
86120-- | Get default template for the specified writer.
87121getDefaultTemplate :: (Maybe FilePath) -- ^ User data directory to search first
@@ -100,119 +134,180 @@ getDefaultTemplate user writer = do
100134 _ -> let fname = "templates" </> "default" <.> format
101135 in E.try $ readDataFileUTF8 user fname
102136
103−data TemplateState = TemplateState Int [(String,String)]
137+newtype Template = Template { unTemplate :: Value -> Text }
138+ deriving Monoid
104139
105−adjustPosition :: String -> Parsec [Char] TemplateState String
106−adjustPosition str = do
107− let lastline = takeWhile (/= '\n') $ reverse str
108− updateState $ \(TemplateState pos x) ->
109− if str == lastline
110− then TemplateState (pos + length lastline) x
111− else TemplateState (length lastline) x
112− return str
140+type Variable = [Text]
113141
114142class TemplateTarget a where
115− toTarget :: String -> a
143+ toTarget :: Text -> a
116144
117−instance TemplateTarget String where
145+instance TemplateTarget Text where
118146 toTarget = id
119147
148+instance TemplateTarget String where
149+ toTarget = T.unpack
150+
120151instance TemplateTarget ByteString where
121− toTarget = fromStringLazy
152+ toTarget = fromChunks . (:[]) . encodeUtf8
122153
123154instance TemplateTarget Html where
124− toTarget = preEscapedString
125−
126−-- | Renders a template
127−renderTemplate :: TemplateTarget a
128− => [(String,String)] -- ^ Assoc. list of values for variables
129− -> String -- ^ Template
130− -> a
131−renderTemplate vals templ =
132− case runParser (do x <- parseTemplate; eof; return x) (TemplateState 0 vals) "template" templ of
133− Left e -> error $ show e
134− Right r -> toTarget $ concat r
135−
136−reservedWords :: [String]
155+ toTarget = preEscapedText
156+
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,
160+ not (null z),
161+ y == k])
162+ | k <- nub $ map fst assoc ]
163+ toVal [x] = toJSON x
164+ toVal [] = Null
165+ toVal xs = toJSON xs
166+
167+renderTemplate :: (ToJSON a, TemplateTarget b) => Template -> a -> b
168+renderTemplate template context =
169+ toTarget $ renderTemplate' template (toJSON context)
170+ where renderTemplate' (Template f) val = f val
171+
172+compileTemplate :: Text -> Either String Template
173+compileTemplate template = A.parseOnly pTemplate template
174+
175+var :: Variable -> Template
176+var = Template . resolveVar
177+
178+resolveVar :: Variable -> Value -> Text
179+resolveVar var' val =
180+ case multiLookup var' val of
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"
185+ Just _ -> mempty
186+ Nothing -> mempty
187+
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
192+
193+lit :: Text -> Template
194+lit = Template . const
195+
196+cond :: Variable -> Template -> Template -> Template
197+cond var' (Template ifyes) (Template ifno) = Template $ \val ->
198+ case resolveVar var' val of
199+ "" -> ifno val
200+ _ -> ifyes val
201+
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')
207+ $ toList vec
208+ Just x -> setVar template var' x
209+ Nothing -> mempty) val
210+
211+setVar :: Template -> Variable -> Value -> Template
212+setVar (Template f) var' val = Template $ f . replaceVar var' val
213+
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
219+
220+--- parsing
221+
222+pTemplate :: Parser Template
223+pTemplate = do
224+ sp <- A.option mempty pInitialSpace
225+ rest <- mconcat <$> many (pConditional <|>
226+ pFor <|>
227+ pNewline <|>
228+ pVar <|>
229+ pLit <|>
230+ pEscapedDollar)
231+ return $ sp <> rest
232+
233+pLit :: Parser Template
234+pLit = lit <$> A.takeWhile1 (\x -> x /='$' && x /= '\n')
235+
236+pNewline :: Parser Template
237+pNewline = do
238+ A.char '\n'
239+ sp <- A.option mempty pInitialSpace
240+ return $ lit "\n" <> sp
241+
242+pInitialSpace :: Parser Template
243+pInitialSpace = do
244+ sps <- A.takeWhile1 (==' ')
245+ let indentVar = if T.null sps
246+ then id
247+ else indent (T.length sps)
248+ v <- A.option mempty $ indentVar <$> pVar
249+ return $ lit sps <> v
250+
251+pEscapedDollar :: Parser Template
252+pEscapedDollar = lit "$" <$ A.string "$$"
253+
254+pVar :: Parser Template
255+pVar = var <$> (A.char '$' *> pIdent <* A.char '$')
256+
257+pIdent :: Parser [Text]
258+pIdent = do
259+ first <- pIdentPart
260+ rest <- many (A.char '.' *> pIdentPart)
261+ return (first:rest)
262+
263+pIdentPart :: Parser Text
264+pIdentPart = do
265+ first <- A.letter
266+ rest <- A.takeWhile (\c -> isAlphaNum c || c == '_' || c == '-')
267+ let id' = T.singleton first <> rest
268+ guard $ id' `notElem` reservedWords
269+ return id'
270+
271+reservedWords :: [Text]
137272reservedWords = ["else","endif","for","endfor","sep"]
138273
139−parseTemplate :: Parsec [Char] TemplateState [String]
140−parseTemplate =
141− many $ (plaintext <|> escapedDollar <|> conditional <|> for <|> variable)
142− >>= adjustPosition
143−
144−plaintext :: Parsec [Char] TemplateState String
145−plaintext = many1 $ noneOf "$"
146−
147−escapedDollar :: Parsec [Char] TemplateState String
148−escapedDollar = try $ string "$$" >> return "$"
149−
150−skipEndline :: Parsec [Char] st ()
151−skipEndline = try $ skipMany (oneOf " \t") >> newline >> return ()
274+skipEndline :: Parser ()
275+skipEndline = A.skipWhile (`elem` " \t") >> A.char '\n' >> return ()
152276
153−conditional :: Parsec [Char] TemplateState String
154−conditional = try $ do
155− TemplateState pos vars <- getState
156− string "$if("
157− id' <- ident
158− string ")$"
277+pConditional :: Parser Template
278+pConditional = do
279+ A.string "$if("
280+ id' <- pIdent
281+ A.string ")$"
159282 -- if newline after the "if", then a newline after "endif" will be swallowed
160− multiline <- option False $ try $ skipEndline >> return True
161− ifContents <- liftM concat parseTemplate
162− -- reset state for else block
163− setState $ TemplateState pos vars
164− elseContents <- option "" $ do try (string "$else$")
165− when multiline $ optional skipEndline
166− liftM concat parseTemplate
167− string "$endif$"
168− when multiline $ optional skipEndline
169− let conditionSatisfied = case lookup id' vars of
170− Nothing -> False
171− Just "" -> False
172− Just _ -> True
173− return $ if conditionSatisfied
174− then ifContents
175− else elseContents
176−
177−for :: Parsec [Char] TemplateState String
178−for = try $ do
179− TemplateState pos vars <- getState
180− string "$for("
181− id' <- ident
182− string ")$"
283+ multiline <- A.option False (True <$ skipEndline)
284+ ifContents <- pTemplate
285+ elseContents <- A.option mempty $
286+ do A.string "$else$"
287+ when multiline $ A.option () skipEndline
288+ pTemplate
289+ A.string "$endif$"
290+ when multiline $ A.option () skipEndline
291+ return $ cond id' ifContents elseContents
292+
293+pFor :: Parser Template
294+pFor = do
295+ A.string "$for("
296+ id' <- pIdent
297+ A.string ")$"
183298 -- if newline after the "for", then a newline after "endfor" will be swallowed
184− multiline <- option False $ try $ skipEndline >> return True
185− let matches = filter (\(k,_) -> k == id') vars
186− let indent = replicate pos ' '
187− contents <- forM matches $ \m -> do
188− updateState $ \(TemplateState p v) -> TemplateState p (m:v)
189− raw <- liftM concat $ lookAhead parseTemplate
190− return $ intercalate ('\n':indent) $ lines $ raw ++ "\n"
191− parseTemplate
192− sep <- option "" $ do try (string "$sep$")
193− when multiline $ optional skipEndline
194− liftM concat parseTemplate
195− string "$endfor$"
196− when multiline $ optional skipEndline
197− setState $ TemplateState pos vars
198− return $ concat $ intersperse sep contents
199−
200−ident :: Parsec [Char] TemplateState String
201−ident = do
202− first <- letter
203− rest <- many (alphaNum <|> oneOf "_-")
204− let id' = first : rest
205− if id' `elem` reservedWords
206− then mzero
207− else return id'
208−
209−variable :: Parsec [Char] TemplateState String
210−variable = try $ do
211− char '$'
212− id' <- ident
213− char '$'
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
218− Nothing -> ""
299+ multiline <- A.option False $ skipEndline >> return True
300+ contents <- pTemplate
301+ sep <- A.option mempty $
302+ do A.string "$sep$"
303+ when multiline $ A.option () skipEndline
304+ pTemplate
305+ A.string "$endfor$"
306+ when multiline $ A.option () skipEndline
307+ return $ iter id' contents sep
308+
309+indent :: Int -> Template -> Template
310+indent 0 x = x
311+indent ind (Template f) = Template $ \val -> indent' (f val)
312+ where indent' t = T.concat
313+ $ intersperse ("\n" <> T.replicate ind " ") $ T.lines t