From 3692a1d1e83703fbf235214f2838cd92683c625c Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Sun, 28 Nov 2021 02:08:01 +0100
Subject: Lua: use package pandoc-lua-marshal (#7719)

The marshaling functions for pandoc's AST are extracted into a separate
package. The package comes with a number of changes:

  - Pandoc's List module was rewritten in C, thereby improving error
    messages.

  - Lists of `Block` and `Inline` elements are marshaled using the new
    list types `Blocks` and `Inlines`, respectively. These types
    currently behave identical to the generic List type, but give better
    error messages. This also opens up the possibility of adding
    element-specific methods to these lists in the future.

  - Elements of type `MetaValue` are no longer pushed as values which
    have `.t` and `.tag` properties. This was already true for
    `MetaString` and `MetaBool` values, which are still marshaled as Lua
    strings and booleans, respectively. Affected values:

      + `MetaBlocks` values are marshaled as a `Blocks` list;

      + `MetaInlines` values are marshaled as a `Inlines` list;

      + `MetaList` values are marshaled as a generic pandoc `List`s.

      + `MetaMap` values are marshaled as plain tables and no longer
        given any metatable.

  - The test suite for marshaled objects and their constructors has
    been extended and improved.

  - A bug in Citation objects, where setting a citation's suffix
    modified it's prefix, has been fixed.
---
 src/Text/Pandoc/Lua/Module/MediaBag.hs |   4 +-
 src/Text/Pandoc/Lua/Module/Pandoc.hs   | 261 ++-------------------------------
 src/Text/Pandoc/Lua/Module/Types.hs    |  30 +---
 src/Text/Pandoc/Lua/Module/Utils.hs    |   9 +-
 4 files changed, 18 insertions(+), 286 deletions(-)

(limited to 'src/Text/Pandoc/Lua/Module')

diff --git a/src/Text/Pandoc/Lua/Module/MediaBag.hs b/src/Text/Pandoc/Lua/Module/MediaBag.hs
index 6e595f9e4..fb055101e 100644
--- a/src/Text/Pandoc/Lua/Module/MediaBag.hs
+++ b/src/Text/Pandoc/Lua/Module/MediaBag.hs
@@ -21,8 +21,8 @@ import Text.Pandoc.Class.CommonState (CommonState (..))
 import Text.Pandoc.Class.PandocMonad (fetchItem, getMediaBag, modifyCommonState,
                                       setMediaBag)
 import Text.Pandoc.Error (PandocError)
-import Text.Pandoc.Lua.Marshaling ()
-import Text.Pandoc.Lua.Marshaling.List (pushPandocList)
+import Text.Pandoc.Lua.Marshal.List (pushPandocList)
+import Text.Pandoc.Lua.Orphans ()
 import Text.Pandoc.Lua.PandocLua (unPandocLua)
 import Text.Pandoc.MIME (MimeType)
 
diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs
index a8b111092..085d904cf 100644
--- a/src/Text/Pandoc/Lua/Module/Pandoc.hs
+++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs
@@ -19,35 +19,28 @@ module Text.Pandoc.Lua.Module.Pandoc
   ) where
 
 import Prelude hiding (read)
-import Control.Applicative ((<|>))
-import Control.Monad ((<$!>), forM_, when)
+import Control.Monad (forM_, when)
 import Control.Monad.Catch (catch, throwM)
 import Control.Monad.Except (throwError)
 import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr)
 import Data.Default (Default (..))
 import Data.Maybe (fromMaybe)
 import Data.Proxy (Proxy (Proxy))
-import Data.Text (Text)
-import HsLua hiding (Div, pushModule)
+import HsLua hiding (pushModule)
 import HsLua.Class.Peekable (PeekError)
 import System.Exit (ExitCode (..))
 import Text.Pandoc.Class.PandocIO (runIO)
 import Text.Pandoc.Definition
