aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2016-10-02 09:30:26 +0200
committerJohn MacFarlane <jgm@berkeley.edu>2016-10-02 09:30:26 +0200
commit5ec9b6352c3c31d7cdaa70f97e43e884e6b06fa1 (patch)
treec75b9c562f48ef81b423eabca89a978f7f5bd713
parentf49ed2e71a11023b09556f0fdf58abab90a675d8 (diff)
downloadpandoc-5ec9b6352c3c31d7cdaa70f97e43e884e6b06fa1.tar.gz
Moved template compiling/rendering code to a separate library.
jgm/doctemplates. This allows the pandoc templating system to be used independently.
-rw-r--r--deb/stack.yaml1
-rw-r--r--osx/stack.yaml1
-rw-r--r--pandoc.cabal1
-rw-r--r--src/Text/Pandoc/Templates.hs267
-rw-r--r--stack.full.yaml1
-rw-r--r--stack.yaml1
-rw-r--r--windows/stack.yaml1
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