module Text.Pandoc.Templates ( renderTemplate
, TemplateTarget
, getDefaultTemplate ) where
import Text.ParserCombinators.Parsec
import Control.Monad (liftM, when, forM)
import System.FilePath
import Data.List (intercalate, intersperse)
import Text.PrettyPrint (text, Doc)
import Text.XHtml (primHtml, Html)
import Data.ByteString.Lazy.UTF8 (ByteString, fromString)
import Text.Pandoc.Shared (readDataFile)
import qualified Control.Exception.Extensible as E (try, IOException)
getDefaultTemplate :: (Maybe FilePath)
-> String
-> IO (Either E.IOException String)
getDefaultTemplate _ "native" = return $ Right ""
getDefaultTemplate user "odt" = getDefaultTemplate user "opendocument"
getDefaultTemplate user writer = do
let format = takeWhile (/='+') writer
let fname = "templates" </> format <.> "template"
E.try $ readDataFile user fname
data TemplateState = TemplateState Int [(String,String)]
adjustPosition :: String -> GenParser 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
class TemplateTarget a where
toTarget :: String -> a
instance TemplateTarget String where
toTarget = id
instance TemplateTarget ByteString where
toTarget = fromString
instance TemplateTarget Html where
toTarget = primHtml
instance TemplateTarget Doc where
toTarget = text
renderTemplate :: TemplateTarget a
=> [(String,String)]
-> String
-> 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]
reservedWords = ["else","endif","for","endfor","sep"]
parseTemplate :: GenParser Char TemplateState [String]
parseTemplate =
many $ (plaintext <|> escapedDollar <|> conditional <|> for <|> variable)
>>= adjustPosition
plaintext :: GenParser Char TemplateState String
plaintext = many1 $ noneOf "$"
escapedDollar :: GenParser Char TemplateState String
escapedDollar = try $ string "$$" >> return "$"
skipEndline :: GenParser Char st ()
skipEndline = try $ skipMany (oneOf " \t") >> newline >> return ()
conditional :: GenParser Char TemplateState String
conditional = try $ do
TemplateState pos vars <- getState
string "$if("
id' <- ident
string ")$"
multiline <- option False $ try $ skipEndline >> return True
ifContents <- liftM concat parseTemplate
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 :: GenParser Char TemplateState String
for = try $ do
TemplateState pos vars <- getState
string "$for("
id' <- ident
string ")$"
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 :: GenParser Char TemplateState String
ident = do
first <- letter
rest <- many (alphaNum <|> oneOf "_-")
let id' = first : rest
if id' `elem` reservedWords
then pzero
else return id'
variable :: GenParser 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 -> ""