-import Text.Pandoc.Lua.Filter (SingletonsList (..), LuaFilter, peekLuaFilter,
+import Text.Pandoc.Lua.Filter (List (..), SingletonsList (..), LuaFilter,
+                               peekLuaFilter,
                                walkInlines, walkInlineLists,
                                walkBlocks, walkBlockLists)
-import Text.Pandoc.Lua.Marshaling ()
-import Text.Pandoc.Lua.Marshaling.AST
-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
+import Text.Pandoc.Lua.Orphans ()
+import Text.Pandoc.Lua.Marshal.AST
+import Text.Pandoc.Lua.Marshal.ReaderOptions ( peekReaderOptions
                                                 , pushReaderOptions)
-import Text.Pandoc.Lua.Marshaling.SimpleTable (mkSimpleTable)
 import Text.Pandoc.Lua.Module.Utils (sha1)
-import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua,
-                                  loadDefaultModule)
+import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua)
 import Text.Pandoc.Options (ReaderOptions (readerExtensions))
 import Text.Pandoc.Process (pipeProcess)
 import Text.Pandoc.Readers (Reader (..), getReader)
@@ -65,21 +58,6 @@ import Text.Pandoc.Error
 pushModule :: PandocLua NumResults
 pushModule = do
   liftPandocLua $ Lua.pushModule documentedModule
-  loadDefaultModule "pandoc"
-  let copyNext = do
-        hasNext <- next (nth 2)
-        if not hasNext
-          then return ()
-          else do
-            pushvalue (nth 2)
-            insert (nth 2)
-            rawset (nth 5) -- pandoc module
-            copyNext
-  liftPandocLua $ do
-    pushnil  -- initial key
-    copyNext
-    pop 1
-
   return 1
 
 documentedModule :: Module PandocError
@@ -97,6 +75,7 @@ documentedModule = Module
       , otherConstructors
       , blockConstructors
       , inlineConstructors
+      , metaValueConstructors
       ]
   }
 
@@ -132,229 +111,13 @@ pushWithConstructorsSubtable constructors = do
     rawset (nth 3)
   pop 1 -- pop constructor table
 
