Push blocks via lua constructors and constants

All element creation tasks are handled by lua functions defined in the
pandoc module.

data/pandoc.lua

@@ -173,18 +173,23 @@ end
 --- Meta blocks
 -- @function MetaBlocks
 -- @tparam {Block,...} blocks blocks
+
 --- Meta inlines
 -- @function MetaInlines
 -- @tparam {Inline,...} inlines inlines
+
 --- Meta list
 -- @function MetaList
 -- @tparam {MetaValue,...} meta_values list of meta values
+
 --- Meta boolean
 -- @function MetaBool
 -- @tparam boolean bool boolean value
+
 --- Meta map
 -- @function MetaMap
 -- @tparam table a string-index map of meta values
+
 --- Meta string
 -- @function MetaString
 -- @tparam string str string value
@@ -205,17 +210,166 @@ for i = 1, #M.meta_value_types do
   )
 end
 
---- Inline element class
+------------------------------------------------------------------------
--- @type Inline
+-- Block
-M.Inline = Element:make_subtype{}
+-- @section Block
-M.Inline.__call = function (t, ...)
+
+M.Block = Element:make_subtype{}
+M.Block.__call = function (t, ...)
   return t:new(...)
 end
 
+--- Creates a block quote element
+-- @function BlockQuote
+-- @tparam      {Block,...} content     block content
+-- @treturn     Block                   block quote element
+M.BlockQuote = M.Block:create_constructor(
+  "BlockQuote",
+  function(content) return {c = content} end
+)
+
+--- Creates a bullet (i.e. unordered) list.
+-- @function BulletList
+-- @tparam      {{Block,...},...} content     list of items
+-- @treturn     Block block quote element
+M.BulletList = M.Block:create_constructor(
+  "BulletList",
+  function(content) return {c = content} end
+)
+
+--- Creates a code block element
+-- @function CodeBlock
+-- @tparam      string      code        code string
+-- @tparam[opt] Attributes  attributes  element attributes
+-- @treturn     Block                   code block element
+M.CodeBlock = M.Block:create_constructor(
+  "CodeBlock",
+  function(code, attributes) return {c = {attributes, code}} end
+)
+
+--- Creates a definition list, containing terms and their explanation.
+-- @function DefinitionList
+-- @tparam      {{{Inline,...},{Block,...}},...} content     list of items
+-- @treturn     Block block quote element
+M.DefinitionList = M.Block:create_constructor(
+  "DefinitionList",
+  function(content) return {c = content} end
+)
+
+--- Creates a div element
+-- @function Div
+-- @tparam      {Block,...} content     block content
+-- @tparam[opt] Attributes  attributes  element attributes
+-- @treturn     Block                   code block element
+M.Div = M.Block:create_constructor(
+  "Div",
+  function(content, attributes) return {c = {attributes, content}} end
+)
+
+--- Creates a block quote element.
+-- @function Header
+-- @tparam      int          level       header level
+-- @tparam      Attributes   attributes  element attributes
+-- @tparam      {Inline,...} content     inline content
+-- @treturn     Block                    header element
+M.Header = M.Block:create_constructor(
+  "Header",
+  function(level, attributes, content)
+    return {c = {level, attributes, content}}
+  end
+)
+
+--- Creates a horizontal rule.
+-- @function HorizontalRule
+-- @treturn     Block                   horizontal rule
+M.HorizontalRule = M.Block:create_constructor(
+  "HorizontalRule",
+  function() return {} end
+)
+
+--- Creates a line block element.
+-- @function LineBlock
+-- @tparam      {{Inline,...},...} content    inline content
+-- @treturn     Block                   block quote element
+M.LineBlock = M.Block:create_constructor(
+  "LineBlock",
+  function(content) return {c = content} end
+)
+
+--- Creates a null element.
+-- @function Null
+-- @treturn     Block                   null element
+M.Null = M.Block:create_constructor(
+  "Null",
+  function() return {} end
+)
+
+--- Creates an ordered list.
+-- @function OrderedList
+-- @tparam      {{Block,...},...} items list items
+-- @param[opt]  listAttributes list parameters
+-- @treturn     Block
+M.OrderedList = M.Block:create_constructor(
+  "OrderedList",
+  function(items, listAttributes)
+    return {c = {listAttributes,items}}
+  end
+)
+
+--- Creates a para element.
+-- @function Para
+-- @tparam      {Inline,...} content    inline content
+-- @treturn     Block                   block quote element
+M.Para = M.Block:create_constructor(
+  "Para",
+  function(content) return {c = content} end
+)
+
+--- Creates a plain element.
+-- @function Plain
+-- @tparam      {Inline,...} content    inline content
+-- @treturn     Block                   block quote element
+M.Plain = M.Block:create_constructor(
+  "Plain",
+  function(content) return {c = content} end
+)
+
+--- Creates a raw content block of the specified format.
+-- @function RawBlock
+-- @tparam      string      format      format of content
+-- @tparam      string      content     string content
+-- @treturn     Block                   block quote element
+M.RawBlock = M.Block:create_constructor(
+  "RawBlock",
+  function(format, content) return {c = {format, content}} end
+)
+
+--- Creates a table element.
+-- @function Table
+-- @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                   block quote element
+M.Table = M.Block:create_constructor(
+  "Table",
+  function(caption, aligns, widths, headers, rows)
+    return {c = {caption, aligns, widths, headers, rows}}
+  end
+)
+
+
 ------------------------------------------------------------------------
 -- Inline
 -- @section Inline
 
