Lua: support new tables

1 files changed, 99 insertions, 17 deletions

diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs
index 5a56b4cb9..81b206f67 100644
--- a/src/Text/Pandoc/Lua/Marshaling/AST.hs
+++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs
@@ -21,7 +21,6 @@ import Foreign.Lua (Lua, Peekable, Pushable, StackIndex)
 import Text.Pandoc.Definition
 import Text.Pandoc.Lua.Util (defineHowTo, pushViaConstructor)
 import Text.Pandoc.Lua.Marshaling.CommonState ()
-import Text.Pandoc.Writers.Shared (toLegacyTable)
 
 import qualified Foreign.Lua as Lua
 import qualified Text.Pandoc.Lua.Util as LuaUtil
@@ -151,7 +150,7 @@ peekMetaValue idx = defineHowTo "get MetaValue" $ do
                   <|> (MetaList <$> Lua.peek idx)
     _        -> Lua.throwException "could not get meta value"
 
--- | Push an block element to the top of the lua stack.
+-- | Push a block element to the top of the Lua stack.
 pushBlock :: Block -> Lua ()
 pushBlock = \case
   BlockQuote blcks         -> pushViaConstructor "BlockQuote" blcks
@@ -168,9 +167,8 @@ pushBlock = \case
   Para blcks               -> pushViaConstructor "Para" blcks
   Plain blcks              -> pushViaConstructor "Plain" blcks
   RawBlock f cs            -> pushViaConstructor "RawBlock" f cs
-  Table _ blkCapt specs thead tbody tfoot ->
-    let (capt, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
-    in pushViaConstructor "Table" capt aligns widths headers rows
+  Table attr blkCapt specs thead tbody tfoot ->
+    pushViaConstructor "Table" attr blkCapt specs thead tbody tfoot
 
 -- | Return the value at the given index as block if possible.
 peekBlock :: StackIndex -> Lua Block
@@ -193,13 +191,13 @@ peekBlock idx = defineHowTo "get Block value" $ do
       "Para"           -> Para <$> elementContent
       "Plain"          -> Plain <$> elementContent
       "RawBlock"       -> uncurry RawBlock <$> elementContent
-      "Table"          -> (\(capt, aligns, widths, headers, body) ->
-                              Table nullAttr
-                                    (Caption Nothing $ maybePlain capt)
-                                    (zip aligns (map strictPos widths))
-                                    (TableHead nullAttr $ toHeaderRow headers)
-                                    [TableBody nullAttr 0 [] (map toRow body)]
-                                    (TableFoot nullAttr []))
+      "Table"          -> (\(attr, capt, colSpecs, thead, tbodies, tfoot) ->
+                              Table (fromLuaAttr attr)
+                                    capt
+                                    colSpecs
+                                    thead
+                                    tbodies
+                                    tfoot)
                           <$> elementContent
       _ -> Lua.throwException ("Unknown block type: " <> tag)
  where
@@ -207,11 +205,95 @@ peekBlock idx = defineHowTo "get Block value" $ do
    elementContent :: Peekable a => Lua a
    elementContent = LuaUtil.rawField idx "c"
 
-   strictPos w = if w > 0 then ColWidth w else ColWidthDefault
-   maybePlain [] = []
-   maybePlain x  = [Plain x]
-   toRow = Row nullAttr . map (\blk -> Cell nullAttr AlignDefault 1 1 blk)
-   toHeaderRow l = if null l then [] else [toRow l]
+instance Pushable Caption where
+  push = pushCaption
+
+instance Peekable Caption where
+  peek = peekCaption
+
+-- | Push Caption element
+pushCaption :: Caption -> Lua ()
+pushCaption (Caption shortCaption longCaption) = do
+  Lua.newtable
+  LuaUtil.addField "short" (Lua.Optional shortCaption)
+  LuaUtil.addField "long" longCaption
+
+-- | Peek Caption element
+peekCaption :: StackIndex -> Lua Caption
+peekCaption idx = do
+  short <- Lua.fromOptional <$> LuaUtil.rawField idx "short"
+  long  <- LuaUtil.rawField idx "long"
+  return $ Caption short long
+
+instance Peekable ColWidth where
+  peek idx = do
+    width <- Lua.fromOptional <$> Lua.peek idx
+    return $ case width of
+      Nothing -> ColWidthDefault
+      Just w  -> ColWidth w
+
+instance Pushable ColWidth where
+  push = \case
+    (ColWidth w)    -> Lua.push w
+    ColWidthDefault -> Lua.pushnil
+
+instance Pushable Row where
+  push (Row attr cells) = Lua.push (attr, cells)
+
+instance Peekable Row where
+  peek = fmap (uncurry Row) . Lua.peek
+
+instance Pushable TableBody where
+  push (TableBody attr (RowHeadColumns rowHeadColumns) head' body) = do
+    Lua.newtable
+    LuaUtil.addField "attr" attr
+    LuaUtil.addField "row_head_columns" rowHeadColumns
+    LuaUtil.addField "head" head'
+    LuaUtil.addField "body" body
+
+instance Peekable TableBody where
+  peek idx = do
+    attr <- LuaUtil.rawField idx "attr"
+    rowHeadColumns <- LuaUtil.rawField idx "row_head_columns"
+    head' <- LuaUtil.rawField idx "head"
+    body <- LuaUtil.rawField idx "body"
+    return $ TableBody attr (RowHeadColumns rowHeadColumns) head' body
+
+instance Pushable TableHead where
+  push (TableHead attr cells) = Lua.push (attr, cells)
+
+instance Peekable TableHead where
+  peek = fmap (uncurry TableHead) . Lua.peek
+
+instance Pushable TableFoot where
+  push (TableFoot attr cells) = Lua.push (attr, cells)
+
+instance Peekable TableFoot where
+  peek = fmap (uncurry TableFoot) . Lua.peek
+
+instance Pushable Cell where
+  push = pushCell
+
+instance Peekable Cell where
+  peek = peekCell
+
+pushCell :: Cell -> Lua ()
+pushCell (Cell attr align (RowSpan rowSpan) (ColSpan colSpan) contents) = do
+  Lua.newtable
+  LuaUtil.addField "attr" attr
+  LuaUtil.addField "alignment" align
+  LuaUtil.addField "row_span" rowSpan
+  LuaUtil.addField "col_span" colSpan
+  LuaUtil.addField "contents" contents
+
+peekCell :: StackIndex -> Lua Cell
+peekCell idx = do
+  attr <- fromLuaAttr <$> LuaUtil.rawField idx "attr"
+  align <- LuaUtil.rawField idx "alignment"
+  rowSpan <- LuaUtil.rawField idx "row_span"
+  colSpan <- LuaUtil.rawField idx "col_span"
+  contents <- LuaUtil.rawField idx "contents"
+  return $ Cell attr align (RowSpan rowSpan) (ColSpan colSpan) contents
 
 -- | Push an inline element to the top of the lua stack.
 pushInline :: Inline -> Lua ()