From b95e864ecfc0a0ef96fa09d4118c8e6b4033784c Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Tue, 26 Oct 2021 21:39:24 +0200
Subject: Lua: marshal SimpleTable values as userdata objects
---
src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs | 74 ++++++++++++++++++++-------
src/Text/Pandoc/Lua/Module/Pandoc.hs | 2 +
src/Text/Pandoc/Lua/Util.hs | 28 ----------
3 files changed, 58 insertions(+), 46 deletions(-)
(limited to 'src')
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
--
cgit v1.2.3