+--- Inline element class
+M.Inline = Element:make_subtype{}
+M.Inline.__call = function (t, ...)
+  return t:new(...)
+end
+
 --- Creates a Cite inline element
 -- @function Cite
 -- @tparam {Inline,...}   content       List of inlines
@@ -405,42 +559,6 @@ M.Superscript = M.Inline:create_constructor(
 )
 
 
-------------------------------------------------------------------------
--- Block elements
--- @type Block
-M.Block = Element:make_subtype{}
-
---- Block constructors
-M.Block.constructors = {
-  BlockQuote = true,
-  BulletList = true,
-  CodeBlock = true,
-  DefinitionList = true,
-  Div = true,
-  Header = true,
-  HorizontalRule = true,
-  HorizontalRule = true,
-  LineBlock = true,
-  Null = true,
-  OrderedList = true,
-  Para = true,
-  Plain = true,
-  RawBlock = true,
-  Table = true,
-}
-
-local set_of_inline_types = {}
-for k, _ in pairs(M.Inline.constructor) do
-  set_of_inline_types[k] = true
-end
-
-for block_type, _ in pairs(M.Block.constructors) do
-  M[block_type] = function(...)
-    return M.Block:new(block_type, ...)
-  end
-end
-
-
 ------------------------------------------------------------------------
 -- Constants
 -- @section constants
@@ -482,6 +600,81 @@ M.SuppressAuthor.t = "SuppressAuthor"
 M.NormalCitation = {}
 M.NormalCitation.t = "NormalCitation"
 
