module Text.Pandoc.Templates ( renderTemplate
, TemplateTarget
, getDefaultTemplate ) where
import Text.Parsec
import Control.Monad (liftM, when, forM, mzero)
import System.FilePath
import Data.List (intercalate, intersperse)
#if MIN_VERSION_blaze_html(0,5,0)
import Text.Blaze.Html (Html)
import Text.Blaze.Internal (preEscapedString)
#else
import Text.Blaze (preEscapedString, Html)
#endif
import Text.Pandoc.UTF8 (fromStringLazy)
import Data.ByteString.Lazy (ByteString)
import Text.Pandoc.Shared (readDataFileUTF8)
import qualified Control.Exception.Extensible as E (try, IOException)
getDefaultTemplate :: (Maybe FilePath)
-> String
-> IO (Either E.IOException String)
getDefaultTemplate user writer = do
let format = takeWhile (`notElem` "+-") writer
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"
_ -> let fname = "templates" </> "default" <.> format
in E.try $ readDataFileUTF8 user fname
data TemplateState = TemplateState Int [(String,String)]
adjustPosition :: String -> Parsec [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 = fromStringLazy
instance TemplateTarget Html where
toTarget = preEscapedString
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 :: Parsec [Char] TemplateState [String]
parseTemplate =
many $ (plaintext <|> escapedDollar <|> conditional <|> for <|> variable)
>>= adjustPosition
plaintext :: Parsec [Char] TemplateState String
plaintext = many1 $ noneOf "$"
escapedDollar :: Parsec [Char] TemplateState String
escapedDollar = try $ string "$$" >> return "$"
skipEndline :: Parsec [Char] st ()
skipEndline = try $ skipMany (oneOf " \t") >> newline >> return ()
conditional :: Parsec [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 :: Parsec [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 :: Parsec [Char] TemplateState String
ident = do
first <- letter
rest <- many (alphaNum <|> oneOf "_-")
let id' = first : rest
if id' `elem` reservedWords
then mzero
else return id'
variable :: Parsec [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 -> ""