diff options
| -rw-r--r-- | .gitattributes | 1 | ||||
| -rw-r--r-- | doc/custom-writers.md | 16 | ||||
| -rw-r--r-- | pandoc-lua-engine/pandoc-lua-engine.cabal | 2 | ||||
| -rw-r--r-- | pandoc-lua-engine/src/Text/Pandoc/Lua/Writer.hs | 31 | ||||
| -rw-r--r-- | pandoc-lua-engine/test/Tests/Lua/Writer.hs | 23 | ||||
| -rw-r--r-- | pandoc-lua-engine/test/writer-template.lua | 7 | ||||
| -rw-r--r-- | pandoc-lua-engine/test/writer-template.out.txt | 4 | ||||
| -rw-r--r-- | src/Text/Pandoc/App/OutputSettings.hs | 52 | ||||
| -rw-r--r-- | src/Text/Pandoc/Scripting.hs | 5 |
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" |
