Lua: marshal SimpleTable values as userdata objects

data/pandoc.lua

@@ -348,30 +348,6 @@ function M.MetaBool(bool)
   return bool
 end
 
-------------------------------------------------------------------------
--- Legacy and compatibility types
---
-
---- Creates a simple (old style) table element.
--- @function SimpleTable
--- @tparam      {Inline,...} caption    table caption
--- @tparam      {AlignDefault|AlignLeft|AlignRight|AlignCenter,...} aligns alignments
--- @tparam      {int,...}    widths     column widths
--- @tparam      {Block,...}  headers    header row
--- @tparam      {{Block,...}} rows      table rows
--- @treturn     Block                   table element
-M.SimpleTable = function(caption, aligns, widths, headers, rows)
-  return {
-    caption = ensureInlineList(caption),
-    aligns = List:new(aligns),
-    widths = List:new(widths),
-    headers = List:new(headers),
-    rows = List:new(rows),
-    tag = "SimpleTable",
-    t = "SimpleTable",
-  }
-end
-
 ------------------------------------------------------------------------
 -- Functions which have moved to different modules
 M.sha1 = utils.sha1

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"

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]

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

test/lua/module/pandoc.lua

@@ -261,6 +261,67 @@ return {
       end)
     }
   },
+  group 'Other types' {
+    group 'SimpleTable' {
+      test('can access properties', function ()
+        local spc = pandoc.Space()
+        local caption = {pandoc.Str 'Languages', spc, pandoc.Str 'overview.'}
+        local aligns = {pandoc.AlignDefault, pandoc.AlignDefault}
+        local widths = {0, 0} -- let pandoc determine col widths
+        local headers = {{pandoc.Plain({pandoc.Str "Language"})},
+          {pandoc.Plain({pandoc.Str "Typing"})}}
+        local rows = {
+          {{pandoc.Plain "Haskell"}, {pandoc.Plain "static"}},
+          {{pandoc.Plain "Lua"}, {pandoc.Plain "Dynamic"}},
+        }
+        local simple_table = pandoc.SimpleTable(
+          caption,
+          aligns,
+          widths,
+          headers,
+          rows
+        )
+        assert.are_same(simple_table.caption, caption)
+        assert.are_same(simple_table.aligns, aligns)
+        assert.are_same(simple_table.widths, widths)
+        assert.are_same(simple_table.headers, headers)
+        assert.are_same(simple_table.rows, rows)
+      end),
+      test('can modify properties', function ()
+        local new_table = pandoc.SimpleTable(
+          {'Languages'},
+          {pandoc.AlignDefault, pandoc.AlignDefault},
+          {0.5, 0.5},
+          {{pandoc.Plain({pandoc.Str "Language"})},
+           {pandoc.Plain({pandoc.Str "Typing"})}},
+          {
+            {{pandoc.Plain "Haskell"}, {pandoc.Plain "static"}},
+            {{pandoc.Plain "Lua"}, {pandoc.Plain "Dynamic"}},
+          }
+        )
+
+        new_table.caption = {pandoc.Str 'Good', pandoc.Space(),
+                             pandoc.Str 'languages'}
+        new_table.aligns[1] = pandoc.AlignLeft
+        new_table.widths = {0, 0}
+        new_table.headers[2] = {pandoc.Plain{pandoc.Str 'compiled/interpreted'}}
+        new_table.rows[1][2] = {pandoc.Plain{pandoc.Str 'both'}}
+        new_table.rows[2][2] = {pandoc.Plain{pandoc.Str 'interpreted'}}
+
+        local expected_table = pandoc.SimpleTable(
+          {pandoc.Str 'Good', pandoc.Space(), pandoc.Str 'languages'},
+          {pandoc.AlignLeft, pandoc.AlignDefault},
+          {0, 0},
+          {{pandoc.Plain 'Language'}, {pandoc.Plain 'compiled/interpreted'}},
+          {
+            {{pandoc.Plain 'Haskell'}, {pandoc.Plain 'both'}},
+            {{pandoc.Plain 'Lua'}, {pandoc.Plain 'interpreted'}}
+          }
+        )
+        assert.are_same(expected_table, new_table)
+      end)
+    }
+  },
 
   group 'clone' {
     test('clones Attr', function ()