-inlineConstructors :: LuaError e =>  [DocumentedFunction e]
-inlineConstructors =
-  [ defun "Cite"
-    ### liftPure2 (flip Cite)
-    <#> parameter peekInlinesFuzzy "content" "Inline" "placeholder content"
-    <#> parameter (peekList peekCitation) "citations" "list of Citations" ""
-    =#> functionResult pushInline "Inline" "cite element"
-  , defun "Code"
-    ### liftPure2 (\text mattr -> Code (fromMaybe nullAttr mattr) text)
-    <#> parameter peekText "code" "string" "code string"
-    <#> optionalParameter peekAttr "attr" "Attr" "additional attributes"
-    =#> functionResult pushInline "Inline" "code element"
-  , mkInlinesConstr "Emph" Emph
-  , defun "Image"
-    ### liftPure4 (\caption src mtitle mattr ->
-                     let attr = fromMaybe nullAttr mattr
-                         title = fromMaybe mempty mtitle
-                     in Image attr caption (src, title))
-    <#> parameter peekInlinesFuzzy "Inlines" "caption" "image caption / alt"
-    <#> parameter peekText "string" "src" "path/URL of the image file"
-    <#> optionalParameter peekText "string" "title" "brief image description"
-    <#> optionalParameter peekAttr "Attr" "attr" "image attributes"
-    =#> functionResult pushInline "Inline" "image element"
-  , defun "LineBreak"
-    ### return LineBreak
-    =#> functionResult pushInline "Inline" "line break"
-  , defun "Link"
-    ### liftPure4 (\content target mtitle mattr ->
-                     let attr = fromMaybe nullAttr mattr
-                         title = fromMaybe mempty mtitle
-                     in Link attr content (target, title))
-    <#> parameter peekInlinesFuzzy "Inlines" "content" "text for this link"
-    <#> parameter peekText "string" "target" "the link target"
-    <#> optionalParameter peekText "string" "title" "brief link description"
-    <#> optionalParameter peekAttr "Attr" "attr" "link attributes"
-    =#> functionResult pushInline "Inline" "link element"
-  , defun "Math"
-    ### liftPure2 Math
-    <#> parameter peekMathType "quotetype" "Math" "rendering method"
-    <#> parameter peekText "text" "string" "math content"
-    =#> functionResult pushInline "Inline" "math element"
-  , defun "Note"
-    ### liftPure Note
-    <#> parameter peekBlocksFuzzy "content" "Blocks" "note content"
-    =#> functionResult pushInline "Inline" "note"
-  , defun "Quoted"
-    ### liftPure2 Quoted
-    <#> parameter peekQuoteType "quotetype" "QuoteType" "type of quotes"
-    <#> parameter peekInlinesFuzzy "content" "Inlines" "inlines in quotes"
-    =#> functionResult pushInline "Inline" "quoted element"
-  , defun "RawInline"
-    ### liftPure2 RawInline
-    <#> parameter peekFormat "format" "Format" "format of content"
-    <#> parameter peekText "text" "string" "string content"
-    =#> functionResult pushInline "Inline" "raw inline element"
-  , mkInlinesConstr "SmallCaps" SmallCaps
-  , defun "SoftBreak"
-    ### return SoftBreak
-    =#> functionResult pushInline "Inline" "soft break"
-  , defun "Space"
-    ### return Space
-    =#> functionResult pushInline "Inline" "new space"
-  , defun "Span"
-    ### liftPure2 (\inlns mattr -> Span (fromMaybe nullAttr mattr) inlns)
-    <#> parameter peekInlinesFuzzy "content" "Inlines" "inline content"
-    <#> optionalParameter peekAttr "attr" "Attr" "additional attributes"
-    =#> functionResult pushInline "Inline" "span element"
-  , defun "Str"
-    ### liftPure Str
-    <#> parameter peekText "text" "string" ""
-    =#> functionResult pushInline "Inline" "new Str object"
-  , mkInlinesConstr "Strong" Strong
-  , mkInlinesConstr "Strikeout" Strikeout
-  , mkInlinesConstr "Subscript" Subscript
-  , mkInlinesConstr "Superscript" Superscript
-  , mkInlinesConstr "Underline" Underline
-  ]
-
-blockConstructors :: LuaError e => [DocumentedFunction e]
-blockConstructors =
-  [ defun "BlockQuote"
-    ### liftPure BlockQuote
-    <#> blocksParam
-    =#> blockResult "BlockQuote element"
-
-  , defun "BulletList"
-    ### liftPure BulletList
-    <#> blockItemsParam "list items"
-    =#> blockResult "BulletList element"
-
-  , defun "CodeBlock"
-    ### liftPure2 (\code mattr -> CodeBlock (fromMaybe nullAttr mattr) code)
-    <#> textParam "text" "code block content"
-    <#> optAttrParam
-    =#> blockResult "CodeBlock element"
-
-  , defun "DefinitionList"
-    ### liftPure DefinitionList
-    <#> parameter (choice
-                   [ peekList peekDefinitionItem
-                   , \idx -> (:[]) <$!> peekDefinitionItem idx
-                   ])
-                  "{{Inlines, {Blocks,...}},...}"
-                  "content" "definition items"
-    =#> blockResult "DefinitionList element"
-
-  , defun "Div"
-    ### liftPure2 (\content mattr -> Div (fromMaybe nullAttr mattr) content)
-    <#> blocksParam
-    <#> optAttrParam
-    =#> blockResult "Div element"
-
-  , defun "Header"
-    ### liftPure3 (\lvl content mattr ->
-                     Header lvl (fromMaybe nullAttr mattr) content)
-    <#> parameter peekIntegral "integer" "level" "heading level"
-    <#> parameter peekInlinesFuzzy "Inlines" "content" "inline content"
-    <#> optAttrParam
-    =#> blockResult "Header element"
-
-  , defun "HorizontalRule"
-    ### return HorizontalRule
-    =#> blockResult "HorizontalRule element"
-
-  , defun "LineBlock"
-    ### liftPure LineBlock
-    <#> parameter (peekList peekInlinesFuzzy) "{Inlines,...}" "content" "lines"
-    =#> blockResult "LineBlock element"
-
-  , defun "Null"
-    ### return Null
-    =#> blockResult "Null element"
-
-  , defun "OrderedList"
-    ### liftPure2 (\items mListAttrib ->
-                     let defListAttrib = (1, DefaultStyle, DefaultDelim)
-                     in OrderedList (fromMaybe defListAttrib mListAttrib) items)
-    <#> blockItemsParam "ordered list items"
-    <#> optionalParameter peekListAttributes "ListAttributes" "listAttributes"
-                          "specifier for the list's numbering"
-    =#> blockResult "OrderedList element"
-
-  , defun "Para"
-    ### liftPure Para
-    <#> parameter peekInlinesFuzzy "Inlines" "content" "paragraph content"
-    =#> blockResult "Para element"
-
-  , defun "Plain"
-    ### liftPure Plain
-    <#> parameter peekInlinesFuzzy "Inlines" "content" "paragraph content"
-    =#> blockResult "Plain element"
-
-  , defun "RawBlock"
-    ### liftPure2 RawBlock
-    <#> parameter peekFormat "Format" "format" "format of content"
-    <#> parameter peekText "string" "text" "raw content"
-    =#> blockResult "RawBlock element"
-
-  , defun "Table"
-    ### (\capt colspecs thead tbodies tfoot mattr ->
-           let attr = fromMaybe nullAttr mattr
-           in return $! attr `seq` capt `seq` colspecs `seq` thead `seq` tbodies
-              `seq` tfoot `seq` Table attr capt colspecs thead tbodies tfoot)
-    <#> parameter peekCaption "Caption" "caption" "table caption"
-    <#> parameter (peekList peekColSpec) "{ColSpec,...}" "colspecs"
-                  "column alignments and widths"
-    <#> parameter peekTableHead "TableHead" "head" "table head"
-    <#> parameter (peekList peekTableBody) "{TableBody,...}" "bodies"
-                  "table bodies"
-    <#> parameter peekTableFoot "TableFoot" "foot" "table foot"
-    <#> optAttrParam
-    =#> blockResult "Table element"
-  ]
- where
-  blockResult = functionResult pushBlock "Block"
-  blocksParam = parameter peekBlocksFuzzy "Blocks" "content" "block content"
-  blockItemsParam = parameter peekItemsFuzzy "List of Blocks" "content"
-  peekItemsFuzzy idx = peekList peekBlocksFuzzy idx
-    <|> ((:[]) <$!> peekBlocksFuzzy idx)
-
-textParam :: LuaError e => Text -> Text -> Parameter e Text
-textParam = parameter peekText "string"
-
-optAttrParam :: LuaError e => Parameter e (Maybe Attr)
-optAttrParam = optionalParameter peekAttr "attr" "Attr" "additional attributes"
-
-mkInlinesConstr :: LuaError e
-                => Name -> ([Inline] -> Inline) -> DocumentedFunction e
-mkInlinesConstr name constr = defun name
-  ### liftPure (\x -> x `seq` constr x)
-  <#> parameter peekInlinesFuzzy "content" "Inlines" ""
-  =#> functionResult pushInline "Inline" "new object"
-
 otherConstructors :: LuaError e => [DocumentedFunction e]
 otherConstructors =
