From 6b462e59332242c18ea38a721ae672b88f33d621 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Sat, 6 Nov 2021 11:00:26 +0100
Subject: 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
---
src/Text/Pandoc/Lua/Global.hs | 4 +-
src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs | 129 +++++++++++++++++-------
src/Text/Pandoc/Lua/Module/Pandoc.hs | 16 ++-
3 files changed, 110 insertions(+), 39 deletions(-)
(limited to 'src/Text/Pandoc/Lua')
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
--
cgit v1.2.3