+--- Table cells aligned left.
+-- @see Table
+M.AlignLeft = {}
+M.AlignLeft.t = "AlignLeft"
+
+--- Table cells right-aligned.
+-- @see Table
+M.AlignRight = {}
+M.AlignRight.t = "AlignRight"
+
+--- Table cell content is centered.
+-- @see Table
+M.AlignCenter = {}
+M.AlignCenter.t = "AlignCenter"
+
+--- Table cells are alignment is unaltered.
+-- @see Table
+M.AlignDefault = {}
+M.AlignDefault.t = "AlignDefault"
+
+--- Default list number delimiters are used.
+-- @see OrderedList
+M.DefaultDelim = {}
+M.DefaultDelim.t = "DefaultDelim"
+
+--- List numbers are delimited by a period.
+-- @see OrderedList
+M.Period = {}
+M.Period.t = "Period"
+
+--- List numbers are delimited by a single parenthesis.
+-- @see OrderedList
+M.OneParen = {}
+M.OneParen.t = "OneParen"
+
+--- List numbers are delimited by a double parentheses.
+-- @see OrderedList
+M.TwoParens = {}
+M.TwoParens.t = "TwoParens"
+
+--- List are numbered in the default style
+-- @see OrderedList
+M.DefaultStyle = {}
+M.DefaultStyle.t = "DefaultStyle"
+
+--- List items are numbered as examples.
+-- @see OrderedList
+M.Example = {}
+M.Example.t = "Example"
+
+--- List are numbered using decimal integers.
+-- @see OrderedList
+M.Decimal = {}
+M.Decimal.t = "Decimal"
+
+--- List are numbered using lower-case roman numerals.
+-- @see OrderedList
+M.LowerRoman = {}
+M.LowerRoman.t = "LowerRoman"
+
+--- List are numbered using upper-case roman numerals
+-- @see OrderedList
+M.UpperRoman = {}
+M.UpperRoman.t = "UpperRoman"
+
+--- List are numbered using lower-case alphabetic characters.
+-- @see OrderedList
+M.LowerAlpha = {}
+M.LowerAlpha.t = "LowerAlpha"
+
+--- List are numbered using upper-case alphabetic characters.
+-- @see OrderedList
+M.UpperAlpha = {}
+M.UpperAlpha.t = "UpperAlpha"
+
 
 ------------------------------------------------------------------------
 -- Helper Functions
@@ -503,7 +696,7 @@ M.NormalCitation.t = "NormalCitation"
 function M.global_filter()
   local res = {}
   for k, v in pairs(_G) do
-    if M.Inline.constructor[k] or M.Block.constructors[k] or k == "Doc" then
+    if M.Inline.constructor[k] or M.Block.constructor[k] or M.Block.constructors[k] or k == "Doc" then
       res[k] = v
     end
   end

src/Text/Pandoc/Lua/StackInstances.hs

@@ -36,25 +36,17 @@ StackValue instances for pandoc types.
 module Text.Pandoc.Lua.StackInstances () where
 
 import Control.Applicative ( (<|>) )
-import Data.Aeson ( FromJSON(..), ToJSON(..), Result(..), Value, fromJSON )
 import Scripting.Lua
   ( LTYPE(..), LuaState, StackValue(..)
   , call, getglobal2, gettable, ltype, newtable, next, objlen
-  , pop, pushnil, rawgeti, rawset, rawseti, settable
+  , pop, pushnil, rawgeti, rawseti, settable
   )
 import Scripting.Lua.Aeson ()
 import Text.Pandoc.Definition
-  ( Block(..), Inline(..), Meta(..), MetaValue(..), Pandoc(..)
-  , Citation(..), CitationMode(..), Format(..), MathType(..), QuoteType(..) )
 
 import qualified Data.Map as M
 import qualified Text.Pandoc.UTF8 as UTF8
 
-maybeFromJson :: (FromJSON a) => Maybe Value -> Maybe a
-maybeFromJson mv = fromJSON <$> mv >>= \case
-  Success x -> Just x
-  _         -> Nothing
-
 instance StackValue Pandoc where
   push lua (Pandoc meta blocks) = do
     newtable lua
@@ -121,16 +113,22 @@ peekContent lua idx = do
 
 instance StackValue Block where
   push lua = \case
-    BlockQuote blcks  -> pushTagged  lua "BlockQuote" blcks
+    BlockQuote blcks         -> pushViaConstructor lua "BlockQuote" blcks
-    BulletList items  -> pushTagged  lua "BulletList" items
+    BulletList items         -> pushViaConstructor lua "BulletList" items
-    HorizontalRule    -> pushTagged' lua "HorizontalRule"
+    CodeBlock attr code      -> pushViaConstructor lua "CodeBlock" code attr
-    LineBlock blcks   -> pushTagged  lua "LineBlock" blcks
+    DefinitionList items     -> pushViaConstructor lua "DefinitionList" items
-    Null              -> pushTagged' lua "Null"
+    Div attr blcks           -> pushViaConstructor lua "Div" blcks attr
-    Para blcks        -> pushTagged  lua "Para" blcks
+    Header lvl attr inlns    -> pushViaConstructor lua "Header" lvl attr inlns
-    Plain blcks       -> pushTagged  lua "Plain" blcks
+    HorizontalRule           -> pushViaConstructor lua "HorizontalRule"
-    RawBlock f cs     -> pushTagged  lua "RawBlock" (f, cs)
+    LineBlock blcks          -> pushViaConstructor lua "LineBlock" blcks
+    OrderedList lstAttr list -> pushViaConstructor lua "OrderedList" list lstAttr
+    Null                     -> pushViaConstructor lua "Null"
+    Para blcks               -> pushViaConstructor lua "Para" blcks
+    Plain blcks              -> pushViaConstructor lua "Plain" blcks
+    RawBlock f cs            -> pushViaConstructor lua "RawBlock" f cs
+    Table capt aligns widths headers rows ->
+      pushViaConstructor lua "Table" capt aligns widths headers rows
     -- fall back to conversion via aeson's Value
