aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Lua
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Lua')
-rw-r--r--src/Text/Pandoc/Lua/Init.hs1
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/AST.hs2
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs59
-rw-r--r--src/Text/Pandoc/Lua/Module/Utils.hs49
-rw-r--r--src/Text/Pandoc/Lua/Util.hs2
5 files changed, 106 insertions, 7 deletions
diff --git a/src/Text/Pandoc/Lua/Init.hs b/src/Text/Pandoc/Lua/Init.hs
index a5e513a1f..e89e9d6e0 100644
--- a/src/Text/Pandoc/Lua/Init.hs
+++ b/src/Text/Pandoc/Lua/Init.hs
@@ -80,6 +80,7 @@ putConstructorsInRegistry = liftPandocLua $ do
putInReg "Attr" -- used for Attr type alias
putInReg "ListAttributes" -- used for ListAttributes type alias
putInReg "List" -- pandoc.List
+ putInReg "SimpleTable" -- helper for backward-compatible table handling
where
constrsToReg :: Data a => a -> Lua ()
constrsToReg = mapM_ (putInReg . showConstr) . dataTypeConstrs . dataTypeOf
diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs
index 679dd1f46..c889618c4 100644
--- a/src/Text/Pandoc/Lua/Marshaling/AST.hs
+++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs
@@ -260,7 +260,7 @@ instance Peekable TableBody where
return $ TableBody attr (RowHeadColumns rowHeadColumns) head' body
instance Pushable TableHead where
- push (TableHead attr cells) = Lua.push (attr, cells)
+ push (TableHead attr rows) = Lua.push (attr, rows)
instance Peekable TableHead where
peek = fmap (uncurry TableHead) . Lua.peek
diff --git a/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs b/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs
new file mode 100644
index 000000000..98fa1efa4
--- /dev/null
+++ b/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs
@@ -0,0 +1,59 @@
+{- |
+ Module : Text.Pandoc.Lua.Marshaling.SimpleTable
+ Copyright : © 2020 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.
+-}
+module Text.Pandoc.Lua.Marshaling.SimpleTable
+ ( SimpleTable (..)
+ , peekSimpleTable
+ , pushSimpleTable
+ )
+ where
+
+import Foreign.Lua (Lua, Peekable, Pushable, StackIndex)
+import Text.Pandoc.Definition
+import Text.Pandoc.Lua.Util (defineHowTo, pushViaConstructor, rawField)
+import Text.Pandoc.Lua.Marshaling.AST ()
+
+import qualified Foreign.Lua as Lua
+
+-- | A simple (legacy-style) table.
+data SimpleTable = SimpleTable
+ { simpleTableCaption :: [Inline]
+ , simpleTableAlignments :: [Alignment]
+ , simpleTableColumnWidths :: [Double]
+ , simpleTableHeader :: [[Block]]
+ , simpleTableBody :: [[[Block]]]
+ }
+
+instance Pushable SimpleTable where
+ push = pushSimpleTable
+
+instance Peekable SimpleTable where
+ peek = peekSimpleTable
+
+-- | Push a simple table to the stack by calling the
+-- @pandoc.SimpleTable@ constructor.
+pushSimpleTable :: SimpleTable -> Lua ()
+pushSimpleTable tbl = pushViaConstructor "SimpleTable"
+ (simpleTableCaption tbl)
+ (simpleTableAlignments tbl)
+ (simpleTableColumnWidths tbl)
+ (simpleTableHeader tbl)
+ (simpleTableBody tbl)
+
+-- | Retrieve a simple table from the stack.
+peekSimpleTable :: StackIndex -> Lua SimpleTable
+peekSimpleTable idx = defineHowTo "get SimpleTable" $
+ SimpleTable
+ <$> rawField idx "caption"
+ <*> rawField idx "aligns"
+ <*> rawField idx "widths"
+ <*> rawField idx "headers"
+ <*> rawField idx "rows"
diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs
index 988489a2a..7595b9c0f 100644
--- a/src/Text/Pandoc/Lua/Module/Utils.hs
+++ b/src/Text/Pandoc/Lua/Module/Utils.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- |
Module : Text.Pandoc.Lua.Module.Utils
@@ -7,7 +8,7 @@
Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
Stability : alpha
-Utility module for lua, exposing internal helper functions.
+Utility module for Lua, exposing internal helper functions.
-}
module Text.Pandoc.Lua.Module.Utils
( pushModule
@@ -15,13 +16,17 @@ module Text.Pandoc.Lua.Module.Utils
import Control.Applicative ((<|>))
import Control.Monad.Catch (try)
+import Data.Data (showConstr, toConstr)
import Data.Default (def)
import Data.Version (Version)
-import Foreign.Lua (Peekable, Lua, NumResults)
-import Text.Pandoc.Definition ( Pandoc, Meta, MetaValue (..), Block, Inline
- , Citation, Attr, ListAttributes)
+import Foreign.Lua (Peekable, Lua, NumResults (..))
+import Text.Pandoc.Definition
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Marshaling ()
+import Text.Pandoc.Lua.Marshaling.SimpleTable
+ ( SimpleTable (..)
+ , pushSimpleTable
+ )
import Text.Pandoc.Lua.PandocLua (PandocLua, addFunction, liftPandocLua)
import qualified Data.Digest.Pure.SHA as SHA
@@ -31,19 +36,22 @@ import qualified Foreign.Lua as Lua
import qualified Text.Pandoc.Builder as B
import qualified Text.Pandoc.Filter.JSON as JSONFilter
import qualified Text.Pandoc.Shared as Shared
+import qualified Text.Pandoc.Writers.Shared as Shared
--- | Push the "pandoc.utils" module to the lua stack.
+-- | Push the "pandoc.utils" module to the Lua stack.
pushModule :: PandocLua NumResults
pushModule = do
liftPandocLua Lua.newtable
addFunction "blocks_to_inlines" blocksToInlines
addFunction "equals" equals
+ addFunction "from_simple_table" from_simple_table
addFunction "make_sections" makeSections
addFunction "normalize_date" normalizeDate
addFunction "run_json_filter" runJSONFilter
addFunction "sha1" sha1
addFunction "stringify" stringify
addFunction "to_roman_numeral" toRomanNumeral
+ addFunction "to_simple_table" to_simple_table
addFunction "Version" (return :: Version -> Lua Version)
return 1
@@ -131,6 +139,37 @@ instance Peekable AstElement where
Left (_ :: PandocError) -> Lua.throwMessage
"Expected an AST element, but could not parse value as such."
+-- | Converts an old/simple table into a normal table block element.
+from_simple_table :: SimpleTable -> Lua NumResults
+from_simple_table (SimpleTable capt aligns widths head' body) = do
+ Lua.push $ Table
+ nullAttr
+ (Caption Nothing [Plain capt])
+ (zipWith (\a w -> (a, toColWidth w)) aligns widths)
+ (TableHead nullAttr [blockListToRow head'])
+ [TableBody nullAttr 0 [] $ map blockListToRow body]
+ (TableFoot nullAttr [])
+ return (NumResults 1)
+ where
+ blockListToRow :: [[Block]] -> Row
+ blockListToRow = Row nullAttr . map (B.simpleCell . B.fromList)
+
+ toColWidth :: Double -> ColWidth
+ toColWidth 0 = ColWidthDefault
+ toColWidth w = ColWidth w
+
+-- | Converts a table into an old/simple table.
+to_simple_table :: Block -> Lua NumResults
+to_simple_table = \case
+ Table _attr caption specs thead tbodies tfoot -> do
+ let (capt, aligns, widths, headers, rows) =
+ Shared.toLegacyTable caption specs thead tbodies tfoot
+ pushSimpleTable $ SimpleTable capt aligns widths headers rows
+ return (NumResults 1)
+ blk ->
+ Lua.throwMessage $
+ "Expected Table, got " <> showConstr (toConstr blk) <> "."
+
-- | Convert a number < 4000 to uppercase roman numeral.
toRomanNumeral :: Lua.Integer -> PandocLua T.Text
toRomanNumeral = return . Shared.toRomanNumeral . fromIntegral
diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs
index c6639e94c..fbd013801 100644
--- a/src/Text/Pandoc/Lua/Util.hs
+++ b/src/Text/Pandoc/Lua/Util.hs
@@ -80,7 +80,7 @@ instance (Pushable a, PushViaCall b) => PushViaCall (a -> b) where
pushViaCall :: PushViaCall a => String -> a
pushViaCall fn = pushViaCall' fn (return ()) 0
--- | Call a pandoc element constructor within lua, passing all given arguments.
+-- | Call a pandoc element constructor within Lua, passing all given arguments.
pushViaConstructor :: PushViaCall a => String -> a
pushViaConstructor pandocFn = pushViaCall ("pandoc." ++ pandocFn)