Lua: provide global `PANDOC_WRITER_OPTIONS` [API change]

API changes:

- The function T.P.Filter.applyFilters now takes a filter
  environment of type `Environment`, instead of a ReaderOptions value.
  The `Environment` type is exported from `T.P.Filter` and allows to
  combine ReaderOptions and WriterOptions in a single value.

- Global, exported from T.P.Lua, has a new type constructor
  `PANDOC_WRITER_OPTIONS`.

Closes: #5221

7 files changed, 311 insertions, 19 deletions

diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs
index 9eb9c2cf3..f3a1c8f28 100644
--- a/src/Text/Pandoc/App.hs
+++ b/src/Text/Pandoc/App.hs
@@ -60,7 +60,8 @@ import Text.Pandoc.App.CommandLineOptions (parseOptions, parseOptionsFromArgs,
                                            options)
 import Text.Pandoc.App.OutputSettings (OutputSettings (..), optToOutputSettings)
 import Text.Collate.Lang (Lang (..), parseLang)
-import Text.Pandoc.Filter (Filter (JSONFilter, LuaFilter), applyFilters)
+import Text.Pandoc.Filter (Filter (JSONFilter, LuaFilter), Environment (..),
+                           applyFilters)
 import Text.Pandoc.PDF (makePDF)
 import Text.Pandoc.SelfContained (makeSelfContained)
 import Text.Pandoc.Shared (eastAsianLineBreakFilter, stripEmptyParagraphs,
@@ -280,6 +281,7 @@ convertWithOpts opts = do
           maybe id (setMeta "citation-abbreviations")
                          (optCitationAbbreviations opts) $ mempty
 
+    let filterEnv = Environment readerOpts writerOptions
     doc <- (case reader of
              TextReader r
                | readerNameBase == "json" ->
@@ -305,7 +307,7 @@ convertWithOpts opts = do
               >=> return . adjustMetadata (<> optMetadata opts)
               >=> return . adjustMetadata (<> cslMetadata)
               >=> applyTransforms transforms
-              >=> applyFilters readerOpts filters [T.unpack format]
+              >=> applyFilters filterEnv filters [T.unpack format]
               >=> maybe return extractMedia (optExtractMedia opts)
               )
 
diff --git a/src/Text/Pandoc/Filter.hs b/src/Text/Pandoc/Filter.hs
index cea65bb21..e4640db94 100644
--- a/src/Text/Pandoc/Filter.hs
+++ b/src/Text/Pandoc/Filter.hs
@@ -14,6 +14,7 @@ Programmatically modifications of pandoc documents.
 -}
 module Text.Pandoc.Filter
   ( Filter (..)
+  , Environment (..)
   , applyFilters
   ) where
 
@@ -22,7 +23,7 @@ import Data.Aeson
 import GHC.Generics (Generic)
 import Text.Pandoc.Class (report, getVerbosity, PandocMonad)
 import Text.Pandoc.Definition (Pandoc)
-import Text.Pandoc.Options (ReaderOptions)
+import Text.Pandoc.Filter.Environment (Environment (..))
 import Text.Pandoc.Logging
 import Text.Pandoc.Citeproc (processCitations)
 import qualified Text.Pandoc.Filter.JSON as JSONFilter
@@ -71,19 +72,19 @@ instance ToJSON Filter where
 
 -- | Modify the given document using a filter.
 applyFilters :: (PandocMonad m, MonadIO m)
-             => ReaderOptions
+             => Environment
              -> [Filter]
              -> [String]
              -> Pandoc
              -> m Pandoc
-applyFilters ropts filters args d = do
+applyFilters fenv filters args d = do
   expandedFilters <- mapM expandFilterPath filters
   foldM applyFilter d expandedFilters
  where
   applyFilter doc (JSONFilter f) =
-    withMessages f $ JSONFilter.apply ropts args f doc
+    withMessages f $ JSONFilter.apply fenv args f doc
   applyFilter doc (LuaFilter f)  =
-    withMessages f $ LuaFilter.apply ropts args f doc
+    withMessages f $ LuaFilter.apply fenv args f doc
   applyFilter doc CiteprocFilter =
     processCitations doc
   withMessages f action = do
