Lua: marshal SimpleTable values as userdata objects

3 files changed, 58 insertions, 46 deletions

diff --git a/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs b/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs
index e9c169dc0..65f5aec8b 100644
--- a/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs
+++ b/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs
@@ -1,13 +1,10 @@
 {-# LANGUAGE OverloadedStrings    #-}
 {-# LANGUAGE ScopedTypeVariables  #-}
-{-# LANGUAGE TypeApplications     #-}
 {- |
    Module      : Text.Pandoc.Lua.Marshaling.SimpleTable
    Copyright   : © 2020-2021 Albert Krewinkel
    License     : GNU GPL, version 2 or above
-
    Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
-   Stability   : alpha
 
 Definition and marshaling of the 'SimpleTable' data type used as a
 convenience type when dealing with tables.
@@ -16,14 +13,14 @@ module Text.Pandoc.Lua.Marshaling.SimpleTable
   ( SimpleTable (..)
   , peekSimpleTable
   , pushSimpleTable
+  , mkSimpleTable
   )
   where
 
-import Control.Monad ((<$!>))
 import HsLua as Lua
 import Text.Pandoc.Definition
-import Text.Pandoc.Lua.Util (pushViaConstructor)
 import Text.Pandoc.Lua.Marshaling.AST
+import Text.Pandoc.Lua.Marshaling.List
 
 -- | A simple (legacy-style) table.
 data SimpleTable = SimpleTable
@@ -32,23 +29,64 @@ data SimpleTable = SimpleTable
   , simpleTableColumnWidths :: [Double]
   , simpleTableHeader :: [[Block]]
   , simpleTableBody :: [[[Block]]]
-  }
+  } deriving (Eq, Show)
+
+typeSimpleTable :: LuaError e => DocumentedType e SimpleTable
+typeSimpleTable = deftype "SimpleTable"
+  [ operation Eq $ lambda
+    ### liftPure2 (==)
+    <#> udparam typeSimpleTable "a" ""
+    <#> udparam typeSimpleTable "b" ""
+    =#> functionResult pushBool "boolean" "whether the two objects are equal"
+  , operation Tostring $ lambda
+    ### liftPure show
+    <#> udparam typeSimpleTable "self" ""
+    =#> functionResult pushString "string" "Haskell string representation"
+  ]
+  [ property "caption" "table caption"
+      (pushPandocList pushInline, simpleTableCaption)
+      (peekInlinesFuzzy, \t capt -> t {simpleTableCaption = capt})
+  , property "aligns" "column alignments"
+      (pushPandocList (pushString . show), simpleTableAlignments)
+      (peekList peekRead, \t aligns -> t{simpleTableAlignments = aligns})
+  , property "widths" "relative column widths"
+      (pushPandocList pushRealFloat, simpleTableColumnWidths)
+      (peekList peekRealFloat, \t ws -> t{simpleTableColumnWidths = ws})
+  , property "headers" "table header"
+      (pushRow, simpleTableHeader)
+      (peekRow, \t h -> t{simpleTableHeader = h})
+  , property "rows" "table body rows"
+      (pushPandocList pushRow, simpleTableBody)
+      (peekList peekRow, \t bs -> t{simpleTableBody = bs})
+
+  , readonly "t" "type tag (always 'SimpleTable')"
+      (pushText, const "SimpleTable")
+
+  , alias "header" "alias for `headers`" ["headers"]
+  ]
+ where
+  pushRow = pushPandocList (pushPandocList pushBlock)
+
+peekRow :: LuaError e => Peeker e [[Block]]
+peekRow = peekList peekBlocksFuzzy
 
 -- | Push a simple table to the stack by calling the
 -- @pandoc.SimpleTable@ constructor.
 pushSimpleTable :: forall e. LuaError e => SimpleTable -> LuaE e ()
-pushSimpleTable tbl = pushViaConstructor @e "SimpleTable"
-  (simpleTableCaption tbl)
-  (simpleTableAlignments tbl)
-  (simpleTableColumnWidths tbl)
-  (simpleTableHeader tbl)
-  (simpleTableBody tbl)
+pushSimpleTable = pushUD typeSimpleTable
 
 -- | Retrieve a simple table from the stack.
 peekSimpleTable :: forall e. LuaError e => Peeker e SimpleTable
-peekSimpleTable idx = retrieving "SimpleTable" $ SimpleTable
-  <$!> peekFieldRaw peekInlines "caption" idx
-  <*>  peekFieldRaw (peekList peekRead) "aligns" idx
-  <*>  peekFieldRaw (peekList peekRealFloat) "widths" idx
-  <*>  peekFieldRaw (peekList peekBlocks) "headers" idx
-  <*>  peekFieldRaw (peekList (peekList peekBlocks)) "rows" idx
+peekSimpleTable = retrieving "SimpleTable" . peekUD typeSimpleTable
+
+-- | Constructor for the 'SimpleTable' type.
+mkSimpleTable :: LuaError e => DocumentedFunction e
+mkSimpleTable = defun "SimpleTable"
+  ### liftPure5 SimpleTable
+  <#> parameter peekInlinesFuzzy "Inlines" "caption" "table caption"
+  <#> parameter (peekList peekRead) "{Alignment,...}" "align" "column alignments"
+  <#> parameter (peekList peekRealFloat) "{number,...}" "widths"
+        "relative column widths"
+  <#> parameter peekRow "{Blocks,...}" "header" "table header row"
+  <#> parameter (peekList peekRow) "{{Blocks,...},...}" "body" "table body rows"
+  =#> functionResult pushSimpleTable "SimpleTable" "new SimpleTable object"
diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs
index 458795029..7bad3f1a5 100644
--- a/src/Text/Pandoc/Lua/Module/Pandoc.hs
+++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs
@@ -39,6 +39,7 @@ 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.SimpleTable (mkSimpleTable)
 import Text.Pandoc.Lua.PandocLua (PandocLua, addFunction, liftPandocLua,
                                   loadDefaultModule)
 import Text.Pandoc.Options (ReaderOptions (readerExtensions))
@@ -311,6 +312,7 @@ otherConstructors =
     #? "Creates a single citation."
 
   , mkListAttributes
+  , mkSimpleTable
   ]
 
 stringConstants :: [String]
diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs
index 50157189f..f20bc09e8 100644
--- a/src/Text/Pandoc/Lua/Util.hs
+++ b/src/Text/Pandoc/Lua/Util.hs
@@ -19,7 +19,6 @@ module Text.Pandoc.Lua.Util
   ( getTag
   , addField
   , addFunction
-  , pushViaConstructor
   , callWithTraceback
   , dofileWithTraceback
   , pushViaConstr'
@@ -44,33 +43,6 @@ addFunction name fn = do
   Lua.pushHaskellFunction $ toHaskellFunction fn
   Lua.rawset (-3)
 
--- | Helper class for pushing a single value to the stack via a lua
--- function. See @pushViaCall@.
-class LuaError e => PushViaCall e a where
-  pushViaCall' :: LuaError e => Name -> LuaE e () -> NumArgs -> a
-
-instance LuaError e => PushViaCall e (LuaE e ()) where
-  pushViaCall' fn pushArgs num = do
-    Lua.pushName @e fn
-    Lua.rawget Lua.registryindex
-    pushArgs
-    Lua.call num 1
-
-instance (LuaError e, Pushable a, PushViaCall e b) =>
-         PushViaCall e (a -> b) where
-  pushViaCall' fn pushArgs num x =
-    pushViaCall' @e fn (pushArgs *> Lua.push x) (num + 1)
-
--- | Push an value to the stack via a lua function. The lua function is called
--- with all arguments that are passed to this function and is expected to return
--- a single value.
-pushViaCall :: forall e a. LuaError e => PushViaCall e a => Name -> a
-pushViaCall fn = pushViaCall' @e fn (return ()) 0
-
--- | Call a pandoc element constructor within Lua, passing all given arguments.
-pushViaConstructor :: forall e a. LuaError e => PushViaCall e a => Name -> a
-pushViaConstructor pandocFn = pushViaCall @e ("pandoc." <> pandocFn)
-
 -- | Get the tag of a value. This is an optimized and specialized version of
 -- @Lua.getfield idx "tag"@. It only checks for the field on the table at index
 -- @idx@ and on its metatable, also ignoring any @__index@ value on the