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.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
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 -> ""