-    x                 -> push lua (toJSON x)
   peek lua i = peekBlock lua i
   valuetype _ = TTABLE
 
@@ -158,6 +156,22 @@ instance StackValue Inline where
   peek = peekInline
   valuetype _ = TTABLE
 
+instance StackValue Alignment where
+  push lua = \case
+    AlignLeft -> getglobal2 lua "pandoc.AlignLeft"
+    AlignRight -> getglobal2 lua "pandoc.AlignRight"
+    AlignCenter -> getglobal2 lua "pandoc.AlignCenter"
+    AlignDefault -> getglobal2 lua "pandoc.AlignDefault"
+  peek lua idx = do
+    tag <- getField lua idx "t"
+    case tag of
+      Just "AlignLeft" -> return $ Just AlignLeft
+      Just "AlignRight" -> return $ Just AlignRight
+      Just "AlignCenter" -> return $ Just AlignCenter
+      Just "AlignDefault" -> return $ Just AlignDefault
+      _ -> return Nothing
+  valuetype _ = TSTRING
+
 instance StackValue Citation where
   push lua (Citation cid prefix suffix mode noteNum hash) =
     pushViaConstructor lua "Citation" cid mode prefix suffix noteNum hash
@@ -183,13 +197,51 @@ instance StackValue CitationMode where
       Just "NormalCitation" -> return $ Just NormalCitation
       Just "SuppressAuthor" -> return $ Just SuppressAuthor
       _ -> return Nothing
-  valuetype _ = TSTRING
+  valuetype _ = TTABLE
 
 instance StackValue Format where
   push lua (Format f) = push lua f
   peek lua idx = fmap Format <$> peek lua idx
   valuetype _ = TSTRING
 
+instance StackValue ListNumberDelim where
+  push lua = \case
+    DefaultDelim -> getglobal2 lua "pandoc.DefaultDelim"
+    Period -> getglobal2 lua "pandoc.Period"
+    OneParen -> getglobal2 lua "pandoc.OneParen"
+    TwoParens -> getglobal2 lua "pandoc.TwoParens"
+  peek lua idx = do
+    tag <- getField lua idx "t"
+    case tag of
+      Just "DefaultDelim" -> return $ Just DefaultDelim
+      Just "Period" -> return $ Just Period
+      Just "OneParen" -> return $ Just OneParen
+      Just "TwoParens" -> return $ Just TwoParens
+      _ -> return Nothing
+  valuetype _ = TTABLE
+
+instance StackValue ListNumberStyle where
+  push lua = \case
+    DefaultStyle -> getglobal2 lua "pandoc.DefaultStyle"
+    LowerRoman -> getglobal2 lua "pandoc.LowerRoman"
+    UpperRoman -> getglobal2 lua "pandoc.UpperRoman"
+    LowerAlpha -> getglobal2 lua "pandoc.LowerAlpha"
+    UpperAlpha -> getglobal2 lua "pandoc.UpperAlpha"
+    Decimal -> getglobal2 lua "pandoc.Decimal"
+    Example -> getglobal2 lua "pandoc.Example"
+  peek lua idx = do
+    tag <- getField lua idx "t"
+    case tag of
+      Just "DefaultStyle" -> return $ Just DefaultStyle
+      Just "LowerRoman" -> return $ Just LowerRoman
+      Just "UpperRoman" -> return $ Just UpperRoman
+      Just "LowerAlpha" -> return $ Just LowerAlpha
+      Just "UpperAlpha" -> return $ Just UpperAlpha
+      Just "Decimal" -> return $ Just Decimal
+      Just "Example" -> return $ Just Example
+      _ -> return Nothing
+  valuetype _ = TTABLE
+
 instance StackValue MathType where
   push lua = \case
     InlineMath -> getglobal2 lua "pandoc.InlineMath"
