diff options
| -rw-r--r-- | data/pandoc.lua | 638 | ||||
| -rw-r--r-- | pandoc.cabal | 1 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua.hs | 162 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/StackInstances.hs | 364 | ||||
| -rw-r--r-- | stack.full.yaml | 1 | ||||
| -rw-r--r-- | stack.pkg.yaml | 1 | ||||
| -rw-r--r-- | stack.yaml | 1 | ||||
| -rw-r--r-- | test/Tests/Lua.hs | 8 | ||||
| -rw-r--r-- | test/lua/markdown-reader.lua | 3 | ||||
| -rw-r--r-- | test/lua/plain-to-para.lua | 4 | ||||
| -rw-r--r-- | test/lua/strmacro.lua | 9 |
11 files changed, 978 insertions, 214 deletions
diff --git a/data/pandoc.lua b/data/pandoc.lua index d705b8566..eab565ca8 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,25 +16,87 @@ 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 + +------------------------------------------------------------------------ +-- 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) self.__index = self return o end + --- Create a new element given its tag and arguments +-- @local function Element:new(tag, ...) local element = { t = tag } local content = {...} @@ -51,7 +113,48 @@ function Element:new(tag, ...) return element end -local function Doc(blocks, meta) +--- 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 +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 + 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 + +------------------------------------------------------------------------ +--- 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, @@ -59,82 +162,545 @@ local function Doc(blocks, meta) } end -local Inline = Element:make_subtype{} -local Block = Element:make_subtype{} -M.block_types = { +------------------------------------------------------------------------ +-- 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 + +------------------------------------------------------------------------ +-- 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", - "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 -M.inline_types = { +--- 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 +-- @tparam {Citation,...} citations List of citations +-- @treturn Inline citations element +M.Cite = M.Inline:create_constructor( "Cite", + function(content, citations) return {c = {citations, content}} end +) + +--- 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, attributes) return {c = {attributes, code}} end +) + +--- 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(content) return {c = content} end +) + +--- 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(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 LineBreak +-- @treturn Inline linebreak element +M.LineBreak = M.Inline:create_constructor( "LineBreak", + function() return {} end +) + +--- 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(content, target, title, attributes) + title = title or "" + attributes = attributes or Attribute.empty + return {c = {attributes, content, {target, title}}} + end +) + +--- 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(mathtype, text) + return {c = {mathtype, text}} + end +) + +--- 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 +) + +--- 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(quotetype, content) return {c = {quotetype, content}} end +) +--- 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(format, text) return {c = {format, text}} end +) + +--- 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(content) return {c = content} end +) + +--- 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 Space +-- @treturn Inline space element +M.Space = M.Inline:create_constructor( "Space", + function() return {} end +) + +--- 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(content, attributes) return {c = {attributes, content}} end +) + +--- Creates a Str inline element +-- @function Str +-- @tparam string text content +-- @treturn Inline string element +M.Str = M.Inline:create_constructor( "Str", + function(text) return {c = text} end +) + +--- 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(content) return {c = content} end +) + +--- 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(content) return {c = content} end +) + +--- Creates a Subscript inline element +-- @function Subscript +-- @tparam {Inline,..} content inline content +-- @treturn Inline subscript element +M.Subscript = M.Inline:create_constructor( "Subscript", - "Superscript" -} + function(content) return {c = content} end +) -for _, block_type in pairs(M.block_types) do - M[block_type] = function(...) - return Block:new(block_type, ...) - end -end +--- Creates a Superscript inline element +-- @function Superscript +-- @tparam {Inline,..} content inline content +-- @treturn Inline strong element +M.Superscript = M.Inline:create_constructor( + "Superscript", + function(content) return {c = content} end +) -for _, inline_type in pairs(M.inline_types) do - M[inline_type] = function(...) - return Inline:new(inline_type, ...) - end -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" + +--- 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 +-- @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.constructor[k] or M.Block.constructors[k] or k == "Doc" then res[k] = v end end return res end -M["Doc"] = Doc - return M diff --git a/pandoc.cabal b/pandoc.cabal index ef3f8fd04..27ccdb15b 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -300,7 +300,6 @@ Library pandoc-types >= 1.17 && < 1.18, aeson >= 0.7 && < 1.2, aeson-pretty >= 0.8 && < 0.9, - hslua-aeson >= 0.1.0.2 && < 1, tagsoup >= 0.13.7 && < 0.15, base64-bytestring >= 0.1 && < 1.1, zlib >= 0.5 && < 0.7, diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs index d7c54b6af..9903d4df6 100644 --- a/src/Text/Pandoc/Lua.hs +++ b/src/Text/Pandoc/Lua.hs @@ -15,6 +15,9 @@ You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.Lua @@ -26,27 +29,24 @@ 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(..) ) -import Data.HashMap.Lazy ( HashMap ) -import Data.Text ( Text, pack, unpack ) -import Data.Text.Encoding ( decodeUtf8 ) +import Data.Map ( Map ) 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 -import qualified Data.HashMap.Lazy as HashMap +import qualified Data.Map as Map import qualified Scripting.Lua as Lua runLuaFilter :: (MonadIO m) => FilePath -> [String] -> Pandoc -> m Pandoc runLuaFilter filterPath args pd = liftIO $ do - lua <- newstate + lua <- Lua.newstate Lua.openlibs lua -- create table in registry to store filter functions Lua.push lua ("PANDOC_FILTER_FUNCTIONS"::String) @@ -58,12 +58,12 @@ runLuaFilter filterPath args pd = liftIO $ do status <- Lua.loadfile lua filterPath if (status /= 0) then do - luaErrMsg <- unpack . decodeUtf8 <$> Lua.tostring lua 1 + Just luaErrMsg <- Lua.peek lua 1 error luaErrMsg else do Lua.call lua 0 1 Just luaFilters <- Lua.peek lua (-1) - Lua.push lua (map pack args) + Lua.push lua args Lua.setglobal lua "PandocParameters" doc <- runAll luaFilters >=> luaFilter lua "filter_doc" $ pd Lua.close lua @@ -86,73 +86,85 @@ walkMWithLuaFilter (LuaFilter lua inlineFnMap blockFnMap docFnMap) = walkM (execBlockLuaFilter lua blockFnMap) >=> walkM (execDocLuaFilter lua docFnMap) -type InlineFunctionMap = HashMap Text (LuaFilterFunction Inline) -type BlockFunctionMap = HashMap Text (LuaFilterFunction Block) -type DocFunctionMap = HashMap Text (LuaFilterFunction Pandoc) +type InlineFunctionMap = Map String (LuaFilterFunction Inline) +type BlockFunctionMap = Map String (LuaFilterFunction Block) +type DocFunctionMap = Map String (LuaFilterFunction Pandoc) data LuaFilter = LuaFilter LuaState InlineFunctionMap BlockFunctionMap DocFunctionMap newtype LuaFilterFunction a = LuaFilterFunction { functionIndex :: Int } execDocLuaFilter :: LuaState - -> HashMap Text (LuaFilterFunction Pandoc) + -> Map String (LuaFilterFunction Pandoc) -> Pandoc -> IO Pandoc execDocLuaFilter lua fnMap x = do let docFnName = "Doc" - case HashMap.lookup docFnName fnMap of + case Map.lookup docFnName fnMap of Nothing -> return x Just fn -> runLuaFilterFunction lua fn x execBlockLuaFilter :: LuaState - -> HashMap Text (LuaFilterFunction Block) + -> Map String (LuaFilterFunction Block) -> Block -> IO Block execBlockLuaFilter lua fnMap x = do - let filterOrId constr = case HashMap.lookup constr fnMap of - Nothing -> return x - Just fn -> runLuaFilterFunction lua fn x + let runFn :: PushViaFilterFunction Block a => LuaFilterFunction Block -> a + runFn fn = runLuaFilterFunction lua fn + let tryFilter :: String -> (LuaFilterFunction Block -> IO Block) -> IO Block + tryFilter fnName callFilterFn = + case Map.lookup fnName fnMap of + Nothing -> return x + Just fn -> callFilterFn fn case x of - Plain _ -> filterOrId "Plain" - Para _ -> filterOrId "Para" - LineBlock _ -> filterOrId "LineBlock" - CodeBlock _ _ -> filterOrId "CodeBlock" - RawBlock _ _ -> filterOrId "RawBlock" - BlockQuote _ -> filterOrId "BlockQuote" - OrderedList _ _ -> filterOrId "OrderedList" - BulletList _ -> filterOrId "BulletList" - DefinitionList _ -> filterOrId "DefinitionList" - Header _ _ _ -> filterOrId "Header" - HorizontalRule -> filterOrId "HorizontalRule" - Table _ _ _ _ _ -> filterOrId "Table" - Div _ _ -> filterOrId "Div" - Null -> filterOrId "Null" + HorizontalRule -> tryFilter "HorizontalRule" runFn + Null -> tryFilter "Null" runFn + BlockQuote blcks -> tryFilter "BlockQuote" $ \fn -> runFn fn blcks + BulletList items -> tryFilter "BulletList" $ \fn -> runFn fn items + CodeBlock attr code -> tryFilter "CodeBlock" $ \fn -> runFn fn attr code + DefinitionList lst -> tryFilter "DefinitionList" $ \fn -> runFn fn lst + Div attr content -> tryFilter "Div" $ \fn -> runFn fn content attr + Header lvl attr inlns -> tryFilter "Header" $ \fn -> runFn fn lvl inlns attr + LineBlock inlns -> tryFilter "LineBlock" $ \fn -> runFn fn inlns + Para inlns -> tryFilter "Para" $ \fn -> runFn fn inlns + Plain inlns -> tryFilter "Plain" $ \fn -> runFn fn inlns + RawBlock format str -> tryFilter "RawBlock" $ \fn -> runFn fn format str + OrderedList (num,sty,delim) items -> + tryFilter "OrderedList" $ \fn -> runFn fn items (num,sty,delim) + Table capt aligns widths headers rows -> + tryFilter "Table" $ \fn -> runFn fn capt aligns widths headers rows execInlineLuaFilter :: LuaState - -> HashMap Text (LuaFilterFunction Inline) + -> Map String (LuaFilterFunction Inline) -> Inline -> IO Inline execInlineLuaFilter lua fnMap x = do - let filterOrId constr = case HashMap.lookup constr fnMap of - Nothing -> return x - Just fn -> runLuaFilterFunction lua fn x + let runFn :: PushViaFilterFunction Inline a => LuaFilterFunction Inline -> a + runFn fn = runLuaFilterFunction lua fn + let tryFilter :: String -> (LuaFilterFunction Inline -> IO Inline) -> IO Inline + tryFilter fnName callFilterFn = + case Map.lookup fnName fnMap of + Nothing -> return x + Just fn -> callFilterFn fn case x of - Cite _ _ -> filterOrId "Cite" - Code _ _ -> filterOrId "Code" - Emph _ -> filterOrId "Emph" - Image _ _ _ -> filterOrId "Image" - LineBreak -> filterOrId "LineBreak" - Link _ _ _ -> filterOrId "Link" - Math _ _ -> filterOrId "Math" - Note _ -> filterOrId "Note" - Quoted _ _ -> filterOrId "Quoted" - RawInline _ _ -> filterOrId "RawInline" - SmallCaps _ -> filterOrId "SmallCaps" - SoftBreak -> filterOrId "SoftBreak" - Space -> filterOrId "Space" - Span _ _ -> filterOrId "Span" - Str _ -> filterOrId "Str" - Strikeout _ -> filterOrId "Strikeout" - Strong _ -> filterOrId "Strong" - Subscript _ -> filterOrId "Subscript" - Superscript _ -> filterOrId "Superscript" + LineBreak -> tryFilter "LineBreak" runFn + SoftBreak -> tryFilter "SoftBreak" runFn + Space -> tryFilter "Space" runFn + Cite cs lst -> tryFilter "Cite" $ \fn -> runFn fn lst cs + Code attr str -> tryFilter "Code" $ \fn -> runFn fn str attr + Emph lst -> tryFilter "Emph" $ \fn -> runFn fn lst + Math mt lst -> tryFilter "Math" $ \fn -> runFn fn lst mt + Note blks -> tryFilter "Note" $ \fn -> runFn fn blks + Quoted qt lst -> tryFilter "Quoted" $ \fn -> runFn fn qt lst + RawInline f str -> tryFilter "RawInline" $ \fn -> runFn fn f str + SmallCaps lst -> tryFilter "SmallCaps" $ \fn -> runFn fn lst + Span attr lst -> tryFilter "Span" $ \fn -> runFn fn lst attr + Str str -> tryFilter "Str" $ \fn -> runFn fn str + Strikeout lst -> tryFilter "Strikeout" $ \fn -> runFn fn lst + Strong lst -> tryFilter "Strong" $ \fn -> runFn fn lst + Subscript lst -> tryFilter "Subscript" $ \fn -> runFn fn lst + Superscript lst -> tryFilter "Superscript" $ \fn -> runFn fn lst + Link attr txt (src, tit) -> tryFilter "Link" $ + \fn -> runFn fn txt src tit attr + Image attr alt (src, tit) -> tryFilter "Image" $ + \fn -> runFn fn alt src tit attr instance StackValue LuaFilter where valuetype _ = Lua.TTABLE @@ -164,17 +176,33 @@ instance StackValue LuaFilter where docFnMap <- Lua.peek lua i return $ LuaFilter lua <$> inlineFnMap <*> blockFnMap <*> docFnMap -runLuaFilterFunction :: (StackValue a) - => LuaState -> LuaFilterFunction a -> a -> IO a -runLuaFilterFunction lua lf inline = do - pushFilterFunction lua lf - Lua.push lua inline - Lua.call lua 1 1 - mbres <- Lua.peek lua (-1) - case mbres of - Nothing -> error $ "Error while trying to get a filter's return " - ++ "value from lua stack." - Just res -> res <$ Lua.pop lua 1 +-- | Helper class for pushing a single value to the stack via a lua function. +-- See @pushViaCall@. +class PushViaFilterFunction a b where + pushViaFilterFunction' :: LuaState -> LuaFilterFunction a -> IO () -> Int -> b + +instance (StackValue a) => PushViaFilterFunction a (IO a) where + pushViaFilterFunction' lua lf pushArgs num = do + pushFilterFunction lua lf + pushArgs + Lua.call lua num 1 + mbres <- Lua.peek lua (-1) + case mbres of + Nothing -> error $ "Error while trying to get a filter's return " + ++ "value from lua stack." + Just res -> res <$ Lua.pop lua 1 + +instance (PushViaFilterFunction a c, StackValue b) => + PushViaFilterFunction a (b -> c) where + pushViaFilterFunction' lua lf pushArgs num x = + pushViaFilterFunction' lua lf (pushArgs *> push lua x) (num + 1) + +-- | Push an value to the stack via a lua filter function. The function is +-- called with all arguments that are passed to this function and is expected to +-- return a single value. +runLuaFilterFunction :: (StackValue a, PushViaFilterFunction a b) + => LuaState -> LuaFilterFunction a -> b +runLuaFilterFunction lua lf = pushViaFilterFunction' lua lf (return ()) 0 -- | Push the filter function to the top of the stack. pushFilterFunction :: Lua.LuaState -> LuaFilterFunction a -> IO () diff --git a/src/Text/Pandoc/Lua/StackInstances.hs b/src/Text/Pandoc/Lua/StackInstances.hs index 690557788..38f392527 100644 --- a/src/Text/Pandoc/Lua/StackInstances.hs +++ b/src/Text/Pandoc/Lua/StackInstances.hs @@ -35,28 +35,22 @@ StackValue instances for pandoc types. -} module Text.Pandoc.Lua.StackInstances () where -import Data.Aeson ( FromJSON(..), ToJSON(..), Result(..), Value, fromJSON ) +import Control.Applicative ( (<|>) ) import Scripting.Lua ( LTYPE(..), LuaState, StackValue(..) - , gettable, newtable, pop, rawgeti, rawset, rawseti, settable + , call, getglobal2, gettable, ltype, newtable, next, objlen + , pop, pushnil, rawgeti, rawseti, settable ) -import Scripting.Lua.Aeson () import Text.Pandoc.Definition - ( Block(..), Inline(..), Meta(..), 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 - 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,57 +58,122 @@ 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 - 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 + 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 instance StackValue Inline where push lua = \case - Cite citations lst -> pushTagged lua "Cite" (citations, lst) - Code attr lst -> pushTagged lua "Code" (attr, lst) - Emph inlns -> pushTagged lua "Emph" inlns - Image attr lst tgt -> pushTagged lua "Image" (attr, lst, tgt) - LineBreak -> pushTagged' lua "LineBreak" - Link attr lst tgt -> pushTagged lua "Link" (attr, lst, tgt) - Note blcks -> pushTagged lua "Note" blcks - Math mty str -> pushTagged lua "Math" (mty, str) - Quoted qt inlns -> pushTagged lua "Quoted" (qt, inlns) - RawInline f cs -> pushTagged lua "RawInline" (f, cs) - SmallCaps inlns -> pushTagged lua "SmallCaps" inlns - SoftBreak -> pushTagged' lua "SoftBreak" - Space -> pushTagged' lua "Space" - Span attr inlns -> pushTagged lua "Span" (attr, inlns) - Str str -> pushTagged lua "Str" str - Strikeout inlns -> pushTagged lua "Strikeout" inlns - Strong inlns -> pushTagged lua "Strong" inlns - Subscript inlns -> pushTagged lua "Subscript" inlns - Superscript inlns -> pushTagged lua "Superscript" inlns + Cite citations lst -> pushViaConstructor lua "Cite" lst citations + Code attr lst -> pushViaConstructor lua "Code" lst attr + Emph inlns -> pushViaConstructor lua "Emph" inlns + Image attr alt (src,tit) -> pushViaConstructor lua "Image" alt src tit attr + LineBreak -> pushViaConstructor lua "LineBreak" + Link attr lst (src,tit) -> pushViaConstructor lua "Link" lst src tit attr + Note blcks -> pushViaConstructor lua "Note" blcks + Math mty str -> pushViaConstructor lua "Math" mty str + Quoted qt inlns -> pushViaConstructor lua "Quoted" qt inlns + RawInline f cs -> pushViaConstructor lua "RawInline" f cs + SmallCaps inlns -> pushViaConstructor lua "SmallCaps" inlns + SoftBreak -> pushViaConstructor lua "SoftBreak" + Space -> pushViaConstructor lua "Space" + Span attr inlns -> pushViaConstructor lua "Span" inlns attr + Str str -> pushViaConstructor lua "Str" str + Strikeout inlns -> pushViaConstructor lua "Strikeout" inlns + Strong inlns -> pushViaConstructor lua "Strong" inlns + Subscript inlns -> pushViaConstructor lua "Subscript" inlns + Superscript inlns -> pushViaConstructor lua "Superscript" inlns 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 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) + push lua (Citation cid prefix suffix mode noteNum hash) = + pushViaConstructor lua "Citation" cid mode prefix suffix noteNum hash peek lua idx = do id' <- getField lua idx "citationId" prefix <- getField lua idx "citationPrefix" @@ -122,20 +181,14 @@ instance StackValue Citation where mode <- getField lua idx "citationMode" num <- getField lua idx "citationNoteNum" hash <- getField lua idx "citationHash" - return $ Citation - <$> id' - <*> prefix - <*> suffix - <*> mode - <*> num - <*> hash + return $ Citation <$> id' <*> prefix <*> suffix <*> mode <*> num <*> hash valuetype _ = TTABLE instance StackValue CitationMode where push lua = \case - AuthorInText -> pushTagged' lua "AuthorInText" - NormalCitation -> pushTagged' lua "NormalCitation" - SuppressAuthor -> pushTagged' lua "SuppressAuthor" + AuthorInText -> getglobal2 lua "pandoc.AuthorInText" + NormalCitation -> getglobal2 lua "pandoc.NormalCitation" + SuppressAuthor -> getglobal2 lua "pandoc.SuppressAuthor" peek lua idx = do tag <- getField lua idx "t" case tag of @@ -143,17 +196,55 @@ 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 -> pushTagged' lua "InlineMath" - DisplayMath -> pushTagged' lua "DisplayMath" + InlineMath -> getglobal2 lua "pandoc.InlineMath" + DisplayMath -> getglobal2 lua "pandoc.DisplayMath" peek lua idx = do res <- getField lua idx "t" case res of @@ -164,8 +255,8 @@ instance StackValue MathType where instance StackValue QuoteType where push lua = \case - SingleQuote -> pushTagged' lua "SingleQuote" - DoubleQuote -> pushTagged' lua "DoubleQuote" + SingleQuote -> getglobal2 lua "pandoc.SingleQuote" + DoubleQuote -> getglobal2 lua "pandoc.DoubleQuote" peek lua idx = do res <- getField lua idx "t" case res of @@ -186,11 +277,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,31 +290,93 @@ 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 --- | 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 - -pushTagged' :: LuaState -> String -> IO () -pushTagged' lua tag = do - newtable lua - push lua "t" - push lua tag - rawset lua (-3) +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 + 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) -- | Return the value at the given index as inline if possible. peekInline :: LuaState -> Int -> IO (Maybe Inline) @@ -268,13 +421,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) @@ -296,21 +458,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/stack.full.yaml b/stack.full.yaml index bf1d1581d..ac06d7f18 100644 --- a/stack.full.yaml +++ b/stack.full.yaml @@ -24,5 +24,4 @@ extra-deps: - doctemplates-0.1.0.2 - skylighting-0.3.1 - hslua-0.5.0 -- hslua-aeson-0.1.0.3 resolver: lts-8.4 diff --git a/stack.pkg.yaml b/stack.pkg.yaml index a240a99b9..ad9490c82 100644 --- a/stack.pkg.yaml +++ b/stack.pkg.yaml @@ -19,6 +19,5 @@ packages: extra-dep: false extra-deps: - hslua-0.5.0 -- hslua-aeson-0.1.0.3 - skylighting-0.3.2 resolver: lts-8.8 diff --git a/stack.yaml b/stack.yaml index 965650226..a77d0c7a8 100644 --- a/stack.yaml +++ b/stack.yaml @@ -9,7 +9,6 @@ packages: - '.' extra-deps: - hslua-0.5.0 -- hslua-aeson-0.1.0.3 - skylighting-0.3.2 - foundation-0.0.6 resolver: lts-8.8 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" diff --git a/test/lua/markdown-reader.lua b/test/lua/markdown-reader.lua index 6356113ec..a72af5546 100644 --- a/test/lua/markdown-reader.lua +++ b/test/lua/markdown-reader.lua @@ -1,7 +1,6 @@ return { { - RawBlock = function (blk) - local format, content = unpack(blk.c) + RawBlock = function (format, content) if format == "markdown" then return pandoc.reader.markdown.read_block(content) else diff --git a/test/lua/plain-to-para.lua b/test/lua/plain-to-para.lua index 747257411..a11edbbe2 100644 --- a/test/lua/plain-to-para.lua +++ b/test/lua/plain-to-para.lua @@ -1,6 +1,6 @@ return { - { Plain = function (blk) - return pandoc.Para(blk.c) + { Plain = function (content) + return pandoc.Para(content) end, } } diff --git a/test/lua/strmacro.lua b/test/lua/strmacro.lua index 1b28801be..40756a476 100644 --- a/test/lua/strmacro.lua +++ b/test/lua/strmacro.lua @@ -1,10 +1,11 @@ return { - { Str = function (inline) - if inline.c == "{{helloworld}}" then + { + Str = function (str) + if str == "{{helloworld}}" then return pandoc.Emph {pandoc.Str "Hello, World"} else - return inline + return pandoc.Str(str) end - end, + end, } } |