0b16b08543
Previously if `foo` is an array (which might be because multiple values were set on the command line), `$foo$` would resolve to the concatenation of the elements of foo. This is rarely useful behavior. It has been changed so that the first value is rendered. Of course, you can still iterate over the values using `$for(foo)$`. This has the result that you can override earlier settings using -V by putting new values later on the command line. That's useful for many purposes.
321 lines
11 KiB
Haskell
321 lines
11 KiB
Haskell
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, CPP,
|
|
OverloadedStrings, GeneralizedNewtypeDeriving #-}
|
|
{-
|
|
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
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
(at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
-}
|
|
|
|
{- |
|
|
Module : Text.Pandoc.Templates
|
|
Copyright : Copyright (C) 2009-2013 John MacFarlane
|
|
License : GNU GPL, version 2 or above
|
|
|
|
Maintainer : John MacFarlane <jgm@berkeley.edu>
|
|
Stability : alpha
|
|
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(..)
|
|
, varListToJSON
|
|
, compileTemplate
|
|
, Template
|
|
, getDefaultTemplate ) where
|
|
|
|
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 Text.Pandoc.Compat.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 (preEscapedText)
|
|
#else
|
|
import Text.Blaze (preEscapedText, Html)
|
|
#endif
|
|
import Data.ByteString.Lazy (ByteString, fromChunks)
|
|
import Text.Pandoc.Shared (readDataFileUTF8)
|
|
import Data.Vector ((!?))
|
|
|
|
-- | Get default template for the specified writer.
|
|
getDefaultTemplate :: (Maybe FilePath) -- ^ User data directory to search first
|
|
-> String -- ^ Name of writer
|
|
-> IO (Either E.IOException String)
|
|
getDefaultTemplate user writer = do
|
|
let format = takeWhile (`notElem` "+-") writer -- strip off extensions
|
|
case format of
|
|
"native" -> return $ Right ""
|
|
"json" -> return $ Right ""
|
|
"docx" -> return $ Right ""
|
|
"odt" -> getDefaultTemplate user "opendocument"
|
|
"markdown_strict" -> getDefaultTemplate user "markdown"
|
|
"multimarkdown" -> getDefaultTemplate user "markdown"
|
|
"markdown_github" -> getDefaultTemplate user "markdown"
|
|
"markdown_mmd" -> getDefaultTemplate user "markdown"
|
|
"markdown_phpextra" -> getDefaultTemplate user "markdown"
|
|
_ -> 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 <- nub $ 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 = A.parseOnly pTemplate template
|
|
|
|
-- | Like 'renderTemplate', but compiles the template first,
|
|
-- 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 _ -> 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 <- 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"]
|
|
|
|
skipEndline :: Parser ()
|
|
skipEndline = A.skipWhile (`elem` " \t") >> A.char '\n' >> return ()
|
|
|
|
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 <- 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 <- 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
|