@@ -249,6 +301,26 @@ instance (StackValue a, StackValue b, StackValue c) =>
     return $ (,,) <$> a <*> b <*> c
   valuetype _ = TTABLE
 
+instance (StackValue a, StackValue b, StackValue c,
+          StackValue d, StackValue e) =>
+         StackValue (a, b, c, d, e)
+ where
+  push lua (a, b, c, d, e) = do
+    newtable lua
+    addIndexedValue lua 1 a
+    addIndexedValue lua 2 b
+    addIndexedValue lua 3 c
+    addIndexedValue lua 4 d
+    addIndexedValue lua 5 e
+  peek lua idx = do
+    a <- getIndexedValue lua idx 1
+    b <- getIndexedValue lua idx 2
+    c <- getIndexedValue lua idx 3
+    d <- getIndexedValue lua idx 4
+    e <- getIndexedValue lua idx 5
+    return $ (,,,,) <$> a <*> b <*> c <*> d <*> e
+  valuetype _ = TTABLE
+
 instance (Ord a, StackValue a, StackValue b) =>
          StackValue (M.Map a b) where
   push lua m = do
@@ -307,22 +379,6 @@ pushViaCall lua fn = pushViaCall' lua fn (return ()) 0
 pushViaConstructor :: PushViaCall a => LuaState -> String -> a
 pushViaConstructor lua pandocFn = pushViaCall lua ("pandoc." ++ pandocFn)
 
--- | Push a value to the lua stack, tagged with a given string. This currently
--- creates a structure equivalent to what the JSONified value would look like
--- when pushed to lua.
-pushTagged :: StackValue a => LuaState -> String -> a -> IO ()
-pushTagged lua tag value = do
-  newtable lua
-  addKeyValue lua "t" tag
-  addKeyValue lua "c" value
-
-pushTagged' :: LuaState -> String -> IO ()
-pushTagged' lua tag = do
-  newtable lua
-  push lua "t"
-  push lua tag
-  rawset lua (-3)
-
 -- | Return the value at the given index as inline if possible.
 peekInline :: LuaState -> Int -> IO (Maybe Inline)
 peekInline lua idx = do
@@ -366,13 +422,22 @@ peekBlock lua idx = do
     Just t -> case t of
       "BlockQuote"     -> fmap BlockQuote <$> elementContent
       "BulletList"     -> fmap BulletList <$> elementContent
+      "CodeBlock"      -> fmap (uncurry CodeBlock) <$> elementContent
+      "DefinitionList" -> fmap DefinitionList <$> elementContent
+      "Div"            -> fmap (uncurry Div) <$> elementContent
+      "Header"         -> fmap (\(lvl, attr, lst) -> Header lvl attr lst)
+                          <$> elementContent
       "HorizontalRule" -> return (Just HorizontalRule)
       "LineBlock"      -> fmap LineBlock <$> elementContent
+      "OrderedList"    -> fmap (uncurry OrderedList) <$> elementContent
       "Null"           -> return (Just Null)
       "Para"           -> fmap Para <$> elementContent
       "Plain"          -> fmap Plain <$> elementContent
-      -- fall back to construction via aeson's Value
+      "RawBlock"       -> fmap (uncurry RawBlock) <$> elementContent
-      _ -> maybeFromJson <$> peek lua idx
+      "Table"          -> fmap (\(capt, aligns, widths, headers, body) ->
+                                  Table capt aligns widths headers body)
+                          <$> elementContent
+      _ -> return Nothing
  where
    -- Get the contents of an AST element.
    elementContent :: StackValue a => IO (Maybe a)