-  [ defun "Pandoc"
-    ### liftPure2 (\blocks mMeta -> Pandoc (fromMaybe nullMeta mMeta) blocks)
-    <#> parameter peekBlocksFuzzy "Blocks" "blocks" "document contents"
-    <#> optionalParameter peekMeta "Meta" "meta" "document metadata"
-    =#> functionResult pushPandoc "Pandoc" "new Pandoc document"
-
-  , defun "Citation"
-    ### (\cid mode mprefix msuffix mnote_num mhash ->
-          cid `seq` mode `seq` mprefix `seq` msuffix `seq`
-          mnote_num `seq` mhash `seq` return $! Citation
-            { citationId = cid
-            , citationMode = mode
-            , citationPrefix = fromMaybe mempty mprefix
-            , citationSuffix = fromMaybe mempty msuffix
-            , citationNoteNum = fromMaybe 0 mnote_num
-            , citationHash = fromMaybe 0 mhash
-            })
-    <#> parameter peekText "string" "cid" "citation ID (e.g. bibtex key)"
-    <#> parameter peekRead "citation mode" "mode" "citation rendering mode"
-    <#> optionalParameter peekInlinesFuzzy "prefix" "Inlines" ""
-    <#> optionalParameter peekInlinesFuzzy "suffix" "Inlines" ""
-    <#> optionalParameter peekIntegral "note_num" "integer" "note number"
-    <#> optionalParameter peekIntegral "hash" "integer" "hash number"
-    =#> functionResult pushCitation "Citation" "new citation object"
-    #? "Creates a single citation."
-
+  [ mkPandoc
+  , mkMeta
   , mkAttr
   , mkAttributeList
+  , mkCitation
   , mkListAttributes
   , mkSimpleTable
 
diff --git a/src/Text/Pandoc/Lua/Module/Types.hs b/src/Text/Pandoc/Lua/Module/Types.hs
index 4b37dafd9..f16737f63 100644
--- a/src/Text/Pandoc/Lua/Module/Types.hs
+++ b/src/Text/Pandoc/Lua/Module/Types.hs
@@ -13,14 +13,11 @@ module Text.Pandoc.Lua.Module.Types
   ( documentedModule
   ) where
 
-import HsLua ( LuaE, NumResults, Peeker, Pusher, Module (..), Field (..)
-             , defun, functionResult, parameter, (###), (<#>), (=#>))
+import HsLua ( Module (..), (###), (<#>), (=#>)
+             , defun, functionResult, parameter)
 import HsLua.Module.Version (peekVersionFuzzy, pushVersion)
 import Text.Pandoc.Error (PandocError)
 import Text.Pandoc.Lua.ErrorConversion ()
-import Text.Pandoc.Lua.Marshaling.AST
-
-import qualified HsLua as Lua
 
 -- | Push the pandoc.types module on the Lua stack.
 documentedModule :: Module PandocError
@@ -28,16 +25,7 @@ documentedModule = Module
   { moduleName = "pandoc.types"
   , moduleDescription =
       "Constructors for types that are not part of the pandoc AST."
-  , moduleFields =
-    [ Field
-      { fieldName = "clone"
-      , fieldDescription = "DEPRECATED! Helper functions for element cloning."
-      , fieldPushValue = do
-          Lua.newtable
-          addFunction "Meta" $ cloneWith peekMeta pushMeta
-          addFunction "MetaValue" $ cloneWith peekMetaValue pushMetaValue
-      }
-    ]
+  , moduleFields = []
   , moduleFunctions =
       [ defun "Version"
         ### return
@@ -52,15 +40,3 @@ documentedModule = Module
       ]
   , moduleOperations = []
   }
- where addFunction name fn = do
-         Lua.pushName name
-         Lua.pushHaskellFunction fn
-         Lua.rawset (Lua.nth 3)
-
-cloneWith :: Peeker PandocError a
-          -> Pusher PandocError a
-          -> LuaE PandocError NumResults
-cloneWith peeker pusher = do
-  x <- Lua.forcePeek $ peeker (Lua.nthBottom 1)
-  pusher x
-  return (Lua.NumResults 1)
diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs
index 6fd707bf8..917f2e627 100644
--- a/src/Text/Pandoc/Lua/Module/Utils.hs
+++ b/src/Text/Pandoc/Lua/Module/Utils.hs
@@ -27,14 +27,7 @@ import HsLua.Class.Peekable (PeekError)
 import HsLua.Module.Version (peekVersionFuzzy, pushVersion)
 import Text.Pandoc.Definition
 import Text.Pandoc.Error (PandocError)
-import Text.Pandoc.Lua.Marshaling ()
-import Text.Pandoc.Lua.Marshaling.AST
-  ( peekBlock, peekInline, peekPandoc, pushBlock, pushInline, pushInlines
-  ,  pushPandoc, peekAttr, peekMeta, peekMetaValue)
-import Text.Pandoc.Lua.Marshaling.ListAttributes (peekListAttributes)
-import Text.Pandoc.Lua.Marshaling.List (pushPandocList)
-import Text.Pandoc.Lua.Marshaling.SimpleTable
-  ( SimpleTable (..), peekSimpleTable, pushSimpleTable )
+import Text.Pandoc.Lua.Marshal.AST
 import Text.Pandoc.Lua.PandocLua (PandocLua (unPandocLua))
 
 import qualified Data.Digest.Pure.SHA as SHA
-- 
cgit v1.2.3