aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--data/pandoc.lua638
-rw-r--r--pandoc.cabal1
-rw-r--r--src/Text/Pandoc/Lua.hs162
-rw-r--r--src/Text/Pandoc/Lua/StackInstances.hs364
-rw-r--r--stack.full.yaml1
-rw-r--r--stack.pkg.yaml1
-rw-r--r--stack.yaml1
-rw-r--r--test/Tests/Lua.hs8
-rw-r--r--test/lua/markdown-reader.lua3
-rw-r--r--test/lua/plain-to-para.lua4
-rw-r--r--test/lua/strmacro.lua9
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,
}
}