Moved template compiling/rendering code to a separate library.

jgm/doctemplates.

This allows the pandoc templating system to be used independently.

7 files changed, 14 insertions, 259 deletions

diff --git a/deb/stack.yaml b/deb/stack.yaml
index 315162ab9..c12ff6c9d 100644
--- a/deb/stack.yaml
+++ b/deb/stack.yaml
@@ -15,6 +15,7 @@ packages:
 - '..'
 extra-deps:
 - pandoc-citeproc-0.10.1.1
+- doctemplates-0.1.0.0
 - http-client-0.5.0
 - http-client-tls-0.3.0
 resolver: lts-7.0
diff --git a/osx/stack.yaml b/osx/stack.yaml
index 61bd06f73..629ebc86a 100644
--- a/osx/stack.yaml
+++ b/osx/stack.yaml
@@ -18,6 +18,7 @@ packages:
 - '..'
 extra-deps:
 - pandoc-citeproc-0.10.1.1
+- doctemplates-0.1.0.0
 - 'http-client-0.5.0'
 - 'http-client-tls-0.3.0'
 resolver: lts-7.0
diff --git a/pandoc.cabal b/pandoc.cabal
index e8d34e73d..a91c9d02a 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -289,6 +289,7 @@ Library
                  JuicyPixels >= 3.1.6.1 && < 3.3,
                  filemanip >= 0.3 && < 0.4,
                  cmark >= 0.5 && < 0.6,
+                 doctemplates >= 0.1 && < 0.2,
                  ghc-prim >= 0.2
   if flag(old-locale)
      Build-Depends: old-locale >= 1 && < 1.1,
diff --git a/src/Text/Pandoc/Templates.hs b/src/Text/Pandoc/Templates.hs
index d111b3efa..d15d27438 100644
--- a/src/Text/Pandoc/Templates.hs
+++ b/src/Text/Pandoc/Templates.hs
@@ -28,92 +28,25 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    Portability : portable
 
 A simple templating system with variable substitution and conditionals.
-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 @.@.
-
-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.
-
-A conditional begins with @$if(variable_name)$@ and ends with @$endif$@.
-It may optionally contain an @$else$@ section.  The if section is
-used if @variable_name@ has a non-null value, otherwise the else section
-is used.
-
-Conditional keywords should not be indented, or unexpected spacing
-problems may occur.
-
-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$@, as in the
-example above.
 
 -}
 
 module Text.Pandoc.Templates ( renderTemplate
                              , renderTemplate'
-                             , TemplateTarget(..)
+                             , TemplateTarget
                              , varListToJSON
                              , compileTemplate
                              , Template
                              , getDefaultTemplate ) where
 
-import Data.Char (isAlphaNum)
-import Control.Monad (guard, when)
-import Data.Aeson (ToJSON(..), Value(..))
-import qualified Text.Parsec as P
-import Text.Parsec.Text (Parser)
-import Data.Monoid ((<>))
+import Text.DocTemplates (Template, TemplateTarget, compileTemplate,
+                          renderTemplate, applyTemplate,
+                          varListToJSON)
+import Data.Aeson (ToJSON(..))
 import qualified Data.Text as T
-import Data.Text (Text)
-import Data.Text.Encoding (encodeUtf8)
-import Data.List (intersperse)
 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)
-import Text.Blaze.Html (Html)
-import Text.Blaze.Internal (preEscapedText)
-import Data.ByteString.Lazy (ByteString, fromChunks)
-import Text.Pandoc.Shared (readDataFileUTF8, ordNub)
-import Data.Vector ((!?))
-import Control.Applicative (many, (<|>))
+import Text.Pandoc.Shared (readDataFileUTF8)
 
 -- | Get default template for the specified writer.
 getDefaultTemplate :: (Maybe FilePath) -- ^ User data directory to search first
@@ -135,191 +68,7 @@ getDefaultTemplate user writer = do
        _        -> let fname = "templates" </> "default" <.> format
                    in  E.try $ readDataFileUTF8 user fname
 
-newtype Template = Template { unTemplate :: Value -> Text }
-                 deriving Monoid
-
-type Variable = [Text]
-
-class TemplateTarget a where
-  toTarget :: Text -> a
-
-instance TemplateTarget Text where
-  toTarget = id
-
-instance TemplateTarget String where
-  toTarget = T.unpack
-
-instance TemplateTarget ByteString where
-  toTarget = fromChunks . (:[]) . encodeUtf8
-
-instance TemplateTarget Html where
-  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 <- ordNub $ map fst assoc ]
-        toVal [x] = toJSON x
-        toVal []  = Null
-        toVal xs  = toJSON xs
-
-renderTemplate :: (ToJSON a, TemplateTarget b) => Template -> a -> b
-renderTemplate (Template f) context = toTarget $ f $ toJSON context
-
-compileTemplate :: Text -> Either String Template
-compileTemplate template =
-  case P.parse (pTemplate <* P.eof) "template" template of
-       Left e   -> Left (show e)
-       Right x  -> Right x
-
--- | Like 'renderTemplate', but compiles the template first,
--- raising an error if compilation fails.
+-- | Like 'applyTemplate', but raising an error if compilation fails.
 renderTemplate' :: (ToJSON a, TemplateTarget b) => String -> a -> b
