From 6b462e59332242c18ea38a721ae672b88f33d621 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel 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') 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