Revised Text.Pandoc.Templates to accept JSON contexts.

Currently the library is set up with a shim for association
lists, for compatibility, but this can change when the writers
are changed.

New export: `varListToJSON`.

Removed `Empty`.

Simplified template type to a newtype.

3 files changed, 237 insertions, 134 deletions

diff --git a/src/Text/Pandoc/Templates.hs b/src/Text/Pandoc/Templates.hs
index bbdb4adc4..12a7e732a 100644
--- a/src/Text/Pandoc/Templates.hs
+++ b/src/Text/Pandoc/Templates.hs
@@ -1,6 +1,7 @@
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, CPP #-}
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, CPP,
+    OverloadedStrings, GeneralizedNewtypeDeriving #-}
 {-
-Copyright (C) 2009-2010 John MacFarlane <jgm@berkeley.edu>
+Copyright (C) 2009-2013 John MacFarlane <jgm@berkeley.edu>
 
 This program is free software; you can redistribute it and/or modify
 it 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
 
 {- |
    Module      : Text.Pandoc.Templates
-   Copyright   : Copyright (C) 2009-2010 John MacFarlane
+   Copyright   : Copyright (C) 2009-2013 John MacFarlane
    License     : GNU GPL, version 2 or above
 
    Maintainer  : John MacFarlane <jgm@berkeley.edu>
@@ -27,16 +28,42 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    Portability : portable
 
 A simple templating system with variable substitution and conditionals.
-Example:
-
-> renderTemplate [("name","Sam"),("salary","50,000")] $
->    "Hi, $name$.  $if(salary)$You make $$$salary$.$else$No salary data.$endif$"
-> "Hi, John.  You make $50,000."
+The following program illustrates its use:
+
+> {-# LANGUAGE OverloadedStrings #-}
+> import Data.Text
+> import Data.Aeson
+> import Text.Pandoc.Templates
+>
+> data Employee = Employee { firstName :: String
+>                          , lastName  :: String
+>                          , salary    :: Maybe Int }
+> instance ToJSON Employee where
+>   toJSON e = object [ "name" .= object [ "first" .= firstName e
+>                                        , "last"  .= lastName e ]
+>                     , "salary" .= salary e ]
+>
+> employees :: [Employee]
+> employees = [ Employee "John" "Doe" Nothing
+>             , Employee "Omar" "Smith" (Just 30000)
+>             , Employee "Sara" "Chen" (Just 60000) ]
+>
+> template :: Template
+> template = either error id $ compileTemplate
+>   "$for(employee)$Hi, $employee.name.first$. $if(employee.salary)$You make $employee.salary$.$else$No salary data.$endif$$sep$\n$endfor$"
+>
+> main = putStrLn $ renderTemplate template $ object ["employee" .= employees ]
 
 A slot for an interpolated variable is a variable name surrounded
 by dollar signs.  To include a literal @$@ in your template, use
 @$$@.  Variable names must begin with a letter and can contain letters,
-numbers, @_@, and @-@.
+numbers, @_@, @-@, and @.@.
+
+The values of variables are determined by a JSON object that is
+passed as a parameter to @renderTemplate@.  So, for example,
+@title@ will return the value of the @title@ field, and
+@employee.salary@ will return the value of the @salary@ field
+of the object that is the value of the @employee@ field.
 
 The value of a variable will be indented to the same level as the
 variable.
@@ -49,39 +76,46 @@ is used.
 Conditional keywords should not be indented, or unexpected spacing
 problems may occur.
 
-If a variable name is associated with multiple values in the association
-list passed to 'renderTemplate', you may use the @$for$@ keyword to
-iterate over them:
-
-> renderTemplate [("name","Sam"),("name","Joe")] $
->   "$for(name)$\nHi, $name$.\n$endfor$"
-> "Hi, Sam.\nHi, Joe."
+The @$for$@ keyword can be used to iterate over an array.  If
+the value of the associated variable is not an array, a single
+iteration will be performed on its value.
 
-You may optionally specify separators using @$sep$@:
+You may optionally specify separators using @$sep$@, as in the
+example above.
 
-> renderTemplate [("name","Sam"),("name","Joe"),("name","Lynn")] $
->   "Hi, $for(name)$$name$$sep$, $endfor$"
-> "Hi, Sam, Joe, Lynn."
 -}
 
 module Text.Pandoc.Templates ( renderTemplate
-                             , TemplateTarget
+                             , TemplateTarget(..)
+                             , varListToJSON
+                             , compileTemplate
+                             , Template
                              , getDefaultTemplate ) where
 
-import Text.Parsec
-import Control.Monad (liftM, when, forM, mzero)
-import System.FilePath
-import Data.List (intercalate, intersperse)
+import Data.Char (isAlphaNum)
+import Control.Monad (guard, when)
+import Data.Aeson (ToJSON(..), Value(..))
+import qualified Data.Attoparsec.Text as A
+import Data.Attoparsec.Text (Parser)
+import Control.Applicative
+import qualified Data.Text as T
+import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
+import Data.Monoid ((<>), Monoid(..))
+import Data.List (intersperse, nub)
+import System.FilePath ((</>), (<.>))
+import qualified Data.Map as M
+import qualified Data.HashMap.Strict as H
+import Data.Foldable (toList)
+import qualified Control.Exception.Extensible as E (try, IOException)
 #if MIN_VERSION_blaze_html(0,5,0)
 import Text.Blaze.Html (Html)
-import Text.Blaze.Internal (preEscapedString)
+import Text.Blaze.Internal (preEscapedText)
 #else
-import Text.Blaze (preEscapedString, Html)
+import Text.Blaze (preEscapedText, Html)
 #endif
-import Text.Pandoc.UTF8 (fromStringLazy)
-import Data.ByteString.Lazy (ByteString)
+import Data.ByteString.Lazy (ByteString, fromChunks)
 import Text.Pandoc.Shared (readDataFileUTF8)
-import qualified Control.Exception.Extensible as E (try, IOException)
 
 -- | Get default template for the specified writer.
 getDefaultTemplate :: (Maybe FilePath) -- ^ User data directory to search first
@@ -100,119 +134,180 @@ getDefaultTemplate user writer = do
        _        -> let fname = "templates" </> "default" <.> format
                    in  E.try $ readDataFileUTF8 user fname
 
-data TemplateState = TemplateState Int [(String,String)]
+newtype Template = Template { unTemplate :: Value -> Text }
+                 deriving Monoid
 
-adjustPosition :: String -> Parsec [Char] TemplateState String
-adjustPosition str = do
-  let lastline = takeWhile (/= '\n') $ reverse str
-  updateState $ \(TemplateState pos x) ->
-    if str == lastline
-       then TemplateState (pos + length lastline) x
-       else TemplateState (length lastline) x
-  return str
+type Variable = [Text]
 
 class TemplateTarget a where
-  toTarget :: String -> a
+  toTarget :: Text -> a
 
-instance TemplateTarget String where
+instance TemplateTarget Text where
   toTarget = id
 
+instance TemplateTarget String where
+  toTarget = T.unpack
+
 instance TemplateTarget ByteString where
-  toTarget = fromStringLazy
+  toTarget = fromChunks . (:[]) . encodeUtf8
 
 instance TemplateTarget Html where
-  toTarget = preEscapedString
-
--- | Renders a template
-renderTemplate :: TemplateTarget a
-               => [(String,String)]  -- ^ Assoc. list of values for variables
-               -> String             -- ^ Template
-               -> a
-renderTemplate vals templ =
-  case runParser (do x <- parseTemplate; eof; return x) (TemplateState 0 vals) "template" templ of
-       Left e        -> error $ show e
-       Right r       -> toTarget $ concat r
-
-reservedWords :: [String]
+  toTarget = preEscapedText
+
+varListToJSON :: [(String, String)] -> Value
+varListToJSON assoc = toJSON $ M.fromList assoc'
+  where assoc' = [(T.pack k, toVal [T.pack z | (y,z) <- assoc,
+                                                not (null z),
+                                                y == k])
+                        | k <- nub $ map fst assoc ]
+        toVal [x] = toJSON x
+        toVal []  = Null
+        toVal xs  = toJSON xs
+
+renderTemplate :: (ToJSON a, TemplateTarget b) => Template -> a -> b
+renderTemplate template context =
+  toTarget $ renderTemplate' template (toJSON context)
+   where renderTemplate' (Template f) val = f val
+
+compileTemplate :: Text -> Either String Template
+compileTemplate template = A.parseOnly pTemplate template
+
+var :: Variable -> Template
+var = Template . resolveVar
+
+resolveVar :: Variable -> Value -> Text
+resolveVar var' val =
+  case multiLookup var' val of
+       Just (Array vec) -> mconcat $ map (resolveVar []) $ toList vec
+       Just (String t)  -> T.stripEnd t
+       Just (Number n)  -> T.pack $ show n
+       Just (Bool True) -> "true"
+       Just _           -> mempty
+       Nothing          -> mempty
+
+multiLookup :: [Text] -> Value -> Maybe Value
+multiLookup [] x = Just x
+multiLookup (v:vs) (Object o) = H.lookup v o >>= multiLookup vs
+multiLookup _ _ = Nothing
+
+lit :: Text -> Template
+lit = Template . const
+
+cond :: Variable -> Template -> Template -> Template
+cond var' (Template ifyes) (Template ifno) = Template $ \val ->
+  case resolveVar var' val of
+       "" -> ifno val
+       _  -> ifyes val
+
+iter :: Variable -> Template -> Template -> Template
+iter var' template sep = Template $ \val -> unTemplate
+  (case multiLookup var' val of
+           Just (Array vec) -> mconcat $ intersperse sep
+                                       $ map (setVar template var')
+                                       $ toList vec
+           Just x           -> setVar template var' x
+           Nothing          -> mempty) val
+
+setVar :: Template -> Variable -> Value -> Template
+setVar (Template f) var' val = Template $ f . replaceVar var' val
+
+replaceVar :: Variable -> Value -> Value -> Value
+replaceVar []     new _          = new
+replaceVar (v:vs) new (Object o) =
+  Object $ H.adjust (\x -> replaceVar vs new x) v o
+replaceVar _ _ old = old
+
+--- parsing
+
+pTemplate :: Parser Template
+pTemplate = do
+  sp <- A.option mempty pInitialSpace
+  rest <- mconcat <$> many (pConditional <|>
+                            pFor <|>
+                            pNewline <|>
+                            pVar <|>
+                            pLit <|>
+                            pEscapedDollar)
+  return $ sp <> rest
+
+pLit :: Parser Template
+pLit = lit <$> A.takeWhile1 (\x -> x /='$' && x /= '\n')
+
+pNewline :: Parser Template
+pNewline = do
+  A.char '\n'
+  sp <- A.option mempty pInitialSpace
+  return $ lit "\n" <> sp
+
+pInitialSpace :: Parser Template
+pInitialSpace = do
+  sps <- A.takeWhile1 (==' ')
+  let indentVar = if T.null sps
+                     then id
+                     else indent (T.length sps)
+  v <- A.option mempty $ indentVar <$> pVar
+  return $ lit sps <> v
+
+pEscapedDollar :: Parser Template
+pEscapedDollar = lit "$" <$ A.string "$$"
+
+pVar :: Parser Template
+pVar = var <$> (A.char '$' *> pIdent <* A.char '$')
+
+pIdent :: Parser [Text]
+pIdent = do
+  first <- pIdentPart
+  rest <- many (A.char '.' *> pIdentPart)
+  return (first:rest)
+
+pIdentPart :: Parser Text
+pIdentPart = do
+  first <- A.letter
+  rest <- A.takeWhile (\c -> isAlphaNum c || c == '_' || c == '-')
+  let id' = T.singleton first <> rest
+  guard $ id' `notElem` reservedWords
+  return id'
+
+reservedWords :: [Text]
 reservedWords = ["else","endif","for","endfor","sep"]
 
-parseTemplate :: Parsec [Char] TemplateState [String]
-parseTemplate =
-  many $ (plaintext <|> escapedDollar <|> conditional <|> for <|> variable)
-           >>= adjustPosition
-
-plaintext :: Parsec [Char] TemplateState String
-plaintext = many1 $ noneOf "$"
-
-escapedDollar :: Parsec [Char] TemplateState String
-escapedDollar = try $ string "$$" >> return "$"
-
-skipEndline :: Parsec [Char] st ()
-skipEndline = try $ skipMany (oneOf " \t") >> newline >> return ()
+skipEndline :: Parser ()
+skipEndline = A.skipWhile (`elem` " \t") >> A.char '\n' >> return ()
 
-conditional :: Parsec [Char] TemplateState String
-conditional = try $ do
-  TemplateState pos vars <- getState
-  string "$if("
-  id' <- ident
-  string ")$"
+pConditional :: Parser Template
+pConditional = do
+  A.string "$if("
+  id' <- pIdent
+  A.string ")$"
   -- if newline after the "if", then a newline after "endif" will be swallowed
-  multiline <- option False $ try $ skipEndline >> return True
-  ifContents <- liftM concat parseTemplate
-  -- reset state for else block
-  setState $ TemplateState pos vars
-  elseContents <- option "" $ do try (string "$else$")
-                                 when multiline $ optional skipEndline
-                                 liftM concat parseTemplate
-  string "$endif$"
-  when multiline $ optional skipEndline
-  let conditionSatisfied = case lookup id' vars of
-                                Nothing -> False
-                                Just "" -> False
-                                Just _  -> True
-  return $ if conditionSatisfied
-              then ifContents
-              else elseContents
-
-for :: Parsec [Char] TemplateState String
-for = try $ do
-  TemplateState pos vars <- getState
-  string "$for("
-  id' <- ident
-  string ")$"
+  multiline <- A.option False (True <$ skipEndline)
+  ifContents <- pTemplate
+  elseContents <- A.option mempty $
+                      do A.string "$else$"
+                         when multiline $ A.option () skipEndline
+                         pTemplate
+  A.string "$endif$"
+  when multiline $ A.option () skipEndline
+  return $ cond id' ifContents elseContents
+
+pFor :: Parser Template
+pFor = do
+  A.string "$for("
+  id' <- pIdent
+  A.string ")$"
   -- if newline after the "for", then a newline after "endfor" will be swallowed
-  multiline <- option False $ try $ skipEndline >> return True
-  let matches = filter (\(k,_) -> k == id') vars
-  let indent = replicate pos ' '
-  contents <- forM matches $ \m -> do
-                      updateState $ \(TemplateState p v) -> TemplateState p (m:v)
-                      raw <- liftM concat $ lookAhead parseTemplate
-                      return $ intercalate ('\n':indent) $ lines $ raw ++ "\n"
-  parseTemplate
-  sep <- option "" $ do try (string "$sep$")
-                        when multiline $ optional skipEndline
-                        liftM concat parseTemplate
-  string "$endfor$"
-  when multiline $ optional skipEndline
-  setState $ TemplateState pos vars
-  return $ concat $ intersperse sep contents
-
-ident :: Parsec [Char] TemplateState String
-ident = do
-  first <- letter
-  rest <- many (alphaNum <|> oneOf "_-")
-  let id' = first : rest
-  if id' `elem` reservedWords
-     then mzero
-     else return id'
-
-variable :: Parsec [Char] TemplateState String
-variable = try $ do
-  char '$'
-  id' <- ident
-  char '$'
-  TemplateState pos vars <- getState
-  let indent = replicate pos ' '
-  return $ case lookup id' vars of
-             Just val  -> intercalate ('\n' : indent) $ lines val
-             Nothing   -> ""
+  multiline <- A.option False $ skipEndline >> return True
+  contents <- pTemplate
+  sep <- A.option mempty $
+           do A.string "$sep$"
+              when multiline $ A.option () skipEndline
+              pTemplate
+  A.string "$endfor$"
+  when multiline $ A.option () skipEndline
+  return $ iter id' contents sep
+
+indent :: Int -> Template -> Template
+indent 0   x            = x
+indent ind (Template f) = Template $ \val -> indent' (f val)
+  where indent' t = T.concat
+                    $ intersperse ("\n" <> T.replicate ind " ") $ T.lines t
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 1e4b19184..1cc17d7fd 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -45,6 +45,7 @@ import Numeric ( showHex )
 import Data.Char ( ord, toLower )
 import Data.List ( isPrefixOf, intersperse )
 import Data.String ( fromString )
+import qualified Data.Text as T
 import Data.Maybe ( catMaybes )
 import Control.Monad.State
 import Text.Blaze.Html hiding(contents)
@@ -212,7 +213,10 @@ inTemplate opts tit auths authsMeta date toc body' newvars =
                          Nothing -> [])  ++
                     [ ("author", renderHtml a) | a <- auths ] ++
                     [ ("author-meta", stripTags $ renderHtml a) | a <- authsMeta ]
-  in  renderTemplate context $ writerTemplate opts
+      template    = case compileTemplate (T.pack $ writerTemplate opts) of
+                          Left  e -> error e
+                          Right t -> t
+  in  renderTemplate template (varListToJSON context)
 
 -- | Like Text.XHtml's identifier, but adds the writerIdentifierPrefix
 prefixedId :: WriterOptions -> String -> Attribute
diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs
index 5541aeb3b..17be983ce 100644
--- a/src/Text/Pandoc/Writers/Man.hs
+++ b/src/Text/Pandoc/Writers/Man.hs
@@ -38,6 +38,7 @@ import Text.Printf ( printf )
 import Data.List ( isPrefixOf, intersperse, intercalate )
 import Text.Pandoc.Pretty
 import Control.Monad.State
+import qualified Data.Text as T
 
 type Notes = [[Block]]
 data WriterState = WriterState { stNotes  :: Notes
@@ -77,8 +78,11 @@ pandocToMan opts (Pandoc (Meta title authors date) blocks) = do
                  , ("description", render' description) ] ++
                  [ ("has-tables", "yes") | hasTables ] ++
                  [ ("author", render' a) | a <- authors' ]
+      template = case compileTemplate (T.pack $ writerTemplate opts) of
+                       Left  e -> error e
+                       Right t -> t
   if writerStandalone opts
-     then return $ renderTemplate context $ writerTemplate opts
+     then return $ renderTemplate template (varListToJSON context)
      else return main
 
 -- | Return man representation of notes.