summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.gitattributes1
-rw-r--r--doc/custom-writers.md16
-rw-r--r--pandoc-lua-engine/pandoc-lua-engine.cabal2
-rw-r--r--pandoc-lua-engine/src/Text/Pandoc/Lua/Writer.hs31
-rw-r--r--pandoc-lua-engine/test/Tests/Lua/Writer.hs23
-rw-r--r--pandoc-lua-engine/test/writer-template.lua7
-rw-r--r--pandoc-lua-engine/test/writer-template.out.txt4
-rw-r--r--src/Text/Pandoc/App/OutputSettings.hs52
-rw-r--r--src/Text/Pandoc/Scripting.hs5
9 files changed, 104 insertions, 37 deletions
diff --git a/.gitattributes b/.gitattributes
index bda8ebee6..a6aaa9577 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -1,2 +1,3 @@
test/fb2/reader/* -text
pandoc-lua-engine/test/*.custom -text
+pandoc-lua-engine/test/*.txt -text
diff --git a/doc/custom-writers.md b/doc/custom-writers.md
index 038067a3e..aa2796d00 100644
--- a/doc/custom-writers.md
+++ b/doc/custom-writers.md
@@ -83,6 +83,17 @@ function Writer (doc, opts)
end
```
+## Default template
+
+The default template of a custom writer is defined by the return
+value of the global function `Template`. Pandoc uses the default
+template for rendering when the user has not specified a template,
+but invoked with the `-s`/`--standalone` flag.
+
+The `Template` global can be left undefined, in which case pandoc
+will throw an error when it would otherwise use the default
+template.
+
## Example: modified Markdown writer
Writers have access to all modules described in the [Lua filters
@@ -106,6 +117,11 @@ function Writer (doc, opts)
}
return pandoc.write(doc:walk(filter), 'gfm', opts)
end
+
+function Template ()
+ local template = pandoc.template
+ return template.compile(template.default 'gfm')
+end
```
[Lua filters documentation]: https://pandoc.org/lua-filters.html
diff --git a/pandoc-lua-engine/pandoc-lua-engine.cabal b/pandoc-lua-engine/pandoc-lua-engine.cabal
index 3c632026b..b20f9afc7 100644
--- a/pandoc-lua-engine/pandoc-lua-engine.cabal
+++ b/pandoc-lua-engine/pandoc-lua-engine.cabal
@@ -32,6 +32,8 @@ extra-source-files: README.md
, test/tables.native
, test/testsuite.native
, test/writer.custom
+ , test/writer-template.lua
+ , test/writer-template.out.txt
source-repository head
type: git
diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Writer.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Writer.hs
index a9a044fe6..eeec9b6af 100644
--- a/pandoc-lua-engine/src/Text/Pandoc/Lua/Writer.hs
+++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Writer.hs
@@ -21,21 +21,24 @@ import Control.Exception
import Control.Monad ((<=<))
import Data.Default (def)
import Data.Maybe (fromMaybe)
+import Data.Text (Text)
import HsLua
import HsLua.Core.Run (newGCManagedState, withGCManagedState)
import Control.Monad.IO.Class (MonadIO)
import Text.Pandoc.Class (PandocMonad, findFileWithDataFallback)
-import Text.Pandoc.Error (PandocError)
+import Text.Pandoc.Error (PandocError (..))
import Text.Pandoc.Format (ExtensionsConfig (..))
import Text.Pandoc.Lua.Global (Global (..), setGlobals)
import Text.Pandoc.Lua.Init (runLuaWith)
import Text.Pandoc.Lua.Marshal.Format (peekExtensionsConfig)
+import Text.Pandoc.Lua.Marshal.Template (peekTemplate)
+import Text.Pandoc.Templates (Template)
import Text.Pandoc.Writers (Writer (..))
import qualified Text.Pandoc.Lua.Writer.Classic as Classic
-- | Convert Pandoc to custom markup.
writeCustom :: (PandocMonad m, MonadIO m)
- => FilePath -> m (Writer m, ExtensionsConfig)
+ => FilePath -> m (Writer m, ExtensionsConfig, m (Template Text))
writeCustom luaFile = do
luaState <- liftIO newGCManagedState
luaFile' <- fromMaybe luaFile <$> findFileWithDataFallback "writers" luaFile
@@ -56,25 +59,39 @@ writeCustom luaFile = do
pushName x
rawget (nth 2) <* remove (nth 2) -- remove global table
- let writerField = "PANDOC Writer function"
+ let writerField = "Pandoc Writer function"
extsConf <- rawgetglobal "writer_extensions" >>= \case
- TypeNil -> pure $ ExtensionsConfig mempty mempty
+ TypeNil -> ExtensionsConfig mempty mempty <$ pop 1
_ -> forcePeek $ peekExtensionsConfig top `lastly` pop 1
+ -- Store template function in registry
+ let templateField = "Pandoc Writer Template"
+ rawgetglobal "Template" *> setfield registryindex templateField
+
+ let getTemplate = liftIO $ withGCManagedState @PandocError luaState $ do
+ getfield registryindex templateField >>= \case
+ TypeNil -> failLua $ "No default template for writer; " <>
+ "the global variable Template is undefined."
+ _ -> do
+ callTrace 0 1
+ forcePeek $ peekTemplate top `lastly` pop 1
+
+ let addProperties = (, extsConf, getTemplate)
+
rawgetglobal "Writer" >>= \case
TypeNil -> rawgetglobal "ByteStringWriter" >>= \case
TypeNil -> do
-- Neither `Writer` nor `BinaryWriter` are defined. Try to
-- use the file as a classic writer.
pop 1 -- remove nil
- pure $ (,extsConf) . TextWriter $ \opts doc ->
+ pure $ addProperties . TextWriter $ \opts doc ->
liftIO $ withGCManagedState luaState $ do
Classic.runCustom @PandocError opts doc
_ -> do
-- Binary writer. Writer function is on top of the stack.
setfield registryindex writerField
- pure $ (,extsConf) . ByteStringWriter $ \opts doc ->
+ pure $ addProperties . ByteStringWriter $ \opts doc ->
-- Call writer with document and writer options as arguments.
liftIO $ withGCManagedState luaState $ do
getfield registryindex writerField
@@ -85,7 +102,7 @@ writeCustom luaFile = do
_ -> do
-- New-type text writer. Writer function is on top of the stack.
setfield registryindex writerField
- pure $ (,extsConf) . TextWriter $ \opts doc ->
+ pure $ addProperties . TextWriter $ \opts doc ->
liftIO $ withGCManagedState luaState $ do
getfield registryindex writerField
push doc
diff --git a/pandoc-lua-engine/test/Tests/Lua/Writer.hs b/pandoc-lua-engine/test/Tests/Lua/Writer.hs
index 8b6e82816..18274d124 100644
--- a/pandoc-lua-engine/test/Tests/Lua/Writer.hs
+++ b/pandoc-lua-engine/test/Tests/Lua/Writer.hs
@@ -35,7 +35,7 @@ tests =
source <- UTF8.toText <$> readFileStrict "testsuite.native"
doc <- readNative def source
txt <- writeCustom "sample.lua" >>= \case
- (TextWriter f, _) -> f def doc
+ (TextWriter f, _, _) -> f def doc
_ -> error "Expected a text writer"
pure $ BL.fromStrict (UTF8.fromText txt))
@@ -45,23 +45,34 @@ tests =
source <- UTF8.toText <$> readFileStrict "tables.native"
doc <- readNative def source
txt <- writeCustom "sample.lua" >>= \case
- (TextWriter f, _) -> f def doc
+ (TextWriter f, _, _) -> f def doc
_ -> error "Expected a text writer"
pure $ BL.fromStrict (UTF8.fromText txt))
- , goldenVsString "tables testsuite"
+ , goldenVsString "bytestring writer"
"bytestring.bin"
(runIOorExplode $ do
txt <- writeCustom "bytestring.lua" >>= \case
- (ByteStringWriter f, _) -> f def mempty
+ (ByteStringWriter f, _, _) -> f def mempty
_ -> error "Expected a bytestring writer"
pure txt)
+ , goldenVsString "template"
+ "writer-template.out.txt"
+ (runIOorExplode $ do
+ txt <- writeCustom "writer-template.lua" >>= \case
+ (TextWriter f, _, mt) -> do
+ template <- mt
+ let opts = def{ writerTemplate = Just template }
+ f opts (B.doc (B.plain (B.str "body goes here")))
+ _ -> error "Expected a text writer"
+ pure $ BL.fromStrict (UTF8.fromText txt))
+
, testCase "preset extensions" $ do
let ediff = ExtensionsDiff{extsToEnable = [], extsToDisable = []}
let format = FlavoredFormat "extensions.lua" ediff
result <- runIOorExplode $ writeCustom "extensions.lua" >>= \case
- (TextWriter write, extsConf) -> do
+ (TextWriter write, extsConf, _) -> do
exts <- applyExtensionsDiff extsConf format
write def{writerExtensions = exts} (B.doc mempty)
_ -> error "Expected a text writer"
@@ -73,7 +84,7 @@ tests =
}
let format = FlavoredFormat "extensions.lua" ediff
result <- runIOorExplode $ writeCustom "extensions.lua" >>= \case
- (TextWriter write, extsConf) -> do
+ (TextWriter write, extsConf, _) -> do
exts <- applyExtensionsDiff extsConf format
write def{writerExtensions = exts} (B.doc mempty)
_ -> error "Expected a text writer"
diff --git a/pandoc-lua-engine/test/writer-template.lua b/pandoc-lua-engine/test/writer-template.lua
new file mode 100644
index 000000000..c90f7c1ef
--- /dev/null
+++ b/pandoc-lua-engine/test/writer-template.lua
@@ -0,0 +1,7 @@
+function Writer (doc, opts)
+ return pandoc.write(doc, 'gfm', opts)
+end
+
+function Template ()
+ return pandoc.template.compile '<!-- start -->\n$body$\n<!-- stop -->\n'
+end
diff --git a/pandoc-lua-engine/test/writer-template.out.txt b/pandoc-lua-engine/test/writer-template.out.txt
new file mode 100644
index 000000000..1fb343c28
--- /dev/null
+++ b/pandoc-lua-engine/test/writer-template.out.txt
@@ -0,0 +1,4 @@
+<!-- start -->
+body goes here
+
+<!-- stop -->
diff --git a/src/Text/Pandoc/App/OutputSettings.hs b/src/Text/Pandoc/App/OutputSettings.hs
index 537def363..2499832ba 100644
--- a/src/Text/Pandoc/App/OutputSettings.hs
+++ b/src/Text/Pandoc/App/OutputSettings.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
@@ -104,20 +105,40 @@ optToOutputSettings scriptingEngine opts = do
flvrd@(Format.FlavoredFormat format _extsDiff) <-
Format.parseFlavoredFormat writerName
- (writer, writerExts) <-
+
+ let standalone = optStandalone opts || not (isTextFormat format) || pdfOutput
+ let processCustomTemplate getDefault =
+ case optTemplate opts of
+ _ | not standalone -> return Nothing
+ Nothing -> Just <$> getDefault
+ Just tp -> do
+ -- strip off extensions
+ let tp' = case takeExtension tp of
+ "" -> tp <.> T.unpack format
+ _ -> tp
+ getTemplate tp'
+ >>= runWithPartials . compileTemplate tp'
+ >>= (\case
+ Left e -> throwError $ PandocTemplateError (T.pack e)
+ Right t -> return $ Just t)
+
+ (writer, writerExts, mtemplate) <-
if "lua" `T.isSuffixOf` format
then do
- (w, extsConf) <- engineWriteCustom scriptingEngine (T.unpack format)
- wexts <- Format.applyExtensionsDiff extsConf flvrd
- return (w, wexts)
+ (w, extsConf, mt) <- engineWriteCustom scriptingEngine (T.unpack format)
+ wexts <- Format.applyExtensionsDiff extsConf flvrd
+ templ <- processCustomTemplate mt
+ return (w, wexts, templ)
else do
+ tmpl <- processCustomTemplate (compileDefaultTemplate format)
if optSandbox opts
then case runPure (getWriter flvrd) of
- Right (w, wexts) -> return (makeSandboxed w, wexts)
+ Right (w, wexts) -> return (makeSandboxed w, wexts, tmpl)
Left e -> throwError e
- else getWriter flvrd
+ else do
+ (w, wexts) <- getWriter flvrd
+ return (w, wexts, tmpl)
- let standalone = optStandalone opts || not (isTextFormat format) || pdfOutput
let addSyntaxMap existingmap f = do
res <- liftIO (parseSyntaxDefinition f)
@@ -186,23 +207,8 @@ optToOutputSettings scriptingEngine opts = do
setVariableM "dzslides-core" dzcore vars
else return vars)
- templ <- case optTemplate opts of
- _ | not standalone -> return Nothing
- Nothing ->
- let filename = T.pack . takeFileName . T.unpack
- in Just <$> compileDefaultTemplate (filename format)
- Just tp -> do
- -- strip off extensions
- let tp' = case takeExtension tp of
- "" -> tp <.> T.unpack format
- _ -> tp
- res <- getTemplate tp' >>= runWithPartials . compileTemplate tp'
- case res of
- Left e -> throwError $ PandocTemplateError $ T.pack e
- Right t -> return $ Just t
-
let writerOpts = def {
- writerTemplate = templ
+ writerTemplate = mtemplate
, writerVariables = variables
, writerTabStop = optTabStop opts
, writerTableOfContents = optTableOfContents opts
diff --git a/src/Text/Pandoc/Scripting.hs b/src/Text/Pandoc/Scripting.hs
index d4be7e377..5e26b0279 100644
--- a/src/Text/Pandoc/Scripting.hs
+++ b/src/Text/Pandoc/Scripting.hs
@@ -23,6 +23,7 @@ import Text.Pandoc.Definition (Pandoc)
import Text.Pandoc.Error (PandocError (PandocNoScriptingEngine))
import Text.Pandoc.Filter.Environment (Environment)
import Text.Pandoc.Format (ExtensionsConfig)
+import Text.Pandoc.Templates (Template)
import Text.Pandoc.Readers (Reader)
import Text.Pandoc.Writers (Writer)
@@ -40,10 +41,12 @@ data ScriptingEngine = ScriptingEngine
-- ^ Function to parse input into a 'Pandoc' document.
, engineWriteCustom :: forall m. (PandocMonad m, MonadIO m)
- => FilePath -> m (Writer m, ExtensionsConfig)
+ => FilePath -> m (WriterProperties m)
-- ^ Invoke the given script file to convert to any custom format.
}
+type WriterProperties m = (Writer m, ExtensionsConfig, m (Template Text))
+
noEngine :: ScriptingEngine
noEngine = ScriptingEngine
{ engineName = "none"