From 97dfe782cfc46c51e9585afdc5853cbd0e9e0234 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Wed, 12 Apr 2017 21:21:25 +0200 Subject: Lua module: provide multi-param Inline constructors Instead of taking only a single argument containing the pre-packed element contents, `Inline` constructors now take the same arguments as the respective filter and `Custom` writer function --- data/pandoc.lua | 164 ++++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 160 insertions(+), 4 deletions(-) (limited to 'data/pandoc.lua') diff --git a/data/pandoc.lua b/data/pandoc.lua index d705b8566..78e2fa07a 100644 --- a/data/pandoc.lua +++ b/data/pandoc.lua @@ -26,7 +26,10 @@ function M.Attributes(id, classes, key_values) return {id, classes, key_values} end +------------------------------------------------------------------------ +--- Document AST elements local Element = {} + --- Create a new element subtype function Element:make_subtype(o) o = o or {} @@ -34,6 +37,7 @@ function Element:make_subtype(o) self.__index = self return o end + --- Create a new element given its tag and arguments function Element:new(tag, ...) local element = { t = tag } @@ -51,6 +55,35 @@ function Element:new(tag, ...) return element end +--- Create a new constructor +-- @param tag Tag used to identify the constructor +-- @param fn Function to be called when constructing a new element +-- @return function that constructs a new element +function Element:create_constructor(tag, fn) + local constr = self:make_subtype({tag = tag}) + function constr:new(...) + local obj = fn(...) + setmetatable(obj, self) + self.__index = function(t, k) + if k == "c" then + return t["content"] + elseif k == "t" then + return getmetatable(t)["tag"] + else + return getmetatable(t)[k] + end + end + return obj + end + return constr +end + +function Element.__call(t, ...) + return t:new(...) +end + +------------------------------------------------------------------------ +-- Document local function Doc(blocks, meta) return { ["blocks"] = blocks, @@ -58,10 +91,132 @@ local function Doc(blocks, meta) ["pandoc-api-version"] = {1,17,0,5}, } end - local Inline = Element:make_subtype{} +function Inline.__call(t, ...) + return t:new(...) +end + local Block = Element:make_subtype{} +------------------------------------------------------------------------ +-- Inline element constructors +-- @section + +--- Create a Cite inline element +-- @function Inline.Cite +Inline.Cite = Inline:create_constructor( + "Cite", + function(lst, cs) return {c = {cs, lst}} end +) +--- Create a Code inline element +-- @function Inline.Code +Inline.Code = Inline:create_constructor( + "Code", + function(code, attr) return {c = {attr, code}} end +) +--- Create a Emph inline element +-- @function Inline.Emph +Inline.Emph = Inline:create_constructor( + "Emph", + function(xs) return {c = xs} end +) +--- Create a Image inline element +-- @function Inline.Image +Inline.Image = Inline:create_constructor( + "Image", + function(capt, src, tit, attr) return {c = {attr, capt, {src, tit}}} end +) +--- Create a LineBreak inline element +-- @function Inline.LineBreak +Inline.LineBreak = Inline:create_constructor( + "LineBreak", + function() return {} end +) +--- Create a Link inline element +-- @function Inline.Link +Inline.Link = Inline:create_constructor( + "Link", + function(txt, src, tit, attr) return {c = {attr, txt, {src, tit}}} end +) +--- Create a Math inline element +-- @function Inline.Math +Inline.Math = Inline:create_constructor( + "Math", + function(m, str) return {c = {m, str}} end +) +--- Create a Note inline element +-- @function Inline.Note +Inline.Note = Inline:create_constructor( + "Note", + function(contents) return {c = contents} end +) +--- Create a Quoted inline element +-- @function Inline.Quoted +Inline.Quoted = Inline:create_constructor( + "Quoted", + function(qt, lst) return {c = {qt, lst}} end +) +--- Create a RawInline inline element +-- @function Inline.RawInline +Inline.RawInline = Inline:create_constructor( + "RawInline", + function(f, xs) return {c = {f, xs}} end +) +--- Create a SmallCaps inline element +-- @function Inline.SmallCaps +Inline.SmallCaps = Inline:create_constructor( + "SmallCaps", + function(xs) return {c = xs} end +) +--- Create a SoftBreak inline element +-- @function Inline.SoftBreak +Inline.SoftBreak = Inline:create_constructor( + "SoftBreak", + function() return {} end +) +--- Create a Space inline element +-- @function Inline.Space +Inline.Space = Inline:create_constructor( + "Space", + function() return {} end +) +--- Create a Span inline element +-- @function Inline.Span +Inline.Span = Inline:create_constructor( + "Span", + function(ls, attr) return {c = {attr, xs}} end +) +--- Create a Str inline element +-- @function Inline.Str +Inline.Str = Inline:create_constructor( + "Str", + function(str) return {c = str} end +) +--- Create a Strikeout inline element +-- @function Inline.Strikeout +Inline.Strikeout = Inline:create_constructor( + "Strikeout", + function(xs) return {c = xs} end +) +--- Create a Strong inline element +-- @function Inline.Strong +Inline.Strong = Inline:create_constructor( + "Strong", + function(xs) return {c = xs} end +) +--- Create a Subscript inline element +-- @function Inline.Subscript +Inline.Subscript = Inline:create_constructor( + "Subscript", + function(xs) return {c = xs} end +) +--- Create a Superscript inline element +-- @function Inline.Superscript +Inline.Superscript = Inline:create_constructor( + "Superscript", + function(xs) return {c = xs} end +) + M.block_types = { "BlockQuote", "BulletList", @@ -102,6 +257,7 @@ M.inline_types = { "Superscript" } + for _, block_type in pairs(M.block_types) do M[block_type] = function(...) return Block:new(block_type, ...) @@ -109,9 +265,7 @@ for _, block_type in pairs(M.block_types) do end for _, inline_type in pairs(M.inline_types) do - M[inline_type] = function(...) - return Inline:new(inline_type, ...) - end + M[inline_type] = Inline[inline_type] end --- Arrays to provide fast lookup of element types @@ -136,5 +290,7 @@ function M.global_filter() end M["Doc"] = Doc +M["Inline"] = Inline +M["Block"] = Block return M -- cgit v1.2.3 From 00746c3c761d7dd64b06f1f432a26c1d4246624e Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Thu, 13 Apr 2017 19:10:51 +0200 Subject: Improve lua module documentation --- data/pandoc.lua | 455 +++++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 315 insertions(+), 140 deletions(-) (limited to 'data/pandoc.lua') diff --git a/data/pandoc.lua b/data/pandoc.lua index 78e2fa07a..8d4d89bcd 100644 --- a/data/pandoc.lua +++ b/data/pandoc.lua @@ -1,7 +1,7 @@ --[[ pandoc.lua -Copyright (c) 2017 Albert Krewinkel +Copyright © 2017 Albert Krewinkel Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice @@ -16,21 +16,78 @@ TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. ]] ---- The module +--- +-- Lua functions for pandoc scripts. +-- +-- @author Albert Krewinkel +-- @copyright © 2017 Albert Krewinkel +-- @license MIT local M = { - _version = "0.1.0" + _VERSION = "0.2.0" } +--- Attributes +-- @type Attributes +M.Attributes = {} +setmetatable(M.Attributes, M.Attributes) + +M.Attributes.__index = function(t, k) + if k == "id" then + return t[1] + elseif k == "class" then + return table.concat(t[2], ' ') + else + return t.kv[k] + end +end + --- Create a new set of attributes (Attr). -function M.Attributes(id, classes, key_values) - return {id, classes, key_values} +-- @function Attributes +M.Attributes.__call = function(t, key_values, id, classes) + local kv = {} + for i = 1, #key_values do + kv[key_values[i][1]] = key_values[i][2] + end + id = id or '' + classes = classes or {} + local attr = {id, classes, key_values, kv = kv} + setmetatable(attr, t) + return attr +end +M.Attributes.empty = M.Attributes('', {}, {}) + + +--- Creates a single citation. +-- @function Citation +-- @tparam string id citation identifier (like a bibtex key) +-- @tparam AuthorInText|SuppressAuthor|NormalCitation mode citation mode +-- @tparam[opt] {Inline,...} prefix citation prefix +-- @tparam[opt] {Inline,...} suffix citation suffix +-- @tparam[opt] int note_num note number +-- @tparam[opt] int note_num hash number +M.Citation = function(id, mode, prefix, suffix, note_num, hash) + prefix = prefix or {} + suffix = suffix or {} + note_num = note_num or 0 + hash = hash or 0 + return { + citationId = id, + citationPrefix = prefix, + citationSuffix = suffix, + citationMode = mode, + citationNoteNum = note_num, + citationHash = hash, + } end ------------------------------------------------------------------------ ---- Document AST elements +-- The base class for pandoc's AST elements. +-- @type Element +-- @local local Element = {} --- Create a new element subtype +-- @local function Element:make_subtype(o) o = o or {} setmetatable(o, self) @@ -39,6 +96,7 @@ function Element:make_subtype(o) end --- Create a new element given its tag and arguments +-- @local function Element:new(tag, ...) local element = { t = tag } local content = {...} @@ -56,6 +114,7 @@ function Element:new(tag, ...) end --- Create a new constructor +-- @local -- @param tag Tag used to identify the constructor -- @param fn Function to be called when constructing a new element -- @return function that constructs a new element @@ -75,222 +134,338 @@ function Element:create_constructor(tag, fn) end return obj end + self.constructor = self.constructor or {} + self.constructor[tag] = constr return constr end +--- Calls the constructor, creating a new element. +-- @local function Element.__call(t, ...) return t:new(...) end ------------------------------------------------------------------------ --- Document -local function Doc(blocks, meta) +--- Pandoc Document +-- @section document + +--- A complete pandoc document +-- @function Doc +-- @tparam {Block,...} blocks document content +-- @tparam[opt] Meta meta document meta data +function M.Doc(blocks, meta) + meta = meta or {} return { ["blocks"] = blocks, ["meta"] = meta, ["pandoc-api-version"] = {1,17,0,5}, } end -local Inline = Element:make_subtype{} -function Inline.__call(t, ...) + + +--- Inline element class +-- @type Inline +M.Inline = Element:make_subtype{} +M.Inline.__call = function (t, ...) return t:new(...) end -local Block = Element:make_subtype{} - ------------------------------------------------------------------------ --- Inline element constructors --- @section +-- Inline +-- @section Inline ---- Create a Cite inline element --- @function Inline.Cite -Inline.Cite = Inline:create_constructor( +--- Creates a Cite inline element +-- @function Cite +-- @tparam {Inline,...} content List of inlines +-- @tparam {Citation,...} citations List of citations +-- @treturn Inline citations element +M.Cite = M.Inline:create_constructor( "Cite", - function(lst, cs) return {c = {cs, lst}} end + function(content, citations) return {c = {citations, content}} end ) ---- Create a Code inline element --- @function Inline.Code -Inline.Code = Inline:create_constructor( + +--- Creates a Code inline element +-- @function Code +-- @tparam string code brief image description +-- @tparam[opt] Attributes attributes additional attributes +-- @treturn Inline code element +M.Code = M.Inline:create_constructor( "Code", - function(code, attr) return {c = {attr, code}} end + function(code, attributes) return {c = {attributes, code}} end ) ---- Create a Emph inline element --- @function Inline.Emph -Inline.Emph = Inline:create_constructor( + +--- Creates an inline element representing emphasised text. +-- @function Emph +-- @tparam {Inline,..} content inline content +-- @treturn Inline emphasis element +M.Emph = M.Inline:create_constructor( "Emph", - function(xs) return {c = xs} end + function(content) return {c = content} end ) ---- Create a Image inline element --- @function Inline.Image -Inline.Image = Inline:create_constructor( + +--- Creates a Image inline element +-- @function Image +-- @tparam {Inline,..} caption text used to describe the image +-- @tparam string src path to the image file +-- @tparam[opt] string title brief image description +-- @tparam[opt] Attributes attributes additional attributes +-- @treturn Inline image element +M.Image = M.Inline:create_constructor( "Image", - function(capt, src, tit, attr) return {c = {attr, capt, {src, tit}}} end + function(caption, src, title, attributes) + title = title or "" + attributes = attributes or Attribute.empty + return {c = {attributes, caption, {src, title}}} + end ) + --- Create a LineBreak inline element --- @function Inline.LineBreak -Inline.LineBreak = Inline:create_constructor( +-- @function LineBreak +-- @treturn Inline linebreak element +M.LineBreak = M.Inline:create_constructor( "LineBreak", function() return {} end ) ---- Create a Link inline element --- @function Inline.Link -Inline.Link = Inline:create_constructor( + +--- Creates a link inline element, usually a hyperlink. +-- @function Link +-- @tparam {Inline,..} content text for this link +-- @tparam string target the link target +-- @tparam[opt] string title brief link description +-- @tparam[opt] Attributes attributes additional attributes +-- @treturn Inline image element +M.Link = M.Inline:create_constructor( "Link", - function(txt, src, tit, attr) return {c = {attr, txt, {src, tit}}} end + function(content, target, title, attributes) + title = title or "" + attributes = attributes or Attribute.empty + return {c = {attributes, content, {target, title}}} + end ) ---- Create a Math inline element --- @function Inline.Math -Inline.Math = Inline:create_constructor( + +--- Creates a Math inline element +-- @function Math +-- @tparam InlineMath|DisplayMath mathtype Display specifier +-- @tparam string text Math content +-- @treturn Inline Math element +M.Math = M.Inline:create_constructor( "Math", - function(m, str) return {c = {m, str}} end + function(mathtype, text) + return {c = {mathtype, text}} + end ) ---- Create a Note inline element --- @function Inline.Note -Inline.Note = Inline:create_constructor( + +--- Creates a Note inline element +-- @function Note +-- @tparam {Block,...} content footnote block content +M.Note = M.Inline:create_constructor( "Note", function(contents) return {c = contents} end ) ---- Create a Quoted inline element --- @function Inline.Quoted -Inline.Quoted = Inline:create_constructor( + +--- Creates a Quoted inline element +-- @function Quoted +-- @tparam DoubleQuote|SingleQuote quotetype type of quotes to be used +-- @tparam {Inline,..} content inline content +-- @treturn Inline quoted element +M.Quoted = M.Inline:create_constructor( "Quoted", - function(qt, lst) return {c = {qt, lst}} end + function(quotetype, content) return {c = {quotetype, content}} end ) ---- Create a RawInline inline element --- @function Inline.RawInline -Inline.RawInline = Inline:create_constructor( +--- Creates a RawInline inline element +-- @function RawInline +-- @tparam string format format of the contents +-- @tparam string text string content +-- @treturn Inline raw inline element +M.RawInline = M.Inline:create_constructor( "RawInline", - function(f, xs) return {c = {f, xs}} end + function(format, text) return {c = {format, text}} end ) ---- Create a SmallCaps inline element --- @function Inline.SmallCaps -Inline.SmallCaps = Inline:create_constructor( + +--- Creates text rendered in small caps +-- @function SmallCaps +-- @tparam {Inline,..} content inline content +-- @treturn Inline smallcaps element +M.SmallCaps = M.Inline:create_constructor( "SmallCaps", - function(xs) return {c = xs} end + function(content) return {c = content} end ) ---- Create a SoftBreak inline element --- @function Inline.SoftBreak -Inline.SoftBreak = Inline:create_constructor( + +--- Creates a SoftBreak inline element. +-- @function SoftBreak +-- @treturn Inline softbreak element +M.SoftBreak = M.Inline:create_constructor( "SoftBreak", function() return {} end ) + --- Create a Space inline element --- @function Inline.Space -Inline.Space = Inline:create_constructor( +-- @function Space +-- @treturn Inline space element +M.Space = M.Inline:create_constructor( "Space", function() return {} end ) ---- Create a Span inline element --- @function Inline.Span -Inline.Span = Inline:create_constructor( + +--- Creates a Span inline element +-- @function Span +-- @tparam {Inline,..} content inline content +-- @tparam[opt] Attributes attributes additional attributes +-- @treturn Inline span element +M.Span = M.Inline:create_constructor( "Span", - function(ls, attr) return {c = {attr, xs}} end + function(content, attributes) return {c = {attributes, content}} end ) ---- Create a Str inline element --- @function Inline.Str -Inline.Str = Inline:create_constructor( + +--- Creates a Str inline element +-- @function Str +-- @tparam string text content +-- @treturn Inline string element +M.Str = M.Inline:create_constructor( "Str", - function(str) return {c = str} end + function(text) return {c = text} end ) ---- Create a Strikeout inline element --- @function Inline.Strikeout -Inline.Strikeout = Inline:create_constructor( + +--- Creates text which is striked out. +-- @function Strikeout +-- @tparam {Inline,..} content inline content +-- @treturn Inline strikeout element +M.Strikeout = M.Inline:create_constructor( "Strikeout", - function(xs) return {c = xs} end + function(content) return {c = content} end ) ---- Create a Strong inline element --- @function Inline.Strong -Inline.Strong = Inline:create_constructor( + +--- Creates a Strong element, whose text is usually displayed in a bold font. +-- @function Strong +-- @tparam {Inline,..} content inline content +-- @treturn Inline strong element +M.Strong = M.Inline:create_constructor( "Strong", - function(xs) return {c = xs} end + function(content) return {c = content} end ) ---- Create a Subscript inline element --- @function Inline.Subscript -Inline.Subscript = Inline:create_constructor( + +--- Creates a Subscript inline element +-- @function Subscript +-- @tparam {Inline,..} content inline content +-- @treturn Inline subscript element +M.Subscript = M.Inline:create_constructor( "Subscript", - function(xs) return {c = xs} end + function(content) return {c = content} end ) ---- Create a Superscript inline element --- @function Inline.Superscript -Inline.Superscript = Inline:create_constructor( + +--- Creates a Superscript inline element +-- @function Superscript +-- @tparam {Inline,..} content inline content +-- @treturn Inline strong element +M.Superscript = M.Inline:create_constructor( "Superscript", - function(xs) return {c = xs} end + function(content) return {c = content} end ) -M.block_types = { - "BlockQuote", - "BulletList", - "CodeBlock", - "DefinitionList", - "Div", - "Header", - "HorizontalRule", - "HorizontalRule", - "LineBlock", - "Null", - "OrderedList", - "Para", - "Plain", - "RawBlock", - "Table", -} -M.inline_types = { - "Cite", - "Code", - "Emph", - "Image", - "LineBreak", - "Link", - "Math", - "Note", - "Quoted", - "RawInline", - "SmallCaps", - "SoftBreak", - "Space", - "Span", - "Str", - "Strikeout", - "Strong", - "Subscript", - "Superscript" +------------------------------------------------------------------------ +-- 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_types) do +for block_type, _ in pairs(M.Block.constructors) do M[block_type] = function(...) - return Block:new(block_type, ...) + return M.Block:new(block_type, ...) end end -for _, inline_type in pairs(M.inline_types) do - M[inline_type] = Inline[inline_type] -end ---- Arrays to provide fast lookup of element types -local set_of_inline_types = {} -local set_of_block_types = {} +------------------------------------------------------------------------ +-- Constants +-- @section constants -for i = 1, #M.inline_types do - set_of_inline_types[M.inline_types[i]] = true -end -for i = 1, #M.block_types do - set_of_block_types[M.block_types[i]] = true -end +--- Math content is to be displayed on a separate line. +-- @see Math +M.DisplayMath = {} +M.DisplayMath.t = "DisplayMath" +--- Math content is to be displayed inline within the paragraph +-- @see Math +M.InlineMath = {} +M.InlineMath.t = "InlineMath" + +--- Double quoted content. +-- @see Quoted +M.DoubleQuote = {} +M.DoubleQuote.t = "DoubleQuote" +--- Single quoted content. +-- @see Quoted +M.SingleQuote = {} +M.SingleQuote.t = "SingleQuote" + +--- Author name is mentioned in the text. +-- @see Citation +-- @see Cite +M.AuthorInText = {} +M.AuthorInText.t = "AuthorInText" + +--- Author name is suppressed. +-- @see Citation +-- @see Cite +M.SuppressAuthor = {} +M.SuppressAuthor.t = "SuppressAuthor" + +--- Default citation style is used. +-- @see Citation +-- @see Cite +M.NormalCitation = {} +M.NormalCitation.t = "NormalCitation" + + +------------------------------------------------------------------------ +-- Helper Functions +-- @section helpers + +--- Use functions defined in the global namespace to create a pandoc filter. +-- All globally defined functions which have names of pandoc elements are +-- collected into a new table. +-- @return A list of filter functions +-- @usage +-- -- within a file defining a pandoc filter: +-- function Str(text) +-- return pandoc.Str(utf8.upper(text)) +-- end +-- +-- return {pandoc.global_filter()} +-- -- the above is equivallent to +-- -- return {{Str = Str}} function M.global_filter() local res = {} for k, v in pairs(_G) do - if set_of_inline_types[k] or set_of_block_types[k] or k == "Doc" then + if M.Inline.constructor[k] or M.Block.constructors[k] or k == "Doc" then res[k] = v end end return res end -M["Doc"] = Doc -M["Inline"] = Inline -M["Block"] = Block - return M -- cgit v1.2.3 From 425df8fff435c105590986e1b85efbcca8986931 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Thu, 13 Apr 2017 22:57:50 +0200 Subject: Use lua constructors to push meta values --- data/pandoc.lua | 42 ++++++++ src/Text/Pandoc/Lua.hs | 4 +- src/Text/Pandoc/Lua/StackInstances.hs | 178 ++++++++++++++++++++++++++++------ test/Tests/Lua.hs | 8 +- 4 files changed, 198 insertions(+), 34 deletions(-) (limited to 'data/pandoc.lua') diff --git a/data/pandoc.lua b/data/pandoc.lua index 8d4d89bcd..6e434d1e7 100644 --- a/data/pandoc.lua +++ b/data/pandoc.lua @@ -163,6 +163,48 @@ function M.Doc(blocks, meta) end +------------------------------------------------------------------------ +-- MetaValue +-- @section MetaValue +M.MetaValue = Element:make_subtype{} +M.MetaValue.__call = function(t, ...) + return t:new(...) +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 +M.meta_value_types = { + "MetaBlocks", + "MetaBool", + "MetaInlines", + "MetaList", + "MetaMap", + "MetaString" +} +for i = 1, #M.meta_value_types do + M[M.meta_value_types[i]] = M.MetaValue:create_constructor( + M.meta_value_types[i], + function(content) + return {c = content} + end + ) +end + --- Inline element class -- @type Inline M.Inline = Element:make_subtype{} diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs index ccd820682..95bc1ef35 100644 --- a/src/Text/Pandoc/Lua.hs +++ b/src/Text/Pandoc/Lua.hs @@ -29,7 +29,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Pandoc lua utils. -} -module Text.Pandoc.Lua ( runLuaFilter ) where +module Text.Pandoc.Lua ( runLuaFilter, pushPandocModule ) where import Control.Monad ( (>=>), when ) import Control.Monad.Trans ( MonadIO(..) ) @@ -39,7 +39,7 @@ import Data.Text.Encoding ( decodeUtf8 ) import Scripting.Lua ( LuaState, StackValue(..) ) import Scripting.Lua.Aeson ( newstate ) import Text.Pandoc.Definition ( Block(..), Inline(..), Pandoc(..) ) -import Text.Pandoc.Lua.PandocModule +import Text.Pandoc.Lua.PandocModule ( pushPandocModule ) import Text.Pandoc.Lua.StackInstances () import Text.Pandoc.Walk diff --git a/src/Text/Pandoc/Lua/StackInstances.hs b/src/Text/Pandoc/Lua/StackInstances.hs index 690557788..5387f94e5 100644 --- a/src/Text/Pandoc/Lua/StackInstances.hs +++ b/src/Text/Pandoc/Lua/StackInstances.hs @@ -35,16 +35,19 @@ 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(..) - , gettable, newtable, pop, rawgeti, rawset, rawseti, settable + , call, getglobal2, gettable, ltype, newtable, next, objlen + , pop, pushnil, rawgeti, rawset, rawseti, settable ) import Scripting.Lua.Aeson () import Text.Pandoc.Definition - ( Block(..), Inline(..), Meta(..), Pandoc(..) + ( 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 @@ -55,8 +58,8 @@ maybeFromJson mv = fromJSON <$> mv >>= \case instance StackValue Pandoc where push lua (Pandoc meta blocks) = do newtable lua - setField lua (-1) "blocks" blocks - setField lua (-1) "meta" meta + addKeyValue lua "blocks" blocks + addKeyValue lua "meta" meta peek lua idx = do blocks <- getField lua idx "blocks" meta <- getField lua idx "meta" @@ -64,10 +67,58 @@ instance StackValue Pandoc where valuetype _ = TTABLE instance StackValue Meta where - push lua = push lua . toJSON - peek lua = fmap maybeFromJson . peek lua + push lua (Meta mmap) = push lua mmap + peek lua idx = fmap Meta <$> peek lua idx valuetype _ = TTABLE +instance StackValue MetaValue where + push lua = \case + MetaBlocks blcks -> pushViaConstructor lua "MetaBlocks" blcks + MetaBool b -> pushViaConstructor lua "MetaBool" b + MetaInlines inlns -> pushViaConstructor lua "MetaInlines" inlns + MetaList metalist -> pushViaConstructor lua "MetaList" metalist + MetaMap metamap -> pushViaConstructor lua "MetaMap" metamap + MetaString cs -> pushViaConstructor lua "MetaString" cs + peek lua idx = do + luatype <- ltype lua idx + case luatype of + TBOOLEAN -> fmap MetaBool <$> peek lua idx + TSTRING -> fmap MetaString <$> peek lua idx + TTABLE -> do + tag <- push lua "t" + *> gettable lua (idx `adjustIndexBy` 1) + *> peek lua (-1) + <* pop lua 1 + case tag of + Just "MetaBlocks" -> fmap MetaBlocks <$> peekContent lua idx + Just "MetaBool" -> fmap MetaBool <$> peekContent lua idx + Just "MetaMap" -> fmap MetaMap <$> peekContent lua idx + Just "MetaInlines" -> fmap MetaInlines <$> peekContent lua idx + Just "MetaList" -> fmap MetaList <$> peekContent lua idx + Just "MetaString" -> fmap MetaString <$> peekContent lua idx + Nothing -> do + len <- objlen lua idx + if len <= 0 + then fmap MetaMap <$> peek lua idx + else (fmap MetaInlines <$> peek lua idx) + <|> (fmap MetaBlocks <$> peek lua idx) + <|> (fmap MetaList <$> peek lua idx) + _ -> return Nothing + _ -> return Nothing + valuetype = \case + MetaBlocks _ -> TTABLE + MetaBool _ -> TBOOLEAN + MetaInlines _ -> TTABLE + MetaList _ -> TTABLE + MetaMap _ -> TTABLE + MetaString _ -> TSTRING + +peekContent :: StackValue a => LuaState -> Int -> IO (Maybe a) +peekContent lua idx = do + push lua "c" + gettable lua (idx `adjustIndexBy` 1) + peek lua (-1) <* pop lua 1 + instance StackValue Block where push lua = \case BlockQuote blcks -> pushTagged lua "BlockQuote" blcks @@ -77,6 +128,7 @@ instance StackValue Block where Null -> pushTagged' lua "Null" Para blcks -> pushTagged lua "Para" blcks Plain blcks -> pushTagged lua "Plain" blcks + RawBlock f cs -> pushTagged lua "RawBlock" (f, cs) -- fall back to conversion via aeson's Value x -> push lua (toJSON x) peek lua i = peekBlock lua i @@ -109,12 +161,12 @@ instance StackValue Inline where instance StackValue Citation where push lua c = do newtable lua - setField lua (-1) "citationId" (citationId c) - setField lua (-1) "citationPrefix" (citationPrefix c) - setField lua (-1) "citationSuffix" (citationSuffix c) - setField lua (-1) "citationMode" (citationMode c) - setField lua (-1) "citationNoteNum" (citationNoteNum c) - setField lua (-1) "citationHash" (citationHash c) + addKeyValue lua "citationId" (citationId c) + addKeyValue lua "citationPrefix" (citationPrefix c) + addKeyValue lua "citationSuffix" (citationSuffix c) + addKeyValue lua "citationMode" (citationMode c) + addKeyValue lua "citationNoteNum" (citationNoteNum c) + addKeyValue lua "citationHash" (citationHash c) peek lua idx = do id' <- getField lua idx "citationId" prefix <- getField lua idx "citationPrefix" @@ -186,11 +238,11 @@ instance StackValue [Char] where instance (StackValue a, StackValue b) => StackValue (a, b) where push lua (a, b) = do newtable lua - setIntField lua (-1) 1 a - setIntField lua (-1) 2 b + addIndexedValue lua 1 a + addIndexedValue lua 2 b peek lua idx = do - a <- getIntField lua idx 1 - b <- getIntField lua idx 2 + a <- getIndexedValue lua idx 1 + b <- getIndexedValue lua idx 2 return $ (,) <$> a <*> b valuetype _ = TTABLE @@ -199,24 +251,82 @@ instance (StackValue a, StackValue b, StackValue c) => where push lua (a, b, c) = do newtable lua - setIntField lua (-1) 1 a - setIntField lua (-1) 2 b - setIntField lua (-1) 3 c + addIndexedValue lua 1 a + addIndexedValue lua 2 b + addIndexedValue lua 3 c peek lua idx = do - a <- getIntField lua idx 1 - b <- getIntField lua idx 2 - c <- getIntField lua idx 3 + a <- getIndexedValue lua idx 1 + b <- getIndexedValue lua idx 2 + c <- getIndexedValue lua idx 3 return $ (,,) <$> a <*> b <*> c valuetype _ = TTABLE +instance (Ord a, StackValue a, StackValue b) => + StackValue (M.Map a b) where + push lua m = do + newtable lua + mapM_ (uncurry $ addKeyValue lua) $ M.toList m + peek lua idx = fmap M.fromList <$> keyValuePairs lua idx + valuetype _ = TTABLE + +-- | Try reading the value under the given index as a list of key-value pairs. +keyValuePairs :: (StackValue a, StackValue b) + => LuaState -> Int -> IO (Maybe [(a, b)]) +keyValuePairs lua idx = do + pushnil lua + sequence <$> remainingPairs + where + remainingPairs = do + res <- nextPair + case res of + Nothing -> return [] + Just a -> (a:) <$> remainingPairs + nextPair :: (StackValue a, StackValue b) => IO (Maybe (Maybe (a,b))) + nextPair = do + hasNext <- next lua (idx `adjustIndexBy` 1) + if hasNext + then do + val <- peek lua (-1) + key <- peek lua (-2) + pop lua 1 -- removes the value, keeps the key + return $ Just <$> ((,) <$> key <*> val) + else do + return Nothing + + +-- | Helper class for pushing a single value to the stack via a lua function. +-- See @pushViaCall@. +class PushViaCall a where + pushViaCall' :: LuaState -> String -> IO () -> Int -> a + +instance PushViaCall (IO ()) where + pushViaCall' lua fn pushArgs num = do + getglobal2 lua fn + pushArgs + call lua num 1 + +instance (StackValue a, PushViaCall b) => PushViaCall (a -> b) where + pushViaCall' lua fn pushArgs num x = + pushViaCall' lua fn (pushArgs *> push lua 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 :: PushViaCall a => LuaState -> String -> a +pushViaCall lua fn = pushViaCall' lua fn (return ()) 0 + +-- | Call a pandoc element constructor within lua, passing all given arguments. +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 - setField lua (-1) "t" tag - setField lua (-1) "c" value + addKeyValue lua "t" tag + addKeyValue lua "c" value pushTagged' :: LuaState -> String -> IO () pushTagged' lua tag = do @@ -296,21 +406,29 @@ getField lua idx key = do peek lua (-1) <* pop lua 1 -- | Set value for key for table at the given index -setField :: (StackValue a, StackValue b) => LuaState -> Int -> a -> b -> IO () -setField lua idx key value = do +setKeyValue :: (StackValue a, StackValue b) => LuaState -> Int -> a -> b -> IO () +setKeyValue lua idx key value = do push lua key push lua value settable lua (idx `adjustIndexBy` 2) +-- | Add a key-value pair to the table at the top of the stack +addKeyValue :: (StackValue a, StackValue b) => LuaState -> a -> b -> IO () +addKeyValue lua = setKeyValue lua (-1) + -- | Get value behind key from table at given index. -getIntField :: StackValue a => LuaState -> Int -> Int -> IO (Maybe a) -getIntField lua idx key = +getIndexedValue :: StackValue a => LuaState -> Int -> Int -> IO (Maybe a) +getIndexedValue lua idx key = rawgeti lua idx key *> peek lua (-1) <* pop lua 1 -- | Set numeric key/value in table at the given index -setIntField :: StackValue a => LuaState -> Int -> Int -> a -> IO () -setIntField lua idx key value = do +setIndexedValue :: StackValue a => LuaState -> Int -> Int -> a -> IO () +setIndexedValue lua idx key value = do push lua value rawseti lua (idx `adjustIndexBy` 1) key + +-- | Set numeric key/value in table at the top of the stack. +addIndexedValue :: StackValue a => LuaState -> Int -> a -> IO () +addIndexedValue lua = setIndexedValue lua (-1) diff --git a/test/Tests/Lua.hs b/test/Tests/Lua.hs index 64c35b298..4196ff4b7 100644 --- a/test/Tests/Lua.hs +++ b/test/Tests/Lua.hs @@ -64,10 +64,14 @@ roundtripEqual x = (x ==) <$> roundtripped roundtripped :: (Lua.StackValue a) => IO a roundtripped = do lua <- Lua.newstate + Lua.openlibs lua + pushPandocModule lua + Lua.setglobal lua "pandoc" + oldSize <- Lua.gettop lua Lua.push lua x size <- Lua.gettop lua - when (size /= 1) $ - error ("not exactly one element on the stack: " ++ show size) + when ((size - oldSize) /= 1) $ + error ("not exactly one additional element on the stack: " ++ show size) res <- Lua.peek lua (-1) retval <- case res of Nothing -> error "could not read from stack" -- cgit v1.2.3 From 540a3e80ad33cb43d23532515757dff7ee68a17f Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Fri, 14 Apr 2017 10:33:38 +0200 Subject: Push blocks via lua constructors and constants All element creation tasks are handled by lua functions defined in the pandoc module. --- data/pandoc.lua | 275 +++++++++++++++++++++++++++++----- src/Text/Pandoc/Lua/StackInstances.hs | 139 ++++++++++++----- 2 files changed, 336 insertions(+), 78 deletions(-) (limited to 'data/pandoc.lua') diff --git a/data/pandoc.lua b/data/pandoc.lua index 6e434d1e7..eab565ca8 100644 --- a/data/pandoc.lua +++ b/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 -M.Inline = Element:make_subtype{} -M.Inline.__call = function (t, ...) +------------------------------------------------------------------------ +-- Block +-- @section Block + +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 diff --git a/src/Text/Pandoc/Lua/StackInstances.hs b/src/Text/Pandoc/Lua/StackInstances.hs index 6f89bbee1..bafe24201 100644 --- a/src/Text/Pandoc/Lua/StackInstances.hs +++ b/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 - BulletList items -> pushTagged lua "BulletList" items - HorizontalRule -> pushTagged' lua "HorizontalRule" - LineBlock blcks -> pushTagged lua "LineBlock" blcks - Null -> pushTagged' lua "Null" - Para blcks -> pushTagged lua "Para" blcks - Plain blcks -> pushTagged lua "Plain" blcks - RawBlock f cs -> pushTagged lua "RawBlock" (f, cs) + BlockQuote blcks -> pushViaConstructor lua "BlockQuote" blcks + BulletList items -> pushViaConstructor lua "BulletList" items + CodeBlock attr code -> pushViaConstructor lua "CodeBlock" code attr + DefinitionList items -> pushViaConstructor lua "DefinitionList" items + Div attr blcks -> pushViaConstructor lua "Div" blcks attr + Header lvl attr inlns -> pushViaConstructor lua "Header" lvl attr inlns + HorizontalRule -> pushViaConstructor lua "HorizontalRule" + 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 - _ -> maybeFromJson <$> peek lua idx + "RawBlock" -> fmap (uncurry RawBlock) <$> elementContent + "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) -- cgit v1.2.3