From b95e864ecfc0a0ef96fa09d4118c8e6b4033784c Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 26 Oct 2021 21:39:24 +0200 Subject: Lua: marshal SimpleTable values as userdata objects --- data/pandoc.lua | 24 --------- src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs | 74 ++++++++++++++++++++------- src/Text/Pandoc/Lua/Module/Pandoc.hs | 2 + src/Text/Pandoc/Lua/Util.hs | 28 ---------- test/lua/module/pandoc.lua | 61 ++++++++++++++++++++++ 5 files changed, 119 insertions(+), 70 deletions(-) diff --git a/data/pandoc.lua b/data/pandoc.lua index 294fed99e..cc4dc0cab 100644 --- a/data/pandoc.lua +++ b/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 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 - 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 diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index 173c9bb29..9b6e360f3 100644 --- a/test/lua/module/pandoc.lua +++ b/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 () -- cgit v1.2.3