diff --git a/src/Text/Pandoc/Filter/Environment.hs b/src/Text/Pandoc/Filter/Environment.hs
new file mode 100644
index 000000000..2e8809bc4
--- /dev/null
+++ b/src/Text/Pandoc/Filter/Environment.hs
@@ -0,0 +1,27 @@
+{- |
+   Module      : Text.Pandoc.Filter.Environment
+   Copyright   : ©2020-2021 Albert Krewinkel
+   License     : GNU GPL, version 2 or above
+
+   Maintainer  : Albert Krewinkel <[email protected]>
+   Stability   : alpha
+   Portability : portable
+
+Environment for pandoc filters.
+-}
+module Text.Pandoc.Filter.Environment
+  ( Environment (..)
+  ) where
+
+import Data.Default (Default (def))
+import Text.Pandoc.Options (ReaderOptions, WriterOptions)
+
+-- | Environment in which a filter is run. This includes reader and
+-- writer options.
+data Environment = Environment
+  { envReaderOptions :: ReaderOptions
+  , envWriterOptions :: WriterOptions
+  }
+
+instance Default Environment where
+  def = Environment def def
diff --git a/src/Text/Pandoc/Filter/JSON.hs b/src/Text/Pandoc/Filter/JSON.hs
index d2323fac4..48b776455 100644
--- a/src/Text/Pandoc/Filter/JSON.hs
+++ b/src/Text/Pandoc/Filter/JSON.hs
@@ -23,16 +23,16 @@ import System.Directory (executable, doesFileExist, findExecutable,
 import System.Environment (getEnvironment)
 import System.Exit (ExitCode (..))
 import System.FilePath ((</>), takeExtension)
-import Text.Pandoc.Error (PandocError (PandocFilterError))
 import Text.Pandoc.Definition (Pandoc)
-import Text.Pandoc.Options (ReaderOptions)
+import Text.Pandoc.Error (PandocError (PandocFilterError))
+import Text.Pandoc.Filter.Environment (Environment (..))
 import Text.Pandoc.Process (pipeProcess)
 import Text.Pandoc.Shared (pandocVersion, tshow)
 import qualified Control.Exception as E
 import qualified Text.Pandoc.UTF8 as UTF8
 
 apply :: MonadIO m
-      => ReaderOptions
+      => Environment
       -> [String]
       -> FilePath
       -> Pandoc
@@ -40,8 +40,8 @@ apply :: MonadIO m
 apply ropts args f = liftIO . externalFilter ropts f args
 
 externalFilter :: MonadIO m
-               => ReaderOptions -> FilePath -> [String] -> Pandoc -> m Pandoc
-externalFilter ropts f args' d = liftIO $ do
+               => Environment -> FilePath -> [String] -> Pandoc -> m Pandoc
+externalFilter fenv f args' d = liftIO $ do
   exists <- doesFileExist f
   isExecutable <- if exists
                      then executable <$> getPermissions f
@@ -62,6 +62,7 @@ externalFilter ropts f args' d = liftIO $ do
     mbExe <- findExecutable f'
     when (isNothing mbExe) $
       E.throwIO $ PandocFilterError fText (T.pack $ "Could not find executable " <> f')
+  let ropts = envReaderOptions fenv
   env <- getEnvironment
   let env' = Just
            ( ("PANDOC_VERSION", T.unpack pandocVersion)
diff --git a/src/Text/Pandoc/Filter/Lua.hs b/src/Text/Pandoc/Filter/Lua.hs
index 4e264261b..fe0a5ba87 100644
--- a/src/Text/Pandoc/Filter/Lua.hs
+++ b/src/Text/Pandoc/Filter/Lua.hs
@@ -18,25 +18,26 @@ import Text.Pandoc.Class (PandocMonad)
 import Control.Monad.Trans (MonadIO)
 import Text.Pandoc.Definition (Pandoc)
 import Text.Pandoc.Error (PandocError (PandocFilterError, PandocLuaError))
+import Text.Pandoc.Filter.Environment (Environment (..))
 import Text.Pandoc.Lua (Global (..), runLua, runFilterFile, setGlobals)
-import Text.Pandoc.Options (ReaderOptions)
 
 -- | Run the Lua filter in @filterPath@ for a transformation to the
 -- target format (first element in args). Pandoc uses Lua init files to
 -- setup the Lua interpreter.
 apply :: (PandocMonad m, MonadIO m)
-      => ReaderOptions
+      => Environment
       -> [String]
       -> FilePath
       -> Pandoc
       -> m Pandoc
-apply ropts args fp doc = do
+apply fenv args fp doc = do
   let format = case args of
                  (x:_) -> x
                  _     -> error "Format not supplied for Lua filter"
   runLua >=> forceResult fp $ do
     setGlobals [ FORMAT $ T.pack format
-               , PANDOC_READER_OPTIONS ropts
+               , PANDOC_READER_OPTIONS (envReaderOptions fenv)
+               , PANDOC_WRITER_OPTIONS (envWriterOptions fenv)
                , PANDOC_SCRIPT_FILE fp
                ]
     runFilterFile fp doc
diff --git a/src/Text/Pandoc/Lua/Global.hs b/src/Text/Pandoc/Lua/Global.hs
index cf82890c6..951204d6b 100644
--- a/src/Text/Pandoc/Lua/Global.hs
+++ b/src/Text/Pandoc/Lua/Global.hs
@@ -23,8 +23,9 @@ import Text.Pandoc.Error (PandocError)
 import Text.Pandoc.Lua.Marshal.CommonState (pushCommonState)
 import Text.Pandoc.Lua.Marshal.Pandoc (pushPandoc)
 import Text.Pandoc.Lua.Marshal.ReaderOptions (pushReaderOptionsReadonly)
+import Text.Pandoc.Lua.Marshal.WriterOptions (pushWriterOptions)
 import Text.Pandoc.Lua.Orphans ()
-import Text.Pandoc.Options (ReaderOptions)
+import Text.Pandoc.Options (ReaderOptions, WriterOptions)
 
 import qualified Data.Text as Text
 
@@ -34,6 +35,7 @@ data Global =
   | PANDOC_API_VERSION
   | PANDOC_DOCUMENT Pandoc
   | PANDOC_READER_OPTIONS ReaderOptions
+  | PANDOC_WRITER_OPTIONS WriterOptions
   | PANDOC_SCRIPT_FILE FilePath
   | PANDOC_STATE CommonState
   | PANDOC_VERSION
@@ -47,7 +49,7 @@ setGlobal :: Global -> LuaE PandocError ()
 setGlobal global = case global of
   -- This could be simplified if Global was an instance of Data.
   FORMAT format -> do
-    Lua.push format
+    Lua.pushText format
     Lua.setglobal "FORMAT"
   PANDOC_API_VERSION -> do
     pushVersion pandocTypesVersion
@@ -58,8 +60,11 @@ setGlobal global = case global of
   PANDOC_READER_OPTIONS ropts -> do
     pushReaderOptionsReadonly ropts
     Lua.setglobal "PANDOC_READER_OPTIONS"
+  PANDOC_WRITER_OPTIONS wopts -> do
+    pushWriterOptions wopts
+    Lua.setglobal "PANDOC_WRITER_OPTIONS"
   PANDOC_SCRIPT_FILE filePath -> do
-    Lua.push filePath
+    Lua.pushString filePath
     Lua.setglobal "PANDOC_SCRIPT_FILE"
   PANDOC_STATE commonState -> do
     pushCommonState commonState
diff --git a/src/Text/Pandoc/Lua/Marshal/WriterOptions.hs b/src/Text/Pandoc/Lua/Marshal/WriterOptions.hs
new file mode 100644
index 000000000..781ae3f7c
--- /dev/null
+++ b/src/Text/Pandoc/Lua/Marshal/WriterOptions.hs
@@ -0,0 +1,255 @@
+{-# LANGUAGE LambdaCase           #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{- |
+   Module      : Text.Pandoc.Lua.Marshaling.WriterOptions
+   Copyright   : © 2021-2022 Albert Krewinkel, John MacFarlane
+   License     : GNU GPL, version 2 or above
+
+   Maintainer  : Albert Krewinkel <[email protected]>
+   Stability   : alpha
+
+Marshaling instance for WriterOptions and its components.
+-}
+module Text.Pandoc.Lua.Marshal.WriterOptions
+  ( peekWriterOptions
+  , pushWriterOptions
+  ) where
+
+import Control.Applicative (optional)
+import Data.Aeson as Aeson
+import Data.Default (def)
+import HsLua as Lua
+import HsLua.Aeson (peekValue, pushValue)
+import Text.Pandoc.Lua.Marshal.List (pushPandocList)
+import Text.Pandoc.Options (WriterOptions (..))
+import Text.Pandoc.UTF8 (fromString)
+
+--
+-- Writer Options
+--
+
+-- | Retrieve a WriterOptions value, either from a normal WriterOptions
+-- value, from a read-only object, or from a table with the same
+-- keys as a WriterOptions object.
+peekWriterOptions :: LuaError e => Peeker e WriterOptions
+peekWriterOptions = retrieving "WriterOptions" . \idx ->
+  liftLua (ltype idx) >>= \case
+    TypeUserdata -> peekUD typeWriterOptions idx
+    TypeTable    -> peekWriterOptionsTable idx
+    _            -> failPeek =<<
+                    typeMismatchMessage "WriterOptions userdata or table" idx
+
+-- | Pushes a WriterOptions value as userdata object.
+pushWriterOptions :: LuaError e => Pusher e WriterOptions
+pushWriterOptions = pushUD typeWriterOptions
+
+-- | 'WriterOptions' object type.
+typeWriterOptions :: LuaError e => DocumentedType e WriterOptions
+typeWriterOptions = deftype "WriterOptions"
+  [ operation Tostring $ lambda
+    ### liftPure show
+    <#> udparam typeWriterOptions "opts" "options to print in native format"
+    =#> functionResult pushString "string" "Haskell representation"
+  ]
+  [ property "cite_method"
+    "How to print cites"
+    (pushViaJSON, writerCiteMethod)
+    (peekViaJSON, \opts x -> opts{ writerCiteMethod = x })
+
+  , property "columns"
+    "Characters in a line (for text wrapping)"
+    (pushIntegral, writerColumns)
+    (peekIntegral, \opts x -> opts{ writerColumns = x })
+
+  , property "dpi"
+    "DPI for pixel to/from inch/cm conversions"
+    (pushIntegral, writerDpi)
+    (peekIntegral, \opts x -> opts{ writerDpi = x })
+
+  , property "email_obfuscation"
+    "How to obfuscate emails"
+    (pushViaJSON, writerEmailObfuscation)
+    (peekViaJSON, \opts x -> opts{ writerEmailObfuscation = x })
+
+  , property "epub_chapter_level"
+    "Header level for chapters (separate files)"
+    (pushIntegral, writerEpubChapterLevel)
+    (peekIntegral, \opts x -> opts{ writerEpubChapterLevel = x })
+
+  , property "epub_fonts"
+    "Paths to fonts to embed"
+    (pushPandocList pushString, writerEpubFonts)
+    (peekList peekString, \opts x -> opts{ writerEpubFonts = x })
+
+  , property "epub_metadata"
+    "Metadata to include in EPUB"
+    (maybe pushnil pushText, writerEpubMetadata)
+    (optional . peekText, \opts x -> opts{ writerEpubMetadata = x })
+
+  , property "epub_subdirectory"
+    "Subdir for epub in OCF"
+    (pushText, writerEpubSubdirectory)
+    (peekText, \opts x -> opts{ writerEpubSubdirectory = x })
+
+  , property "extensions" "Markdown extensions that can be used"
+    (pushViaJSON, writerExtensions)
+    (peekViaJSON, \opts x -> opts{ writerExtensions = x })
+
+  , property "highlight_style"
+    "Style to use for highlighting (nil = no highlighting)"
+    (maybe pushnil pushViaJSON, writerHighlightStyle)
+    (optional . peekViaJSON, \opts x -> opts{ writerHighlightStyle = x })
+
+  , property "html_math_method"
+    "How to print math in HTML"
+    (pushViaJSON, writerHTMLMathMethod)
+    (peekViaJSON, \opts x -> opts{ writerHTMLMathMethod = x })
+
+  , property "html_q_tags"
+    "Use @<q>@ tags for quotes in HTML"
+    (pushBool, writerHtmlQTags)
+    (peekBool, \opts x -> opts{ writerHtmlQTags = x })
+
+  , property "identifier_prefix"
+    "Prefix for section & note ids in HTML and for footnote marks in markdown"
+    (pushText, writerIdentifierPrefix)
+    (peekText, \opts x -> opts{ writerIdentifierPrefix = x })
+
+  , property "incremental"
+    "True if lists should be incremental"
+    (pushBool, writerIncremental)
+    (peekBool, \opts x -> opts{ writerIncremental = x })
+
+  , property "listings"
+    "Use listings package for code"
+    (pushBool, writerListings)
+    (peekBool, \opts x -> opts{ writerListings = x })
+
+  , property "number_offset"
+    "Starting number for section, subsection, ..."
+    (pushPandocList pushIntegral, writerNumberOffset)
+    (peekList peekIntegral, \opts x -> opts{ writerNumberOffset = x })
+
+  , property "number_sections"
+    "Number sections in LaTeX"
+    (pushBool, writerNumberSections)
+    (peekBool, \opts x -> opts{ writerNumberSections = x })
+
+  , property "prefer_ascii"
+    "Prefer ASCII representations of characters when possible"
+    (pushBool, writerPreferAscii)
+    (peekBool, \opts x -> opts{ writerPreferAscii = x })
+
+  , property "reference_doc"
+    "Path to reference document if specified"
+    (maybe pushnil pushString, writerReferenceDoc)
+    (optional . peekString, \opts x -> opts{ writerReferenceDoc = x })
+
+  , property "reference_location"
+    "Location of footnotes and references for writing markdown"
+    (pushViaJSON, writerReferenceLocation)
+    (peekViaJSON, \opts x -> opts{ writerReferenceLocation = x })
+
+  , property "reference_links"
+    "Use reference links in writing markdown, rst"
+    (pushBool, writerReferenceLinks)
+    (peekBool, \opts x -> opts{ writerReferenceLinks = x })
+
+  , property "section_divs"
+    "Put sections in div tags in HTML"
+    (pushBool, writerSectionDivs)
+    (peekBool, \opts x -> opts{ writerSectionDivs = x })
+
+  , property "setext_headers"
+    "Use setext headers for levels 1-2 in markdown"
+    (pushBool, writerSetextHeaders)
+    (peekBool, \opts x -> opts{ writerSetextHeaders = x })
+
+  , property "slide_level"
+    "Force header level of slides"
+    (maybe pushnil pushIntegral, writerSlideLevel)
+    (optional . peekIntegral, \opts x -> opts{ writerSlideLevel = x })
+
+  -- , property "syntax_map" "Syntax highlighting definition"
+  --   (pushViaJSON, writerSyntaxMap)
+  --   (peekViaJSON, \opts x -> opts{ writerSyntaxMap = x })
+    -- :: SyntaxMap
+
+  , property "tab_stop"
+    "Tabstop for conversion btw spaces and tabs"
+    (pushIntegral, writerTabStop)
+    (peekIntegral, \opts x -> opts{ writerTabStop = x })
+
+  , property "table_of_contents"
+    "Include table of contents"
+    (pushBool, writerTableOfContents)
+    (peekBool, \opts x -> opts{ writerTableOfContents = x })
+
+  -- , property "template" "Template to use"
+  --   (maybe pushnil pushViaJSON, writerTemplate)
+  --   (optional . peekViaJSON, \opts x -> opts{ writerTemplate = x })
+    -- :: Maybe (Template Text)
+
+  , property "toc_depth"
+    "Number of levels to include in TOC"
+    (pushIntegral, writerTOCDepth)
+    (peekIntegral, \opts x -> opts{ writerTOCDepth = x })
+
+  , property "top_level_division"
+    "Type of top-level divisions"
+    (pushViaJSON, writerTopLevelDivision)
+    (peekViaJSON, \opts x -> opts{ writerTopLevelDivision = x })
+
+  , property "variables"
+    "Variables to set in template"
+    (pushViaJSON, writerVariables)
+    (peekViaJSON, \opts x -> opts{ writerVariables = x })
+
+  , property "wrap_text"
+    "Option for wrapping text"
+    (pushViaJSON, writerWrapText)
+    (peekViaJSON, \opts x -> opts{ writerWrapText = x })
+  ]
+
+-- | Retrieves a 'WriterOptions' object from a table on the stack, using
+-- the default values for all missing fields.
+--
+-- Internally, this pushes the default writer options, sets each
+-- key/value pair of the table in the userdata value, then retrieves the
+-- object again. This will update all fields and complain about unknown
+-- keys.
+peekWriterOptionsTable :: LuaError e => Peeker e WriterOptions
+peekWriterOptionsTable idx = retrieving "WriterOptions (table)" $ do
+  liftLua $ do
+    absidx <- absindex idx
+    pushUD typeWriterOptions def
+    let setFields = do
+          next absidx >>= \case
+            False -> return () -- all fields were copied
+            True -> do
+              pushvalue (nth 2) *> insert (nth 2)
+              settable (nth 4) -- set in userdata object
+              setFields
+    pushnil -- first key
+    setFields
+  peekUD typeWriterOptions top `lastly` pop 1
+
+instance Pushable WriterOptions where
+  push = pushWriterOptions
+
+-- These will become part of hslua-aeson in future versions.
+
+-- | Retrieves a value from the Lua stack via JSON.
+peekViaJSON :: (Aeson.FromJSON a, LuaError e) => Peeker e a
+peekViaJSON idx = do
+  value <- peekValue idx
+  case fromJSON value of
+    Aeson.Success x -> pure x
+    Aeson.Error msg -> failPeek $ "failed to decode: " <>
+                       fromString msg
+
+-- | Pushes a value to the Lua stack as a JSON-like value.
+pushViaJSON :: (Aeson.ToJSON a, LuaError e) => Pusher e a
+pushViaJSON = pushValue . toJSON