-renderTemplate' template =
-  renderTemplate (either error id $ compileTemplate $ T.pack template)
-
-var :: Variable -> Template
-var = Template . resolveVar
-
-resolveVar :: Variable -> Value -> Text
-resolveVar var' val =
-  case multiLookup var' val of
-       Just (Array vec) -> maybe mempty (resolveVar []) $ vec !? 0
-       Just (String t)  -> T.stripEnd t
-       Just (Number n)  -> T.pack $ show n
-       Just (Bool True) -> "true"
-       Just (Object _)  -> "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           -> cond var' (setVar template var' x) mempty
-           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 <- P.option mempty pInitialSpace
-  rest <- mconcat <$> many (pConditional <|>
-                            pFor <|>
-                            pNewline <|>
-                            pVar <|>
-                            pLit <|>
-                            pEscapedDollar)
-  return $ sp <> rest
-
-takeWhile1 :: (Char -> Bool) -> Parser Text
-takeWhile1 f = T.pack <$> P.many1 (P.satisfy f)
-
-pLit :: Parser Template
-pLit = lit <$> takeWhile1 (\x -> x /='$' && x /= '\n')
-
-pNewline :: Parser Template
-pNewline = do
-  P.char '\n'
-  sp <- P.option mempty pInitialSpace
-  return $ lit "\n" <> sp
-
-pInitialSpace :: Parser Template
-pInitialSpace = do
-  sps <- takeWhile1 (==' ')
-  let indentVar = if T.null sps
-                     then id
-                     else indent (T.length sps)
-  v <- P.option mempty $ indentVar <$> pVar
-  return $ lit sps <> v
-
-pEscapedDollar :: Parser Template
-pEscapedDollar = lit "$" <$ P.try (P.string "$$")
-
-pVar :: Parser Template
-pVar = var <$> (P.try $ P.char '$' *> pIdent <* P.char '$')
-
-pIdent :: Parser [Text]
-pIdent = do
-  first <- pIdentPart
-  rest <- many (P.char '.' *> pIdentPart)
-  return (first:rest)
-
-pIdentPart :: Parser Text
-pIdentPart = P.try $ do
-  first <- P.letter
-  rest <- T.pack <$> P.many (P.satisfy (\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"]
-
-skipEndline :: Parser ()
-skipEndline = P.try $ P.skipMany (P.satisfy (`elem` (" \t" :: String))) >> P.char '\n' >> return ()
-
-pConditional :: Parser Template
-pConditional = do
-  P.try $ P.string "$if("
-  id' <- pIdent
-  P.string ")$"
-  -- if newline after the "if", then a newline after "endif" will be swallowed
-  multiline <- P.option False (True <$ skipEndline)
-  ifContents <- pTemplate
-  elseContents <- P.option mempty $ P.try $
-                      do P.string "$else$"
-                         when multiline $ P.option () skipEndline
-                         pTemplate
-  P.string "$endif$"
-  when multiline $ P.option () skipEndline
-  return $ cond id' ifContents elseContents
-
-pFor :: Parser Template
-pFor = do
-  P.try $ P.string "$for("
-  id' <- pIdent
-  P.string ")$"
-  -- if newline after the "for", then a newline after "endfor" will be swallowed
-  multiline <- P.option False $ skipEndline >> return True
-  contents <- pTemplate
-  sep <- P.option mempty $
-           do P.try $ P.string "$sep$"
-              when multiline $ P.option () skipEndline
-              pTemplate
-  P.string "$endfor$"
-  when multiline $ P.option () skipEndline
-  return $ iter id' contents sep
+renderTemplate' template = either error id . applyTemplate (T.pack template)
 
-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/stack.full.yaml b/stack.full.yaml
index e405a4c27..899bc95b8 100644
--- a/stack.full.yaml
+++ b/stack.full.yaml
@@ -20,6 +20,7 @@ packages:
 - '../pandoc-citeproc'
 - '../pandoc-types'
 extra-deps:
+- doctemplates-0.1.0.0
 - http-client-0.5.0
 - http-client-tls-0.3.0
 resolver: lts-7.0
diff --git a/stack.yaml b/stack.yaml
index b1d68af03..a1a2d7530 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -10,4 +10,5 @@ packages:
 extra-deps:
 - http-client-0.5.0
 - http-client-tls-0.3.0
+- doctemplates-0.1.0.0
 resolver: lts-7.0
diff --git a/windows/stack.yaml b/windows/stack.yaml
index cfb8f8f0b..f6501deef 100644
--- a/windows/stack.yaml
+++ b/windows/stack.yaml
@@ -17,4 +17,5 @@ extra-deps:
 - 'http-client-0.5.0'
 - 'http-client-tls-0.3.0'
 - pandoc-citeproc-0.10.1.1
+- doctemplates-0.1.0.0
 resolver: lts-7.0