diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Text/Pandoc/Lua/Marshaling/AST.hs | 116 |
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 () |