Lua: allow to pass custom reader options to `pandoc.read`

Reader options can now be passed as an optional third argument to
`pandoc.read`. The object can either be a table or a ReaderOptions value
like `PANDOC_READER_OPTIONS`. Creating new ReaderOptions objects is
possible through the new constructor `pandoc.ReaderOptions`.

Closes: #7656

3 files changed, 110 insertions, 39 deletions

diff --git a/src/Text/Pandoc/Lua/Global.hs b/src/Text/Pandoc/Lua/Global.hs
index 23b3a8284..05510f45d 100644
--- a/src/Text/Pandoc/Lua/Global.hs
+++ b/src/Text/Pandoc/Lua/Global.hs
@@ -22,7 +22,7 @@ import Text.Pandoc.Definition (Pandoc (Pandoc), pandocTypesVersion)
 import Text.Pandoc.Error (PandocError)
 import Text.Pandoc.Lua.Marshaling ()
 import Text.Pandoc.Lua.Marshaling.CommonState (pushCommonState)
-import Text.Pandoc.Lua.Marshaling.ReaderOptions (pushReaderOptions)
+import Text.Pandoc.Lua.Marshaling.ReaderOptions (pushReaderOptionsReadonly)
 import Text.Pandoc.Options (ReaderOptions)
 
 import qualified Data.Text as Text
@@ -55,7 +55,7 @@ setGlobal global = case global of
     pushUD typePandocLazy  doc
     Lua.setglobal "PANDOC_DOCUMENT"
   PANDOC_READER_OPTIONS ropts -> do
-    pushReaderOptions ropts
+    pushReaderOptionsReadonly ropts
     Lua.setglobal "PANDOC_READER_OPTIONS"
   PANDOC_SCRIPT_FILE filePath -> do
     Lua.push filePath
