[API Change] Base custom writers on Writer type.

The `T.P.Lua.writeCustom` function changed to allow either a TextWriter
or ByteStringWriter to be returned. The global variables
`PANDOC_DOCUMENT` and `PANDOC_WRITER_OPTIONS` are no longer set when the
writer script is loaded. Both variables are still set in classic writers
before the conversion is started, so they can be used when they are
wrapped in functions.

6 files changed, 69 insertions, 48 deletions

diff --git a/data/sample.lua b/data/sample.lua
index c0adae230..aacc0d2b6 100644
--- a/data/sample.lua
+++ b/data/sample.lua
@@ -13,19 +13,19 @@
 -- produce informative error messages if your code contains
 -- syntax errors.
 
+function Writer (doc, opts)
+  PANDOC_DOCUMENT = doc
+  PANDOC_WRITER_OPTIONS = opts
+  loadfile(PANDOC_SCRIPT_FILE)()
+  return pandoc.write_classic(doc, opts)
+end
+
 local pipe = pandoc.pipe
 local stringify = (require 'pandoc.utils').stringify
 
--- The global variable PANDOC_DOCUMENT contains the full AST of
--- the document which is going to be written. It can be used to
--- configure the writer.
-local meta = PANDOC_DOCUMENT.meta
-
 -- Choose the image format based on the value of the