diff --git a/src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs b/src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs
index 2cc39ee3a..b19c209e8 100644
--- a/src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs
+++ b/src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase           #-}
 {-# LANGUAGE OverloadedStrings    #-}
 {-# LANGUAGE ScopedTypeVariables  #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -15,8 +16,10 @@ Marshaling instance for ReaderOptions and its components.
 module Text.Pandoc.Lua.Marshaling.ReaderOptions
   ( peekReaderOptions
   , pushReaderOptions
+  , pushReaderOptionsReadonly
   ) where
 
+import Data.Default (def)
 import HsLua as Lua
 import Text.Pandoc.Lua.Marshaling.List (pushPandocList)
 import Text.Pandoc.Options (ReaderOptions (..))
@@ -25,47 +28,103 @@ import Text.Pandoc.Options (ReaderOptions (..))
 -- Reader Options
 --
 
+-- | Retrieve a ReaderOptions value, either from a normal ReaderOptions
+-- value, from a read-only object, or from a table with the same
+-- keys as a ReaderOptions object.
 peekReaderOptions :: LuaError e => Peeker e ReaderOptions
-peekReaderOptions = peekUD typeReaderOptions
+peekReaderOptions = retrieving "ReaderOptions" . \idx ->
+  liftLua (ltype idx) >>= \case
+    TypeUserdata -> choice [ peekUD typeReaderOptions
+                           , peekUD typeReaderOptionsReadonly
+                           ]
+                           idx
+    TypeTable    -> peekReaderOptionsTable idx
+    _            -> failPeek =<<
+                    typeMismatchMessage "ReaderOptions userdata or table" idx
 
+-- | Pushes a ReaderOptions value as userdata object.
 pushReaderOptions :: LuaError e => Pusher e ReaderOptions
 pushReaderOptions = pushUD typeReaderOptions
 
+-- | Pushes a ReaderOptions object, but makes it read-only.
+pushReaderOptionsReadonly :: LuaError e => Pusher e ReaderOptions
+pushReaderOptionsReadonly = pushUD typeReaderOptionsReadonly
+
+-- | ReaderOptions object type for read-only values.
+typeReaderOptionsReadonly :: LuaError e => DocumentedType e ReaderOptions
+typeReaderOptionsReadonly = deftype "ReaderOptions (read-only)"
+  [ operation Tostring $ lambda
+    ### liftPure show
+    <#> udparam typeReaderOptions "opts" "options to print in native format"
+    =#> functionResult pushString "string" "Haskell representation"
+  , operation Newindex $ lambda
+    ### (failLua "This ReaderOptions value is read-only.")
+    =?> "Throws an error when called, i.e., an assignment is made."
+  ]
+  readerOptionsMembers
+
+-- | 'ReaderOptions' object type.
 typeReaderOptions :: LuaError e => DocumentedType e ReaderOptions
-typeReaderOptions = deftype "pandoc ReaderOptions"
-  [ operation Tostring luaShow
+typeReaderOptions = deftype "ReaderOptions"
+  [ operation Tostring $ lambda
+    ### liftPure show
+    <#> udparam typeReaderOptions "opts" "options to print in native format"
+    =#> functionResult pushString "string" "Haskell representation"
   ]
-  [ readonly "extensions" ""
-      ( pushString . show
-      , readerExtensions)
-  , readonly "standalone" ""
-      ( pushBool
-      , readerStandalone)
-  , readonly "columns" ""
-      ( pushIntegral
-      , readerColumns)
-  , readonly "tab_stop" ""
-      ( pushIntegral
-      , readerTabStop)
-  , readonly "indented_code_classes" ""
-      ( pushPandocList pushText
-      , readerIndentedCodeClasses)
-  , readonly "abbreviations" ""
-      ( pushSet pushText
-      , readerAbbreviations)
-  , readonly "track_changes" ""
-      ( pushString . show
-      , readerTrackChanges)
-  , readonly "strip_comments" ""
-      ( pushBool
-      , readerStripComments)
-  , readonly "default_image_extension" ""
-      ( pushText
-      , readerDefaultImageExtension)
+  readerOptionsMembers
+
+-- | Member properties of 'ReaderOptions' Lua values.
+readerOptionsMembers :: LuaError e
+                     => [Member e (DocumentedFunction e) ReaderOptions]
+readerOptionsMembers =
+  [ property "abbreviations" ""
+      (pushSet pushText, readerAbbreviations)
+      (peekSet peekText, \opts x -> opts{ readerAbbreviations = x })
+  , property "columns" ""
+      (pushIntegral, readerColumns)
+      (peekIntegral, \opts x -> opts{ readerColumns = x })
+  , property "default_image_extension" ""
+      (pushText, readerDefaultImageExtension)
+      (peekText, \opts x -> opts{ readerDefaultImageExtension = x })
+  , property "extensions" ""
+      (pushString . show, readerExtensions)
+      (peekRead, \opts x -> opts{ readerExtensions = x })
+  , property "indented_code_classes" ""
+      (pushPandocList pushText, readerIndentedCodeClasses)
+      (peekList peekText, \opts x -> opts{ readerIndentedCodeClasses = x })
+  , property "strip_comments" ""
+      (pushBool, readerStripComments)
+      (peekBool, \opts x -> opts{ readerStripComments = x })
+  , property "standalone" ""
+      (pushBool, readerStandalone)
+      (peekBool, \opts x -> opts{ readerStandalone = x })
+  , property "tab_stop" ""
+      (pushIntegral, readerTabStop)
+      (peekIntegral, \opts x -> opts{ readerTabStop = x })
+  , property "track_changes" ""
+      (pushString . show, readerTrackChanges)
+      (peekRead, \opts x -> opts{ readerTrackChanges = x })
   ]
 
-luaShow :: LuaError e => DocumentedFunction e
-luaShow = defun "__tostring"
-  ### liftPure show
-  <#> udparam typeReaderOptions "state" "object to print in native format"
-  =#> functionResult pushString "string" "Haskell representation"
+-- | Retrieves a 'ReaderOptions' object from a table on the stack, using
+-- the default values for all missing fields.
+--
+-- Internally, this push the defaults reader 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.
+peekReaderOptionsTable :: LuaError e => Peeker e ReaderOptions
+peekReaderOptionsTable idx = retrieving "ReaderOptions (table)" $ do
+  liftLua $ do
+    absidx <- absindex idx
+    pushUD typeReaderOptions 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 typeReaderOptions top
diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs
index 33432b4d8..8f42a2988 100644
--- a/src/Text/Pandoc/Lua/Module/Pandoc.hs
+++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs
@@ -42,6 +42,8 @@ import Text.Pandoc.Lua.Marshaling.Attr (mkAttr, mkAttributeList)
 import Text.Pandoc.Lua.Marshaling.List (List (..))
 import Text.Pandoc.Lua.Marshaling.ListAttributes ( mkListAttributes
                                                  , peekListAttributes)
+import Text.Pandoc.Lua.Marshaling.ReaderOptions ( peekReaderOptions
+                                                , pushReaderOptions)
 import Text.Pandoc.Lua.Marshaling.SimpleTable (mkSimpleTable)
 import Text.Pandoc.Lua.Module.Utils (sha1)
 import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua,
@@ -355,6 +357,12 @@ otherConstructors =
   , mkAttributeList
   , mkListAttributes
   , mkSimpleTable
+
+  , defun "ReaderOptions"
+    ### liftPure id
+    <#> parameter peekReaderOptions "ReaderOptions|table" "opts" "reader options"
+    =#> functionResult pushReaderOptions "ReaderOptions" "new object"
+    #? "Creates a new ReaderOptions value."
   ]
 
 stringConstants :: [Field e]
@@ -405,10 +413,12 @@ functions =
     =?> "output string, or error triple"
 
   , defun "read"
-    ### (\content mformatspec -> do
+    ### (\content mformatspec mreaderOptions -> do
             let formatSpec = fromMaybe "markdown" mformatspec
+                readerOptions = fromMaybe def mreaderOptions
             res <- Lua.liftIO . runIO $ getReader formatSpec >>= \case
-              (TextReader r, es) -> r def{ readerExtensions = es } content
+              (TextReader r, es) -> r readerOptions{ readerExtensions = es }
+                                      content
               _ -> throwError $ PandocSomeError
                    "Only textual formats are supported"
             case res of
@@ -422,6 +432,8 @@ functions =
                 throwM e)
     <#> parameter peekText "string" "content" "text to parse"
     <#> optionalParameter peekText "string" "formatspec" "format and extensions"
+    <#> optionalParameter peekReaderOptions "ReaderOptions" "reader_options"
+          "reader options"
     =#> functionResult pushPandoc "Pandoc" "result document"
 
   , sha1