--- `image_format` meta value.
-local image_format = meta.image_format
-  and stringify(meta.image_format)
-  or 'png'
+-- `image_format` environment variable.
+local image_format = os.getenv 'image_format' or 'png'
 local image_mime_type = ({
     jpeg = 'image/jpeg',
     jpg = 'image/jpeg',
diff --git a/doc/custom-writers.md b/doc/custom-writers.md
index fc839c8a0..bb61be9da 100644
--- a/doc/custom-writers.md
+++ b/doc/custom-writers.md
@@ -81,7 +81,7 @@ end
 Custom writers using the new style must contain a global function
 named `Writer`. Pandoc calls this function with the document and
 writer options as arguments, and expects the function to return a
-string.
+UTF-8 encoded string.
 
 ``` lua
 function Writer (doc, opts)
@@ -89,6 +89,14 @@ function Writer (doc, opts)
 end
 ```
 
+Writers that do not return text but binary data should define a
+function with name `BinaryWriter` instead. The function must still
+return a string, but it does not have to be UTF-8 encoded and can
+contain arbitrary binary data.
+
+If both `Writer` and `BinaryWriter` functions are defined, then
+only the `Writer` function will be used.
+
 ## Example: modified Markdown writer
 
 Writers have access to all modules described in the [Lua filters
diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Writer.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Writer.hs
index f216ea63b..8dbae9eae 100644
--- a/pandoc-lua-engine/src/Text/Pandoc/Lua/Writer.hs
+++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Writer.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE LambdaCase          #-}
 {-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE TypeApplications    #-}
 {- |
    Module      : Text.Pandoc.Lua.Writer
    Copyright   : Copyright (C) 2012-2022 John MacFarlane
@@ -17,26 +18,28 @@ module Text.Pandoc.Lua.Writer
 
 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.Definition (Pandoc (..))
+import Text.Pandoc.Error (PandocError)
 import Text.Pandoc.Lua.Global (Global (..), setGlobals)
-import Text.Pandoc.Lua.Init (runLua)
-import Text.Pandoc.Options (WriterOptions)
+import Text.Pandoc.Lua.Init (runLuaWith)
+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 -> WriterOptions -> Pandoc -> m Text
-writeCustom luaFile opts doc = do
+            => FilePath -> m (Writer m)
+writeCustom luaFile = do
+  luaState <- liftIO newGCManagedState
   luaFile' <- fromMaybe luaFile <$> findFileWithDataFallback "writers" luaFile
-  either throw pure <=< runLua $ do
-    setGlobals [ PANDOC_DOCUMENT doc
+  either throw pure <=< runLuaWith luaState $ do
+    setGlobals [ PANDOC_DOCUMENT mempty
                , PANDOC_SCRIPT_FILE luaFile'
-               , PANDOC_WRITER_OPTIONS opts
+               , PANDOC_WRITER_OPTIONS def
                ]
     dofileTrace luaFile' >>= \case
       OK -> pure ()
@@ -50,14 +53,23 @@ writeCustom luaFile opts doc = do
           pushName x
           rawget (nth 2) <* remove (nth 2) -- remove global table
 
+    let writerField = "PANDOC Writer function"
+
     rawgetglobal "Writer" >>= \case
       TypeNil -> do
+        -- Neither `Writer` nor `BinaryWriter` are defined. Try to
+        -- use the file as a classic writer.
         pop 1  -- remove nil
-        Classic.runCustom opts doc
-      _       -> do
-        -- Writer on top of the stack. Call it with document and writer
-        -- options as arguments.
-        push doc
-        push opts
-        callTrace 2 1
-        forcePeek $ peekText top
+        return . TextWriter $ \opts doc ->
+          liftIO $ withGCManagedState luaState $ do
+            Classic.runCustom @PandocError opts doc
+      _ -> do
+        -- New-type text writer. Writer function is on top of the stack.
+        setfield registryindex writerField
+        return . TextWriter $ \opts doc ->
+          liftIO $ withGCManagedState luaState $ do
+            getfield registryindex writerField
+            push doc
+            push opts
+            callTrace 2 1
+            forcePeek @PandocError $ peekText top
diff --git a/pandoc-lua-engine/test/Tests/Lua/Writer.hs b/pandoc-lua-engine/test/Tests/Lua/Writer.hs
index 4086b9768..80d743dd5 100644
--- a/pandoc-lua-engine/test/Tests/Lua/Writer.hs
+++ b/pandoc-lua-engine/test/Tests/Lua/Writer.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase        #-}
 {- |
 Module      : Tests.Lua.Writer
 Copyright   : © 2019-2022 Albert Krewinkel
@@ -15,6 +16,7 @@ import Data.Default (Default (def))
 import Text.Pandoc.Class (runIOorExplode, readFileStrict)
 import Text.Pandoc.Lua (writeCustom)
 import Text.Pandoc.Readers (readNative)
+import Text.Pandoc.Writers (Writer (TextWriter))
 import Test.Tasty (TestTree)
 import Test.Tasty.Golden (goldenVsString)
 
@@ -28,7 +30,9 @@ tests =
     (runIOorExplode $ do
         source <- UTF8.toText <$> readFileStrict "testsuite.native"
         doc <- readNative def source
-        txt <- writeCustom "sample.lua" def doc
+        txt <- writeCustom "sample.lua" >>= \case
+          TextWriter f -> f def doc
+          _            -> error "Expected a text writer"
         pure $ BL.fromStrict (UTF8.fromText txt))
 
   , goldenVsString "tables testsuite"
@@ -36,6 +40,8 @@ tests =
     (runIOorExplode $ do
         source <- UTF8.toText <$> readFileStrict "tables.native"
         doc <- readNative def source
-        txt <- writeCustom "sample.lua" def doc
+        txt <- writeCustom "sample.lua" >>= \case
+          TextWriter f -> f def doc
+          _            -> error "Expected a text writer"
         pure $ BL.fromStrict (UTF8.fromText txt))
   ]
diff --git a/src/Text/Pandoc/App/OutputSettings.hs b/src/Text/Pandoc/App/OutputSettings.hs
index fd6b8afbd..e69cc4d47 100644
--- a/src/Text/Pandoc/App/OutputSettings.hs
+++ b/src/Text/Pandoc/App/OutputSettings.hs
@@ -102,24 +102,18 @@ optToOutputSettings scriptingEngine opts = do
                       optBibliography opts
            in  case pureWriter of
                  TextWriter w -> TextWriter $ \o d -> sandbox files (w o d)
-                 ByteStringWriter w
-                            -> ByteStringWriter $ \o d -> sandbox files (w o d)
-
+                 ByteStringWriter w ->
+                   ByteStringWriter $ \o d -> sandbox files (w o d)
 
   (writer, writerExts) <-
-            if ".lua" `T.isSuffixOf` format
-               then return ( TextWriter $
-                             engineWriteCustom scriptingEngine
-                                               (T.unpack writerName)
-                           , mempty
-                           )
-               else if optSandbox opts
-                       then
-                         case runPure (getWriter writerName) of
-                           Left e -> throwError e
-                           Right (w, wexts) ->
-                                  return (makeSandboxed w, wexts)
-                       else getWriter (T.toLower writerName)
+    if ".lua" `T.isSuffixOf` format
+    then (,mempty) <$> engineWriteCustom scriptingEngine (T.unpack writerName)
+    else if optSandbox opts
+         then
+           case runPure (getWriter writerName) of
+             Left e -> throwError e
+             Right (w, wexts) ->return (makeSandboxed w, wexts)
+         else getWriter (T.toLower writerName)
 
   let standalone = optStandalone opts || not (isTextFormat format) || pdfOutput
 
diff --git a/src/Text/Pandoc/Scripting.hs b/src/Text/Pandoc/Scripting.hs
index ce171c81a..17bc2f972 100644
--- a/src/Text/Pandoc/Scripting.hs
+++ b/src/Text/Pandoc/Scripting.hs
@@ -22,8 +22,9 @@ import Text.Pandoc.Definition (Pandoc)
 import Text.Pandoc.Class.PandocMonad (PandocMonad)
 import Text.Pandoc.Error (PandocError (PandocNoScriptingEngine))
 import Text.Pandoc.Filter.Environment (Environment)
-import Text.Pandoc.Options (ReaderOptions, WriterOptions)
+import Text.Pandoc.Options (ReaderOptions)
 import Text.Pandoc.Sources (Sources)
+import Text.Pandoc.Writers (Writer)
 
 -- | Structure to define a scripting engine.
 data ScriptingEngine = ScriptingEngine
@@ -39,7 +40,7 @@ data ScriptingEngine = ScriptingEngine
     -- ^ Function to parse input into a 'Pandoc' document.
 
   , engineWriteCustom :: forall m. (PandocMonad m, MonadIO m)
-                      => FilePath -> WriterOptions -> Pandoc -> m Text
+                      => FilePath -> m (Writer m)
     -- ^ Invoke the given script file to convert to any custom format.
   }
 
@@ -50,6 +51,6 @@ noEngine = ScriptingEngine
       throwError PandocNoScriptingEngine
   , engineReadCustom = \_fp _ropts _sources ->
       throwError PandocNoScriptingEngine
-  , engineWriteCustom = \_fp _wopts _doc ->
+  , engineWriteCustom = \_fp ->
       throwError PandocNoScriptingEngine
   }