git.iko.soy/typeable/pandoc
on master help sign in
Merge pull request #3569 from tarleb/lua-destructured-filter-functions

Destructuring lua filter functions

commit932e395e535e10e7fdbfadd5617b7427a2141343 authorAlbert Krewinkel <albert+github@zeitkraut.de> dateFri 14 Apr 2017, 11:57 (10 years ago) parent624ccbd07f41a5
11 files changed+978−214
data/pandoc.lua+602−36 pandoc.cabal−1 src/Text/Pandoc/Lua.hs+95−67 src/Text/Pandoc/Lua/StackInstances.hs+267−97 stack.full.yaml−1 stack.pkg.yaml−1 stack.yaml−1 test/Tests/Lua.hs+6−2 test/lua/markdown-reader.lua+1−2 test/lua/plain-to-para.lua+2−2 test/lua/strmacro.lua+5−4
data/pandoc.lua+602−36
@@ -1,7 +1,7 @@
11--[[
22pandoc.lua
33
4−Copyright (c) 2017 Albert Krewinkel
4+Copyright © 2017 Albert Krewinkel
55
66Permission to use, copy, modify, and/or distribute this software for any purpose
77with 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
1616THIS SOFTWARE.
1717]]
1818
19−--- The module
19+---
20+-- Lua functions for pandoc scripts.
21+--
22+-- @author Albert Krewinkel
23+-- @copyright © 2017 Albert Krewinkel
24+-- @license MIT
2025local M = {
21− _version = "0.1.0"
26+ _VERSION = "0.2.0"
2227}
2328
29+--- Attributes
30+-- @type Attributes
31+M.Attributes = {}
32+setmetatable(M.Attributes, M.Attributes)
33+
34+M.Attributes.__index = function(t, k)
35+ if k == "id" then
36+ return t[1]
37+ elseif k == "class" then
38+ return table.concat(t[2], ' ')
39+ else
40+ return t.kv[k]
41+ end
42+end
43+
2444--- Create a new set of attributes (Attr).
25−function M.Attributes(id, classes, key_values)
26− return {id, classes, key_values}
45+-- @function Attributes
46+M.Attributes.__call = function(t, key_values, id, classes)
47+ local kv = {}
48+ for i = 1, #key_values do
49+ kv[key_values[i][1]] = key_values[i][2]
50+ end
51+ id = id or ''
52+ classes = classes or {}
53+ local attr = {id, classes, key_values, kv = kv}
54+ setmetatable(attr, t)
55+ return attr
2756end
57+M.Attributes.empty = M.Attributes('', {}, {})
58+
2859
60+--- Creates a single citation.
61+-- @function Citation
62+-- @tparam string id citation identifier (like a bibtex key)
63+-- @tparam AuthorInText|SuppressAuthor|NormalCitation mode citation mode
64+-- @tparam[opt] {Inline,...} prefix citation prefix
65+-- @tparam[opt] {Inline,...} suffix citation suffix
66+-- @tparam[opt] int note_num note number
67+-- @tparam[opt] int note_num hash number
68+M.Citation = function(id, mode, prefix, suffix, note_num, hash)
69+ prefix = prefix or {}
70+ suffix = suffix or {}
71+ note_num = note_num or 0
72+ hash = hash or 0
73+ return {
74+ citationId = id,
75+ citationPrefix = prefix,
76+ citationSuffix = suffix,
77+ citationMode = mode,
78+ citationNoteNum = note_num,
79+ citationHash = hash,
80+ }
81+end
82+
83+------------------------------------------------------------------------
84+-- The base class for pandoc's AST elements.
85+-- @type Element
86+-- @local
2987local Element = {}
88+
3089--- Create a new element subtype
90+-- @local
3191function Element:make_subtype(o)
3292 o = o or {}
3393 setmetatable(o, self)
3494 self.__index = self
3595 return o
3696end
97+
3798--- Create a new element given its tag and arguments
99+-- @local
38100function Element:new(tag, ...)
39101 local element = { t = tag }
40102 local content = {...}
@@ -51,7 +113,48 @@ function Element:new(tag, ...)
51113 return element
52114end
53115
54−local function Doc(blocks, meta)
116+--- Create a new constructor
117+-- @local
118+-- @param tag Tag used to identify the constructor
119+-- @param fn Function to be called when constructing a new element
120+-- @return function that constructs a new element
121+function Element:create_constructor(tag, fn)
122+ local constr = self:make_subtype({tag = tag})
123+ function constr:new(...)
124+ local obj = fn(...)
125+ setmetatable(obj, self)
126+ self.__index = function(t, k)
127+ if k == "c" then
128+ return t["content"]
129+ elseif k == "t" then
130+ return getmetatable(t)["tag"]
131+ else
132+ return getmetatable(t)[k]
133+ end
134+ end
135+ return obj
136+ end
137+ self.constructor = self.constructor or {}
138+ self.constructor[tag] = constr
139+ return constr
140+end
141+
142+--- Calls the constructor, creating a new element.
143+-- @local
144+function Element.__call(t, ...)
145+ return t:new(...)
146+end
147+
148+------------------------------------------------------------------------
149+--- Pandoc Document
150+-- @section document
151+
152+--- A complete pandoc document
153+-- @function Doc
154+-- @tparam {Block,...} blocks document content
155+-- @tparam[opt] Meta meta document meta data
156+function M.Doc(blocks, meta)
157+ meta = meta or {}
55158 return {
56159 ["blocks"] = blocks,
57160 ["meta"] = meta,
@@ -59,82 +162,545 @@ local function Doc(blocks, meta)
59162 }
60163end
61164
62−local Inline = Element:make_subtype{}
63−local Block = Element:make_subtype{}
64165
65−M.block_types = {
166+------------------------------------------------------------------------
167+-- MetaValue
168+-- @section MetaValue
169+M.MetaValue = Element:make_subtype{}
170+M.MetaValue.__call = function(t, ...)
171+ return t:new(...)
172+end
173+--- Meta blocks
174+-- @function MetaBlocks
175+-- @tparam {Block,...} blocks blocks
176+
177+--- Meta inlines
178+-- @function MetaInlines
179+-- @tparam {Inline,...} inlines inlines
180+
181+--- Meta list
182+-- @function MetaList
183+-- @tparam {MetaValue,...} meta_values list of meta values
184+
185+--- Meta boolean
186+-- @function MetaBool
187+-- @tparam boolean bool boolean value
188+
189+--- Meta map
190+-- @function MetaMap
191+-- @tparam table a string-index map of meta values
192+
193+--- Meta string
194+-- @function MetaString
195+-- @tparam string str string value
196+M.meta_value_types = {
197+ "MetaBlocks",
198+ "MetaBool",
199+ "MetaInlines",
200+ "MetaList",
201+ "MetaMap",
202+ "MetaString"
203+}
204+for i = 1, #M.meta_value_types do
205+ M[M.meta_value_types[i]] = M.MetaValue:create_constructor(
206+ M.meta_value_types[i],
207+ function(content)
208+ return {c = content}
209+ end
210+ )
211+end
212+
213+------------------------------------------------------------------------
214+-- Block
215+-- @section Block
216+
217+M.Block = Element:make_subtype{}
218+M.Block.__call = function (t, ...)
219+ return t:new(...)
220+end
221+
222+--- Creates a block quote element
223+-- @function BlockQuote
224+-- @tparam {Block,...} content block content
225+-- @treturn Block block quote element
226+M.BlockQuote = M.Block:create_constructor(
66227 "BlockQuote",
228+ function(content) return {c = content} end
229+)
230+
231+--- Creates a bullet (i.e. unordered) list.
232+-- @function BulletList
233+-- @tparam {{Block,...},...} content list of items
234+-- @treturn Block block quote element
235+M.BulletList = M.Block:create_constructor(
67236 "BulletList",
237+ function(content) return {c = content} end
238+)
239+
240+--- Creates a code block element
241+-- @function CodeBlock
242+-- @tparam string code code string
243+-- @tparam[opt] Attributes attributes element attributes
244+-- @treturn Block code block element
245+M.CodeBlock = M.Block:create_constructor(
68246 "CodeBlock",
247+ function(code, attributes) return {c = {attributes, code}} end
248+)
249+
250+--- Creates a definition list, containing terms and their explanation.
251+-- @function DefinitionList
252+-- @tparam {{{Inline,...},{Block,...}},...} content list of items
253+-- @treturn Block block quote element
254+M.DefinitionList = M.Block:create_constructor(
69255 "DefinitionList",
256+ function(content) return {c = content} end
257+)
258+
259+--- Creates a div element
260+-- @function Div
261+-- @tparam {Block,...} content block content
262+-- @tparam[opt] Attributes attributes element attributes
263+-- @treturn Block code block element
264+M.Div = M.Block:create_constructor(
70265 "Div",
266+ function(content, attributes) return {c = {attributes, content}} end
267+)
268+
269+--- Creates a block quote element.
270+-- @function Header
271+-- @tparam int level header level
272+-- @tparam Attributes attributes element attributes
273+-- @tparam {Inline,...} content inline content
274+-- @treturn Block header element
275+M.Header = M.Block:create_constructor(
71276 "Header",
277+ function(level, attributes, content)
278+ return {c = {level, attributes, content}}
279+ end
280+)
281+
282+--- Creates a horizontal rule.
283+-- @function HorizontalRule
284+-- @treturn Block horizontal rule
285+M.HorizontalRule = M.Block:create_constructor(
72286 "HorizontalRule",
73− "HorizontalRule",
287+ function() return {} end
288+)
289+
290+--- Creates a line block element.
291+-- @function LineBlock
292+-- @tparam {{Inline,...},...} content inline content
293+-- @treturn Block block quote element
294+M.LineBlock = M.Block:create_constructor(
74295 "LineBlock",
296+ function(content) return {c = content} end
297+)
298+
299+--- Creates a null element.
300+-- @function Null
301+-- @treturn Block null element
302+M.Null = M.Block:create_constructor(
75303 "Null",
304+ function() return {} end
305+)
306+
307+--- Creates an ordered list.
308+-- @function OrderedList
309+-- @tparam {{Block,...},...} items list items
310+-- @param[opt] listAttributes list parameters
311+-- @treturn Block
312+M.OrderedList = M.Block:create_constructor(
76313 "OrderedList",
314+ function(items, listAttributes)
315+ return {c = {listAttributes,items}}
316+ end
317+)
318+
319+--- Creates a para element.
320+-- @function Para
321+-- @tparam {Inline,...} content inline content
322+-- @treturn Block block quote element
323+M.Para = M.Block:create_constructor(
77324 "Para",
325+ function(content) return {c = content} end
326+)
327+
328+--- Creates a plain element.
329+-- @function Plain
330+-- @tparam {Inline,...} content inline content
331+-- @treturn Block block quote element
332+M.Plain = M.Block:create_constructor(
78333 "Plain",
334+ function(content) return {c = content} end
335+)
336+
337+--- Creates a raw content block of the specified format.
338+-- @function RawBlock
339+-- @tparam string format format of content
340+-- @tparam string content string content
341+-- @treturn Block block quote element
342+M.RawBlock = M.Block:create_constructor(
79343 "RawBlock",
344+ function(format, content) return {c = {format, content}} end
345+)
346+
347+--- Creates a table element.
348+-- @function Table
349+-- @tparam {Inline,...} caption table caption
350+-- @tparam {AlignDefault|AlignLeft|AlignRight|AlignCenter,...} aligns alignments
351+-- @tparam {int,...} widths column widths
352+-- @tparam {Block,...} headers header row
353+-- @tparam {{Block,...}} rows table rows
354+-- @treturn Block block quote element
355+M.Table = M.Block:create_constructor(
80356 "Table",
81−}
357+ function(caption, aligns, widths, headers, rows)
358+ return {c = {caption, aligns, widths, headers, rows}}
359+ end
360+)
361+
362+
363+------------------------------------------------------------------------
364+-- Inline
365+-- @section Inline
82366
83−M.inline_types = {
367+--- Inline element class
368+M.Inline = Element:make_subtype{}
369+M.Inline.__call = function (t, ...)
370+ return t:new(...)
371+end
372+
373+--- Creates a Cite inline element
374+-- @function Cite
375+-- @tparam {Inline,...} content List of inlines
376+-- @tparam {Citation,...} citations List of citations
377+-- @treturn Inline citations element
378+M.Cite = M.Inline:create_constructor(
84379 "Cite",
380+ function(content, citations) return {c = {citations, content}} end
381+)
382+
383+--- Creates a Code inline element
384+-- @function Code
385+-- @tparam string code brief image description
386+-- @tparam[opt] Attributes attributes additional attributes
387+-- @treturn Inline code element
388+M.Code = M.Inline:create_constructor(
85389 "Code",
390+ function(code, attributes) return {c = {attributes, code}} end
391+)
392+
393+--- Creates an inline element representing emphasised text.
394+-- @function Emph
395+-- @tparam {Inline,..} content inline content
396+-- @treturn Inline emphasis element
397+M.Emph = M.Inline:create_constructor(
86398 "Emph",
399+ function(content) return {c = content} end
400+)
401+
402+--- Creates a Image inline element
403+-- @function Image
404+-- @tparam {Inline,..} caption text used to describe the image
405+-- @tparam string src path to the image file
406+-- @tparam[opt] string title brief image description
407+-- @tparam[opt] Attributes attributes additional attributes
408+-- @treturn Inline image element
409+M.Image = M.Inline:create_constructor(
87410 "Image",
411+ function(caption, src, title, attributes)
412+ title = title or ""
413+ attributes = attributes or Attribute.empty
414+ return {c = {attributes, caption, {src, title}}}
415+ end
416+)
417+
418+--- Create a LineBreak inline element
419+-- @function LineBreak
420+-- @treturn Inline linebreak element
421+M.LineBreak = M.Inline:create_constructor(
88422 "LineBreak",
423+ function() return {} end
424+)
425+
426+--- Creates a link inline element, usually a hyperlink.
427+-- @function Link
428+-- @tparam {Inline,..} content text for this link
429+-- @tparam string target the link target
430+-- @tparam[opt] string title brief link description
431+-- @tparam[opt] Attributes attributes additional attributes
432+-- @treturn Inline image element
433+M.Link = M.Inline:create_constructor(
89434 "Link",
435+ function(content, target, title, attributes)
436+ title = title or ""
437+ attributes = attributes or Attribute.empty
438+ return {c = {attributes, content, {target, title}}}
439+ end
440+)
441+
442+--- Creates a Math inline element
443+-- @function Math
444+-- @tparam InlineMath|DisplayMath mathtype Display specifier
445+-- @tparam string text Math content
446+-- @treturn Inline Math element
447+M.Math = M.Inline:create_constructor(
90448 "Math",
449+ function(mathtype, text)
450+ return {c = {mathtype, text}}
451+ end
452+)
453+
454+--- Creates a Note inline element
455+-- @function Note
456+-- @tparam {Block,...} content footnote block content
457+M.Note = M.Inline:create_constructor(
91458 "Note",
459+ function(contents) return {c = contents} end
460+)
461+
462+--- Creates a Quoted inline element
463+-- @function Quoted
464+-- @tparam DoubleQuote|SingleQuote quotetype type of quotes to be used
465+-- @tparam {Inline,..} content inline content
466+-- @treturn Inline quoted element
467+M.Quoted = M.Inline:create_constructor(
92468 "Quoted",
469+ function(quotetype, content) return {c = {quotetype, content}} end
470+)
471+--- Creates a RawInline inline element
472+-- @function RawInline
473+-- @tparam string format format of the contents
474+-- @tparam string text string content
475+-- @treturn Inline raw inline element
476+M.RawInline = M.Inline:create_constructor(
93477 "RawInline",
478+ function(format, text) return {c = {format, text}} end
479+)
480+
481+--- Creates text rendered in small caps
482+-- @function SmallCaps
483+-- @tparam {Inline,..} content inline content
484+-- @treturn Inline smallcaps element
485+M.SmallCaps = M.Inline:create_constructor(
94486 "SmallCaps",
487+ function(content) return {c = content} end
488+)
489+
490+--- Creates a SoftBreak inline element.
491+-- @function SoftBreak
492+-- @treturn Inline softbreak element
493+M.SoftBreak = M.Inline:create_constructor(
95494 "SoftBreak",
495+ function() return {} end
496+)
497+
498+--- Create a Space inline element
499+-- @function Space
500+-- @treturn Inline space element
501+M.Space = M.Inline:create_constructor(
96502 "Space",
503+ function() return {} end
504+)
505+
506+--- Creates a Span inline element
507+-- @function Span
508+-- @tparam {Inline,..} content inline content
509+-- @tparam[opt] Attributes attributes additional attributes
510+-- @treturn Inline span element
511+M.Span = M.Inline:create_constructor(
97512 "Span",
513+ function(content, attributes) return {c = {attributes, content}} end
514+)
515+
516+--- Creates a Str inline element
517+-- @function Str
518+-- @tparam string text content
519+-- @treturn Inline string element
520+M.Str = M.Inline:create_constructor(
98521 "Str",
522+ function(text) return {c = text} end
523+)
524+
525+--- Creates text which is striked out.
526+-- @function Strikeout
527+-- @tparam {Inline,..} content inline content
528+-- @treturn Inline strikeout element
529+M.Strikeout = M.Inline:create_constructor(
99530 "Strikeout",
531+ function(content) return {c = content} end
532+)
533+
534+--- Creates a Strong element, whose text is usually displayed in a bold font.
535+-- @function Strong
536+-- @tparam {Inline,..} content inline content
537+-- @treturn Inline strong element
538+M.Strong = M.Inline:create_constructor(
100539 "Strong",
540+ function(content) return {c = content} end
541+)
542+
543+--- Creates a Subscript inline element
544+-- @function Subscript
545+-- @tparam {Inline,..} content inline content
546+-- @treturn Inline subscript element
547+M.Subscript = M.Inline:create_constructor(
101548 "Subscript",
102− "Superscript"
103−}
549+ function(content) return {c = content} end
550+)
104551
105−for _, block_type in pairs(M.block_types) do
106− M[block_type] = function(...)
107− return Block:new(block_type, ...)
108− end
109−end
552+--- Creates a Superscript inline element
553+-- @function Superscript
554+-- @tparam {Inline,..} content inline content
555+-- @treturn Inline strong element
556+M.Superscript = M.Inline:create_constructor(
557+ "Superscript",
558+ function(content) return {c = content} end
559+)
110560
111−for _, inline_type in pairs(M.inline_types) do
112− M[inline_type] = function(...)
113− return Inline:new(inline_type, ...)
114− end
115−end
116561
117−--- Arrays to provide fast lookup of element types
118−local set_of_inline_types = {}
119−local set_of_block_types = {}
562+------------------------------------------------------------------------
563+-- Constants
564+-- @section constants
120565
121−for i = 1, #M.inline_types do
122− set_of_inline_types[M.inline_types[i]] = true
123−end
124−for i = 1, #M.block_types do
125− set_of_block_types[M.block_types[i]] = true
126−end
566+--- Math content is to be displayed on a separate line.
567+-- @see Math
568+M.DisplayMath = {}
569+M.DisplayMath.t = "DisplayMath"
570+--- Math content is to be displayed inline within the paragraph
571+-- @see Math
572+M.InlineMath = {}
573+M.InlineMath.t = "InlineMath"
574+
575+--- Double quoted content.
576+-- @see Quoted
577+M.DoubleQuote = {}
578+M.DoubleQuote.t = "DoubleQuote"
579+
580+--- Single quoted content.
581+-- @see Quoted
582+M.SingleQuote = {}
583+M.SingleQuote.t = "SingleQuote"
584+
585+--- Author name is mentioned in the text.
586+-- @see Citation
587+-- @see Cite
588+M.AuthorInText = {}
589+M.AuthorInText.t = "AuthorInText"
590+
591+--- Author name is suppressed.
592+-- @see Citation
593+-- @see Cite
594+M.SuppressAuthor = {}
595+M.SuppressAuthor.t = "SuppressAuthor"
596+
597+--- Default citation style is used.
598+-- @see Citation
599+-- @see Cite
600+M.NormalCitation = {}
601+M.NormalCitation.t = "NormalCitation"
602+
603+--- Table cells aligned left.
604+-- @see Table
605+M.AlignLeft = {}
606+M.AlignLeft.t = "AlignLeft"
607+
608+--- Table cells right-aligned.
609+-- @see Table
610+M.AlignRight = {}
611+M.AlignRight.t = "AlignRight"
612+
613+--- Table cell content is centered.
614+-- @see Table
615+M.AlignCenter = {}
616+M.AlignCenter.t = "AlignCenter"
617+
618+--- Table cells are alignment is unaltered.
619+-- @see Table
620+M.AlignDefault = {}
621+M.AlignDefault.t = "AlignDefault"
622+
623+--- Default list number delimiters are used.
624+-- @see OrderedList
625+M.DefaultDelim = {}
626+M.DefaultDelim.t = "DefaultDelim"
627+
628+--- List numbers are delimited by a period.
629+-- @see OrderedList
630+M.Period = {}
631+M.Period.t = "Period"
127632
633+--- List numbers are delimited by a single parenthesis.
634+-- @see OrderedList
635+M.OneParen = {}
636+M.OneParen.t = "OneParen"
637+
638+--- List numbers are delimited by a double parentheses.
639+-- @see OrderedList
640+M.TwoParens = {}
641+M.TwoParens.t = "TwoParens"
642+
643+--- List are numbered in the default style
644+-- @see OrderedList
645+M.DefaultStyle = {}
646+M.DefaultStyle.t = "DefaultStyle"
647+
648+--- List items are numbered as examples.
649+-- @see OrderedList
650+M.Example = {}
651+M.Example.t = "Example"
652+
653+--- List are numbered using decimal integers.
654+-- @see OrderedList
655+M.Decimal = {}
656+M.Decimal.t = "Decimal"
657+
658+--- List are numbered using lower-case roman numerals.
659+-- @see OrderedList
660+M.LowerRoman = {}
661+M.LowerRoman.t = "LowerRoman"
662+
663+--- List are numbered using upper-case roman numerals
664+-- @see OrderedList
665+M.UpperRoman = {}
666+M.UpperRoman.t = "UpperRoman"
667+
668+--- List are numbered using lower-case alphabetic characters.
669+-- @see OrderedList
670+M.LowerAlpha = {}
671+M.LowerAlpha.t = "LowerAlpha"
672+
673+--- List are numbered using upper-case alphabetic characters.
674+-- @see OrderedList
675+M.UpperAlpha = {}
676+M.UpperAlpha.t = "UpperAlpha"
677+
678+
679+------------------------------------------------------------------------
680+-- Helper Functions
681+-- @section helpers
682+
683+--- Use functions defined in the global namespace to create a pandoc filter.
684+-- All globally defined functions which have names of pandoc elements are
685+-- collected into a new table.
686+-- @return A list of filter functions
687+-- @usage
688+-- -- within a file defining a pandoc filter:
689+-- function Str(text)
690+-- return pandoc.Str(utf8.upper(text))
691+-- end
692+--
693+-- return {pandoc.global_filter()}
694+-- -- the above is equivallent to
695+-- -- return {{Str = Str}}
128696function M.global_filter()
129697 local res = {}
130698 for k, v in pairs(_G) do
131− if set_of_inline_types[k] or set_of_block_types[k] or k == "Doc" then
699+ if M.Inline.constructor[k] or M.Block.constructor[k] or M.Block.constructors[k] or k == "Doc" then
132700 res[k] = v
133701 end
134702 end
135703 return res
136704end
137705
138−M["Doc"] = Doc
139−
140706return M
pandoc.cabal−1
@@ -300,7 +300,6 @@ Library
300300 pandoc-types >= 1.17 && < 1.18,
301301 aeson >= 0.7 && < 1.2,
302302 aeson-pretty >= 0.8 && < 0.9,
303− hslua-aeson >= 0.1.0.2 && < 1,
304303 tagsoup >= 0.13.7 && < 0.15,
305304 base64-bytestring >= 0.1 && < 1.1,
306305 zlib >= 0.5 && < 0.7,
src/Text/Pandoc/Lua.hs+95−67
@@ -15,6 +15,9 @@ You should have received a copy of the GNU General Public License
1515along with this program; if not, write to the Free Software
1616Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
1717-}
18+{-# LANGUAGE FlexibleContexts #-}
19+{-# LANGUAGE FlexibleInstances #-}
20+{-# LANGUAGE MultiParamTypeClasses #-}
1821{-# LANGUAGE OverloadedStrings #-}
1922{- |
2023 Module : Text.Pandoc.Lua
@@ -26,27 +29,24 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
2629
2730Pandoc lua utils.
2831-}
29−module Text.Pandoc.Lua ( runLuaFilter ) where
32+module Text.Pandoc.Lua ( runLuaFilter, pushPandocModule ) where
3033
3134import Control.Monad ( (>=>), when )
3235import Control.Monad.Trans ( MonadIO(..) )
33−import Data.HashMap.Lazy ( HashMap )
34−import Data.Text ( Text, pack, unpack )
35−import Data.Text.Encoding ( decodeUtf8 )
36+import Data.Map ( Map )
3637import Scripting.Lua ( LuaState, StackValue(..) )
37−import Scripting.Lua.Aeson ( newstate )
3838import Text.Pandoc.Definition ( Block(..), Inline(..), Pandoc(..) )
39−import Text.Pandoc.Lua.PandocModule
39+import Text.Pandoc.Lua.PandocModule ( pushPandocModule )
4040import Text.Pandoc.Lua.StackInstances ()
4141import Text.Pandoc.Walk
4242
43−import qualified Data.HashMap.Lazy as HashMap
43+import qualified Data.Map as Map
4444import qualified Scripting.Lua as Lua
4545
4646runLuaFilter :: (MonadIO m)
4747 => FilePath -> [String] -> Pandoc -> m Pandoc
4848runLuaFilter filterPath args pd = liftIO $ do
49− lua <- newstate
49+ lua <- Lua.newstate
5050 Lua.openlibs lua
5151 -- create table in registry to store filter functions
5252 Lua.push lua ("PANDOC_FILTER_FUNCTIONS"::String)
@@ -58,12 +58,12 @@ runLuaFilter filterPath args pd = liftIO $ do
5858 status <- Lua.loadfile lua filterPath
5959 if (status /= 0)
6060 then do
61− luaErrMsg <- unpack . decodeUtf8 <$> Lua.tostring lua 1
61+ Just luaErrMsg <- Lua.peek lua 1
6262 error luaErrMsg
6363 else do
6464 Lua.call lua 0 1
6565 Just luaFilters <- Lua.peek lua (-1)
66− Lua.push lua (map pack args)
66+ Lua.push lua args
6767 Lua.setglobal lua "PandocParameters"
6868 doc <- runAll luaFilters >=> luaFilter lua "filter_doc" $ pd
6969 Lua.close lua
@@ -86,73 +86,85 @@ walkMWithLuaFilter (LuaFilter lua inlineFnMap blockFnMap docFnMap) =
8686 walkM (execBlockLuaFilter lua blockFnMap) >=>
8787 walkM (execDocLuaFilter lua docFnMap)
8888
89−type InlineFunctionMap = HashMap Text (LuaFilterFunction Inline)
90−type BlockFunctionMap = HashMap Text (LuaFilterFunction Block)
91−type DocFunctionMap = HashMap Text (LuaFilterFunction Pandoc)
89+type InlineFunctionMap = Map String (LuaFilterFunction Inline)
90+type BlockFunctionMap = Map String (LuaFilterFunction Block)
91+type DocFunctionMap = Map String (LuaFilterFunction Pandoc)
9292data LuaFilter =
9393 LuaFilter LuaState InlineFunctionMap BlockFunctionMap DocFunctionMap
9494
9595newtype LuaFilterFunction a = LuaFilterFunction { functionIndex :: Int }
9696
9797execDocLuaFilter :: LuaState
98− -> HashMap Text (LuaFilterFunction Pandoc)
98+ -> Map String (LuaFilterFunction Pandoc)
9999 -> Pandoc -> IO Pandoc
100100execDocLuaFilter lua fnMap x = do
101101 let docFnName = "Doc"
102− case HashMap.lookup docFnName fnMap of
102+ case Map.lookup docFnName fnMap of
103103 Nothing -> return x
104104 Just fn -> runLuaFilterFunction lua fn x
105105
106106execBlockLuaFilter :: LuaState
107− -> HashMap Text (LuaFilterFunction Block)
107+ -> Map String (LuaFilterFunction Block)
108108 -> Block -> IO Block
109109execBlockLuaFilter lua fnMap x = do
110− let filterOrId constr = case HashMap.lookup constr fnMap of
111− Nothing -> return x
112− Just fn -> runLuaFilterFunction lua fn x
110+ let runFn :: PushViaFilterFunction Block a => LuaFilterFunction Block -> a
111+ runFn fn = runLuaFilterFunction lua fn
112+ let tryFilter :: String -> (LuaFilterFunction Block -> IO Block) -> IO Block
113+ tryFilter fnName callFilterFn =
114+ case Map.lookup fnName fnMap of
115+ Nothing -> return x
116+ Just fn -> callFilterFn fn
113117 case x of
114− Plain _ -> filterOrId "Plain"
115− Para _ -> filterOrId "Para"
116− LineBlock _ -> filterOrId "LineBlock"
117− CodeBlock _ _ -> filterOrId "CodeBlock"
118− RawBlock _ _ -> filterOrId "RawBlock"
119− BlockQuote _ -> filterOrId "BlockQuote"
120− OrderedList _ _ -> filterOrId "OrderedList"
121− BulletList _ -> filterOrId "BulletList"
122− DefinitionList _ -> filterOrId "DefinitionList"
123− Header _ _ _ -> filterOrId "Header"
124− HorizontalRule -> filterOrId "HorizontalRule"
125− Table _ _ _ _ _ -> filterOrId "Table"
126− Div _ _ -> filterOrId "Div"
127− Null -> filterOrId "Null"
118+ HorizontalRule -> tryFilter "HorizontalRule" runFn
119+ Null -> tryFilter "Null" runFn
120+ BlockQuote blcks -> tryFilter "BlockQuote" $ \fn -> runFn fn blcks
121+ BulletList items -> tryFilter "BulletList" $ \fn -> runFn fn items
122+ CodeBlock attr code -> tryFilter "CodeBlock" $ \fn -> runFn fn attr code
123+ DefinitionList lst -> tryFilter "DefinitionList" $ \fn -> runFn fn lst
124+ Div attr content -> tryFilter "Div" $ \fn -> runFn fn content attr
125+ Header lvl attr inlns -> tryFilter "Header" $ \fn -> runFn fn lvl inlns attr
126+ LineBlock inlns -> tryFilter "LineBlock" $ \fn -> runFn fn inlns
127+ Para inlns -> tryFilter "Para" $ \fn -> runFn fn inlns
128+ Plain inlns -> tryFilter "Plain" $ \fn -> runFn fn inlns
129+ RawBlock format str -> tryFilter "RawBlock" $ \fn -> runFn fn format str
130+ OrderedList (num,sty,delim) items ->
131+ tryFilter "OrderedList" $ \fn -> runFn fn items (num,sty,delim)
132+ Table capt aligns widths headers rows ->
133+ tryFilter "Table" $ \fn -> runFn fn capt aligns widths headers rows
128134
129135execInlineLuaFilter :: LuaState
130− -> HashMap Text (LuaFilterFunction Inline)
136+ -> Map String (LuaFilterFunction Inline)
131137 -> Inline -> IO Inline
132138execInlineLuaFilter lua fnMap x = do
133− let filterOrId constr = case HashMap.lookup constr fnMap of
134− Nothing -> return x
135− Just fn -> runLuaFilterFunction lua fn x
139+ let runFn :: PushViaFilterFunction Inline a => LuaFilterFunction Inline -> a
140+ runFn fn = runLuaFilterFunction lua fn
141+ let tryFilter :: String -> (LuaFilterFunction Inline -> IO Inline) -> IO Inline
142+ tryFilter fnName callFilterFn =
143+ case Map.lookup fnName fnMap of
144+ Nothing -> return x
145+ Just fn -> callFilterFn fn
136146 case x of
137− Cite _ _ -> filterOrId "Cite"
138− Code _ _ -> filterOrId "Code"
139− Emph _ -> filterOrId "Emph"
140− Image _ _ _ -> filterOrId "Image"
141− LineBreak -> filterOrId "LineBreak"
142− Link _ _ _ -> filterOrId "Link"
143− Math _ _ -> filterOrId "Math"
144− Note _ -> filterOrId "Note"
145− Quoted _ _ -> filterOrId "Quoted"
146− RawInline _ _ -> filterOrId "RawInline"
147− SmallCaps _ -> filterOrId "SmallCaps"
148− SoftBreak -> filterOrId "SoftBreak"
149− Space -> filterOrId "Space"
150− Span _ _ -> filterOrId "Span"
151− Str _ -> filterOrId "Str"
152− Strikeout _ -> filterOrId "Strikeout"
153− Strong _ -> filterOrId "Strong"
154− Subscript _ -> filterOrId "Subscript"
155− Superscript _ -> filterOrId "Superscript"
147+ LineBreak -> tryFilter "LineBreak" runFn
148+ SoftBreak -> tryFilter "SoftBreak" runFn
149+ Space -> tryFilter "Space" runFn
150+ Cite cs lst -> tryFilter "Cite" $ \fn -> runFn fn lst cs
151+ Code attr str -> tryFilter "Code" $ \fn -> runFn fn str attr
152+ Emph lst -> tryFilter "Emph" $ \fn -> runFn fn lst
153+ Math mt lst -> tryFilter "Math" $ \fn -> runFn fn lst mt
154+ Note blks -> tryFilter "Note" $ \fn -> runFn fn blks
155+ Quoted qt lst -> tryFilter "Quoted" $ \fn -> runFn fn qt lst
156+ RawInline f str -> tryFilter "RawInline" $ \fn -> runFn fn f str
157+ SmallCaps lst -> tryFilter "SmallCaps" $ \fn -> runFn fn lst
158+ Span attr lst -> tryFilter "Span" $ \fn -> runFn fn lst attr
159+ Str str -> tryFilter "Str" $ \fn -> runFn fn str
160+ Strikeout lst -> tryFilter "Strikeout" $ \fn -> runFn fn lst
161+ Strong lst -> tryFilter "Strong" $ \fn -> runFn fn lst
162+ Subscript lst -> tryFilter "Subscript" $ \fn -> runFn fn lst
163+ Superscript lst -> tryFilter "Superscript" $ \fn -> runFn fn lst
164+ Link attr txt (src, tit) -> tryFilter "Link" $
165+ \fn -> runFn fn txt src tit attr
166+ Image attr alt (src, tit) -> tryFilter "Image" $
167+ \fn -> runFn fn alt src tit attr
156168
157169instance StackValue LuaFilter where
158170 valuetype _ = Lua.TTABLE
@@ -164,17 +176,33 @@ instance StackValue LuaFilter where
164176 docFnMap <- Lua.peek lua i
165177 return $ LuaFilter lua <$> inlineFnMap <*> blockFnMap <*> docFnMap
166178
167−runLuaFilterFunction :: (StackValue a)
168− => LuaState -> LuaFilterFunction a -> a -> IO a
169−runLuaFilterFunction lua lf inline = do
170− pushFilterFunction lua lf
171− Lua.push lua inline
172− Lua.call lua 1 1
173− mbres <- Lua.peek lua (-1)
174− case mbres of
175− Nothing -> error $ "Error while trying to get a filter's return "
176− ++ "value from lua stack."
177− Just res -> res <$ Lua.pop lua 1
179+-- | Helper class for pushing a single value to the stack via a lua function.
180+-- See @pushViaCall@.
181+class PushViaFilterFunction a b where
182+ pushViaFilterFunction' :: LuaState -> LuaFilterFunction a -> IO () -> Int -> b
183+
184+instance (StackValue a) => PushViaFilterFunction a (IO a) where
185+ pushViaFilterFunction' lua lf pushArgs num = do
186+ pushFilterFunction lua lf
187+ pushArgs
188+ Lua.call lua num 1
189+ mbres <- Lua.peek lua (-1)
190+ case mbres of
191+ Nothing -> error $ "Error while trying to get a filter's return "
192+ ++ "value from lua stack."
193+ Just res -> res <$ Lua.pop lua 1
194+
195+instance (PushViaFilterFunction a c, StackValue b) =>
196+ PushViaFilterFunction a (b -> c) where
197+ pushViaFilterFunction' lua lf pushArgs num x =
198+ pushViaFilterFunction' lua lf (pushArgs *> push lua x) (num + 1)
199+
200+-- | Push an value to the stack via a lua filter function. The function is
201+-- called with all arguments that are passed to this function and is expected to
202+-- return a single value.
203+runLuaFilterFunction :: (StackValue a, PushViaFilterFunction a b)
204+ => LuaState -> LuaFilterFunction a -> b
205+runLuaFilterFunction lua lf = pushViaFilterFunction' lua lf (return ()) 0
178206
179207-- | Push the filter function to the top of the stack.
180208pushFilterFunction :: Lua.LuaState -> LuaFilterFunction a -> IO ()
src/Text/Pandoc/Lua/StackInstances.hs+267−97
@@ -35,28 +35,22 @@ StackValue instances for pandoc types.
3535-}
3636module Text.Pandoc.Lua.StackInstances () where
3737
38−import Data.Aeson ( FromJSON(..), ToJSON(..), Result(..), Value, fromJSON )
38+import Control.Applicative ( (<|>) )
3939import Scripting.Lua
4040 ( LTYPE(..), LuaState, StackValue(..)
41− , gettable, newtable, pop, rawgeti, rawset, rawseti, settable
41+ , call, getglobal2, gettable, ltype, newtable, next, objlen
42+ , pop, pushnil, rawgeti, rawseti, settable
4243 )
43−import Scripting.Lua.Aeson ()
4444import Text.Pandoc.Definition
45− ( Block(..), Inline(..), Meta(..), Pandoc(..)
46− , Citation(..), CitationMode(..), Format(..), MathType(..), QuoteType(..) )
4745
46+import qualified Data.Map as M
4847import qualified Text.Pandoc.UTF8 as UTF8
4948
50−maybeFromJson :: (FromJSON a) => Maybe Value -> Maybe a
51−maybeFromJson mv = fromJSON <$> mv >>= \case
52− Success x -> Just x
53− _ -> Nothing
54−
5549instance StackValue Pandoc where
5650 push lua (Pandoc meta blocks) = do
5751 newtable lua
58− setField lua (-1) "blocks" blocks
59− setField lua (-1) "meta" meta
52+ addKeyValue lua "blocks" blocks
53+ addKeyValue lua "meta" meta
6054 peek lua idx = do
6155 blocks <- getField lua idx "blocks"
6256 meta <- getField lua idx "meta"
@@ -64,57 +58,122 @@ instance StackValue Pandoc where
6458 valuetype _ = TTABLE
6559
6660instance StackValue Meta where
67− push lua = push lua . toJSON
68− peek lua = fmap maybeFromJson . peek lua
61+ push lua (Meta mmap) = push lua mmap
62+ peek lua idx = fmap Meta <$> peek lua idx
6963 valuetype _ = TTABLE
7064
65+instance StackValue MetaValue where
66+ push lua = \case
67+ MetaBlocks blcks -> pushViaConstructor lua "MetaBlocks" blcks
68+ MetaBool b -> pushViaConstructor lua "MetaBool" b
69+ MetaInlines inlns -> pushViaConstructor lua "MetaInlines" inlns
70+ MetaList metalist -> pushViaConstructor lua "MetaList" metalist
71+ MetaMap metamap -> pushViaConstructor lua "MetaMap" metamap
72+ MetaString cs -> pushViaConstructor lua "MetaString" cs
73+ peek lua idx = do
74+ luatype <- ltype lua idx
75+ case luatype of
76+ TBOOLEAN -> fmap MetaBool <$> peek lua idx
77+ TSTRING -> fmap MetaString <$> peek lua idx
78+ TTABLE -> do
79+ tag <- push lua "t"
80+ *> gettable lua (idx `adjustIndexBy` 1)
81+ *> peek lua (-1)
82+ <* pop lua 1
83+ case tag of
84+ Just "MetaBlocks" -> fmap MetaBlocks <$> peekContent lua idx
85+ Just "MetaBool" -> fmap MetaBool <$> peekContent lua idx
86+ Just "MetaMap" -> fmap MetaMap <$> peekContent lua idx
87+ Just "MetaInlines" -> fmap MetaInlines <$> peekContent lua idx
88+ Just "MetaList" -> fmap MetaList <$> peekContent lua idx
89+ Just "MetaString" -> fmap MetaString <$> peekContent lua idx
90+ Nothing -> do
91+ len <- objlen lua idx
92+ if len <= 0
93+ then fmap MetaMap <$> peek lua idx
94+ else (fmap MetaInlines <$> peek lua idx)
95+ <|> (fmap MetaBlocks <$> peek lua idx)
96+ <|> (fmap MetaList <$> peek lua idx)
97+ _ -> return Nothing
98+ _ -> return Nothing
99+ valuetype = \case
100+ MetaBlocks _ -> TTABLE
101+ MetaBool _ -> TBOOLEAN
102+ MetaInlines _ -> TTABLE
103+ MetaList _ -> TTABLE
104+ MetaMap _ -> TTABLE
105+ MetaString _ -> TSTRING
106+
107+peekContent :: StackValue a => LuaState -> Int -> IO (Maybe a)
108+peekContent lua idx = do
109+ push lua "c"
110+ gettable lua (idx `adjustIndexBy` 1)
111+ peek lua (-1) <* pop lua 1
112+
71113instance StackValue Block where
72114 push lua = \case
73− BlockQuote blcks -> pushTagged lua "BlockQuote" blcks
74− BulletList items -> pushTagged lua "BulletList" items
75− HorizontalRule -> pushTagged' lua "HorizontalRule"
76− LineBlock blcks -> pushTagged lua "LineBlock" blcks
77− Null -> pushTagged' lua "Null"
78− Para blcks -> pushTagged lua "Para" blcks
79− Plain blcks -> pushTagged lua "Plain" blcks
115+ BlockQuote blcks -> pushViaConstructor lua "BlockQuote" blcks
116+ BulletList items -> pushViaConstructor lua "BulletList" items
117+ CodeBlock attr code -> pushViaConstructor lua "CodeBlock" code attr
118+ DefinitionList items -> pushViaConstructor lua "DefinitionList" items
119+ Div attr blcks -> pushViaConstructor lua "Div" blcks attr
120+ Header lvl attr inlns -> pushViaConstructor lua "Header" lvl attr inlns
121+ HorizontalRule -> pushViaConstructor lua "HorizontalRule"
122+ LineBlock blcks -> pushViaConstructor lua "LineBlock" blcks
123+ OrderedList lstAttr list -> pushViaConstructor lua "OrderedList" list lstAttr
124+ Null -> pushViaConstructor lua "Null"
125+ Para blcks -> pushViaConstructor lua "Para" blcks
126+ Plain blcks -> pushViaConstructor lua "Plain" blcks
127+ RawBlock f cs -> pushViaConstructor lua "RawBlock" f cs
128+ Table capt aligns widths headers rows ->
129+ pushViaConstructor lua "Table" capt aligns widths headers rows
80130 -- fall back to conversion via aeson's Value
81− x -> push lua (toJSON x)
82131 peek lua i = peekBlock lua i
83132 valuetype _ = TTABLE
84133
85134instance StackValue Inline where
86135 push lua = \case
87− Cite citations lst -> pushTagged lua "Cite" (citations, lst)
88− Code attr lst -> pushTagged lua "Code" (attr, lst)
89− Emph inlns -> pushTagged lua "Emph" inlns
90− Image attr lst tgt -> pushTagged lua "Image" (attr, lst, tgt)
91− LineBreak -> pushTagged' lua "LineBreak"
92− Link attr lst tgt -> pushTagged lua "Link" (attr, lst, tgt)
93− Note blcks -> pushTagged lua "Note" blcks
94− Math mty str -> pushTagged lua "Math" (mty, str)
95− Quoted qt inlns -> pushTagged lua "Quoted" (qt, inlns)
96− RawInline f cs -> pushTagged lua "RawInline" (f, cs)
97− SmallCaps inlns -> pushTagged lua "SmallCaps" inlns
98− SoftBreak -> pushTagged' lua "SoftBreak"
99− Space -> pushTagged' lua "Space"
100− Span attr inlns -> pushTagged lua "Span" (attr, inlns)
101− Str str -> pushTagged lua "Str" str
102− Strikeout inlns -> pushTagged lua "Strikeout" inlns
103− Strong inlns -> pushTagged lua "Strong" inlns
104− Subscript inlns -> pushTagged lua "Subscript" inlns
105− Superscript inlns -> pushTagged lua "Superscript" inlns
136+ Cite citations lst -> pushViaConstructor lua "Cite" lst citations
137+ Code attr lst -> pushViaConstructor lua "Code" lst attr
138+ Emph inlns -> pushViaConstructor lua "Emph" inlns
139+ Image attr alt (src,tit) -> pushViaConstructor lua "Image" alt src tit attr
140+ LineBreak -> pushViaConstructor lua "LineBreak"
141+ Link attr lst (src,tit) -> pushViaConstructor lua "Link" lst src tit attr
142+ Note blcks -> pushViaConstructor lua "Note" blcks
143+ Math mty str -> pushViaConstructor lua "Math" mty str
144+ Quoted qt inlns -> pushViaConstructor lua "Quoted" qt inlns
145+ RawInline f cs -> pushViaConstructor lua "RawInline" f cs
146+ SmallCaps inlns -> pushViaConstructor lua "SmallCaps" inlns
147+ SoftBreak -> pushViaConstructor lua "SoftBreak"
148+ Space -> pushViaConstructor lua "Space"
149+ Span attr inlns -> pushViaConstructor lua "Span" inlns attr
150+ Str str -> pushViaConstructor lua "Str" str
151+ Strikeout inlns -> pushViaConstructor lua "Strikeout" inlns
152+ Strong inlns -> pushViaConstructor lua "Strong" inlns
153+ Subscript inlns -> pushViaConstructor lua "Subscript" inlns
154+ Superscript inlns -> pushViaConstructor lua "Superscript" inlns
106155 peek = peekInline
107156 valuetype _ = TTABLE
108157
158+instance StackValue Alignment where
159+ push lua = \case
160+ AlignLeft -> getglobal2 lua "pandoc.AlignLeft"
161+ AlignRight -> getglobal2 lua "pandoc.AlignRight"
162+ AlignCenter -> getglobal2 lua "pandoc.AlignCenter"
163+ AlignDefault -> getglobal2 lua "pandoc.AlignDefault"
164+ peek lua idx = do
165+ tag <- getField lua idx "t"
166+ case tag of
167+ Just "AlignLeft" -> return $ Just AlignLeft
168+ Just "AlignRight" -> return $ Just AlignRight
169+ Just "AlignCenter" -> return $ Just AlignCenter
170+ Just "AlignDefault" -> return $ Just AlignDefault
171+ _ -> return Nothing
172+ valuetype _ = TSTRING
173+
109174instance StackValue Citation where
110− push lua c = do
111− newtable lua
112− setField lua (-1) "citationId" (citationId c)
113− setField lua (-1) "citationPrefix" (citationPrefix c)
114− setField lua (-1) "citationSuffix" (citationSuffix c)
115− setField lua (-1) "citationMode" (citationMode c)
116− setField lua (-1) "citationNoteNum" (citationNoteNum c)
117− setField lua (-1) "citationHash" (citationHash c)
175+ push lua (Citation cid prefix suffix mode noteNum hash) =
176+ pushViaConstructor lua "Citation" cid mode prefix suffix noteNum hash
118177 peek lua idx = do
119178 id' <- getField lua idx "citationId"
120179 prefix <- getField lua idx "citationPrefix"
@@ -122,20 +181,14 @@ instance StackValue Citation where
122181 mode <- getField lua idx "citationMode"
123182 num <- getField lua idx "citationNoteNum"
124183 hash <- getField lua idx "citationHash"
125− return $ Citation
126− <$> id'
127− <*> prefix
128− <*> suffix
129− <*> mode
130− <*> num
131− <*> hash
184+ return $ Citation <$> id' <*> prefix <*> suffix <*> mode <*> num <*> hash
132185 valuetype _ = TTABLE
133186
134187instance StackValue CitationMode where
135188 push lua = \case
136− AuthorInText -> pushTagged' lua "AuthorInText"
137− NormalCitation -> pushTagged' lua "NormalCitation"
138− SuppressAuthor -> pushTagged' lua "SuppressAuthor"
189+ AuthorInText -> getglobal2 lua "pandoc.AuthorInText"
190+ NormalCitation -> getglobal2 lua "pandoc.NormalCitation"
191+ SuppressAuthor -> getglobal2 lua "pandoc.SuppressAuthor"
139192 peek lua idx = do
140193 tag <- getField lua idx "t"
141194 case tag of
@@ -143,17 +196,55 @@ instance StackValue CitationMode where
143196 Just "NormalCitation" -> return $ Just NormalCitation
144197 Just "SuppressAuthor" -> return $ Just SuppressAuthor
145198 _ -> return Nothing
146− valuetype _ = TSTRING
199+ valuetype _ = TTABLE
147200
148201instance StackValue Format where
149202 push lua (Format f) = push lua f
150203 peek lua idx = fmap Format <$> peek lua idx
151204 valuetype _ = TSTRING
152205
206+instance StackValue ListNumberDelim where
207+ push lua = \case
208+ DefaultDelim -> getglobal2 lua "pandoc.DefaultDelim"
209+ Period -> getglobal2 lua "pandoc.Period"
210+ OneParen -> getglobal2 lua "pandoc.OneParen"
211+ TwoParens -> getglobal2 lua "pandoc.TwoParens"
212+ peek lua idx = do
213+ tag <- getField lua idx "t"
214+ case tag of
215+ Just "DefaultDelim" -> return $ Just DefaultDelim
216+ Just "Period" -> return $ Just Period
217+ Just "OneParen" -> return $ Just OneParen
218+ Just "TwoParens" -> return $ Just TwoParens
219+ _ -> return Nothing
220+ valuetype _ = TTABLE
221+
222+instance StackValue ListNumberStyle where
223+ push lua = \case
224+ DefaultStyle -> getglobal2 lua "pandoc.DefaultStyle"
225+ LowerRoman -> getglobal2 lua "pandoc.LowerRoman"
226+ UpperRoman -> getglobal2 lua "pandoc.UpperRoman"
227+ LowerAlpha -> getglobal2 lua "pandoc.LowerAlpha"
228+ UpperAlpha -> getglobal2 lua "pandoc.UpperAlpha"
229+ Decimal -> getglobal2 lua "pandoc.Decimal"
230+ Example -> getglobal2 lua "pandoc.Example"
231+ peek lua idx = do
232+ tag <- getField lua idx "t"
233+ case tag of
234+ Just "DefaultStyle" -> return $ Just DefaultStyle
235+ Just "LowerRoman" -> return $ Just LowerRoman
236+ Just "UpperRoman" -> return $ Just UpperRoman
237+ Just "LowerAlpha" -> return $ Just LowerAlpha
238+ Just "UpperAlpha" -> return $ Just UpperAlpha
239+ Just "Decimal" -> return $ Just Decimal
240+ Just "Example" -> return $ Just Example
241+ _ -> return Nothing
242+ valuetype _ = TTABLE
243+
153244instance StackValue MathType where
154245 push lua = \case
155− InlineMath -> pushTagged' lua "InlineMath"
156− DisplayMath -> pushTagged' lua "DisplayMath"
246+ InlineMath -> getglobal2 lua "pandoc.InlineMath"
247+ DisplayMath -> getglobal2 lua "pandoc.DisplayMath"
157248 peek lua idx = do
158249 res <- getField lua idx "t"
159250 case res of
@@ -164,8 +255,8 @@ instance StackValue MathType where
164255
165256instance StackValue QuoteType where
166257 push lua = \case
167− SingleQuote -> pushTagged' lua "SingleQuote"
168− DoubleQuote -> pushTagged' lua "DoubleQuote"
258+ SingleQuote -> getglobal2 lua "pandoc.SingleQuote"
259+ DoubleQuote -> getglobal2 lua "pandoc.DoubleQuote"
169260 peek lua idx = do
170261 res <- getField lua idx "t"
171262 case res of
@@ -186,11 +277,11 @@ instance StackValue [Char] where
186277instance (StackValue a, StackValue b) => StackValue (a, b) where
187278 push lua (a, b) = do
188279 newtable lua
189− setIntField lua (-1) 1 a
190− setIntField lua (-1) 2 b
280+ addIndexedValue lua 1 a
281+ addIndexedValue lua 2 b
191282 peek lua idx = do
192− a <- getIntField lua idx 1
193− b <- getIntField lua idx 2
283+ a <- getIndexedValue lua idx 1
284+ b <- getIndexedValue lua idx 2
194285 return $ (,) <$> a <*> b
195286 valuetype _ = TTABLE
196287
@@ -199,31 +290,93 @@ instance (StackValue a, StackValue b, StackValue c) =>
199290 where
200291 push lua (a, b, c) = do
201292 newtable lua
202− setIntField lua (-1) 1 a
203− setIntField lua (-1) 2 b
204− setIntField lua (-1) 3 c
293+ addIndexedValue lua 1 a
294+ addIndexedValue lua 2 b
295+ addIndexedValue lua 3 c
205296 peek lua idx = do
206− a <- getIntField lua idx 1
207− b <- getIntField lua idx 2
208− c <- getIntField lua idx 3
297+ a <- getIndexedValue lua idx 1
298+ b <- getIndexedValue lua idx 2
299+ c <- getIndexedValue lua idx 3
209300 return $ (,,) <$> a <*> b <*> c
210301 valuetype _ = TTABLE
211302
212−-- | Push a value to the lua stack, tagged with a given string. This currently
213−-- creates a structure equivalent to what the JSONified value would look like
214−-- when pushed to lua.
215−pushTagged :: StackValue a => LuaState -> String -> a -> IO ()
216−pushTagged lua tag value = do
217− newtable lua
218− setField lua (-1) "t" tag
219− setField lua (-1) "c" value
220−
221−pushTagged' :: LuaState -> String -> IO ()
222−pushTagged' lua tag = do
223− newtable lua
224− push lua "t"
225− push lua tag
226− rawset lua (-3)
303+instance (StackValue a, StackValue b, StackValue c,
304+ StackValue d, StackValue e) =>
305+ StackValue (a, b, c, d, e)
306+ where
307+ push lua (a, b, c, d, e) = do
308+ newtable lua
309+ addIndexedValue lua 1 a
310+ addIndexedValue lua 2 b
311+ addIndexedValue lua 3 c
312+ addIndexedValue lua 4 d
313+ addIndexedValue lua 5 e
314+ peek lua idx = do
315+ a <- getIndexedValue lua idx 1
316+ b <- getIndexedValue lua idx 2
317+ c <- getIndexedValue lua idx 3
318+ d <- getIndexedValue lua idx 4
319+ e <- getIndexedValue lua idx 5
320+ return $ (,,,,) <$> a <*> b <*> c <*> d <*> e
321+ valuetype _ = TTABLE
322+
323+instance (Ord a, StackValue a, StackValue b) =>
324+ StackValue (M.Map a b) where
325+ push lua m = do
326+ newtable lua
327+ mapM_ (uncurry $ addKeyValue lua) $ M.toList m
328+ peek lua idx = fmap M.fromList <$> keyValuePairs lua idx
329+ valuetype _ = TTABLE
330+
331+-- | Try reading the value under the given index as a list of key-value pairs.
332+keyValuePairs :: (StackValue a, StackValue b)
333+ => LuaState -> Int -> IO (Maybe [(a, b)])
334+keyValuePairs lua idx = do
335+ pushnil lua
336+ sequence <$> remainingPairs
337+ where
338+ remainingPairs = do
339+ res <- nextPair
340+ case res of
341+ Nothing -> return []
342+ Just a -> (a:) <$> remainingPairs
343+ nextPair :: (StackValue a, StackValue b) => IO (Maybe (Maybe (a,b)))
344+ nextPair = do
345+ hasNext <- next lua (idx `adjustIndexBy` 1)
346+ if hasNext
347+ then do
348+ val <- peek lua (-1)
349+ key <- peek lua (-2)
350+ pop lua 1 -- removes the value, keeps the key
351+ return $ Just <$> ((,) <$> key <*> val)
352+ else do
353+ return Nothing
354+
355+
356+-- | Helper class for pushing a single value to the stack via a lua function.
357+-- See @pushViaCall@.
358+class PushViaCall a where
359+ pushViaCall' :: LuaState -> String -> IO () -> Int -> a
360+
361+instance PushViaCall (IO ()) where
362+ pushViaCall' lua fn pushArgs num = do
363+ getglobal2 lua fn
364+ pushArgs
365+ call lua num 1
366+
367+instance (StackValue a, PushViaCall b) => PushViaCall (a -> b) where
368+ pushViaCall' lua fn pushArgs num x =
369+ pushViaCall' lua fn (pushArgs *> push lua x) (num + 1)
370+
371+-- | Push an value to the stack via a lua function. The lua function is called
372+-- with all arguments that are passed to this function and is expected to return
373+-- a single value.
374+pushViaCall :: PushViaCall a => LuaState -> String -> a
375+pushViaCall lua fn = pushViaCall' lua fn (return ()) 0
376+
377+-- | Call a pandoc element constructor within lua, passing all given arguments.
378+pushViaConstructor :: PushViaCall a => LuaState -> String -> a
379+pushViaConstructor lua pandocFn = pushViaCall lua ("pandoc." ++ pandocFn)
227380
228381-- | Return the value at the given index as inline if possible.
229382peekInline :: LuaState -> Int -> IO (Maybe Inline)
@@ -268,13 +421,22 @@ peekBlock lua idx = do
268421 Just t -> case t of
269422 "BlockQuote" -> fmap BlockQuote <$> elementContent
270423 "BulletList" -> fmap BulletList <$> elementContent
424+ "CodeBlock" -> fmap (uncurry CodeBlock) <$> elementContent
425+ "DefinitionList" -> fmap DefinitionList <$> elementContent
426+ "Div" -> fmap (uncurry Div) <$> elementContent
427+ "Header" -> fmap (\(lvl, attr, lst) -> Header lvl attr lst)
428+ <$> elementContent
271429 "HorizontalRule" -> return (Just HorizontalRule)
272430 "LineBlock" -> fmap LineBlock <$> elementContent
431+ "OrderedList" -> fmap (uncurry OrderedList) <$> elementContent
273432 "Null" -> return (Just Null)
274433 "Para" -> fmap Para <$> elementContent
275434 "Plain" -> fmap Plain <$> elementContent
276− -- fall back to construction via aeson's Value
277− _ -> maybeFromJson <$> peek lua idx
435+ "RawBlock" -> fmap (uncurry RawBlock) <$> elementContent
436+ "Table" -> fmap (\(capt, aligns, widths, headers, body) ->
437+ Table capt aligns widths headers body)
438+ <$> elementContent
439+ _ -> return Nothing
278440 where
279441 -- Get the contents of an AST element.
280442 elementContent :: StackValue a => IO (Maybe a)
@@ -296,21 +458,29 @@ getField lua idx key = do
296458 peek lua (-1) <* pop lua 1
297459
298460-- | Set value for key for table at the given index
299−setField :: (StackValue a, StackValue b) => LuaState -> Int -> a -> b -> IO ()
300−setField lua idx key value = do
461+setKeyValue :: (StackValue a, StackValue b) => LuaState -> Int -> a -> b -> IO ()
462+setKeyValue lua idx key value = do
301463 push lua key
302464 push lua value
303465 settable lua (idx `adjustIndexBy` 2)
304466
467+-- | Add a key-value pair to the table at the top of the stack
468+addKeyValue :: (StackValue a, StackValue b) => LuaState -> a -> b -> IO ()
469+addKeyValue lua = setKeyValue lua (-1)
470+
305471-- | Get value behind key from table at given index.
306−getIntField :: StackValue a => LuaState -> Int -> Int -> IO (Maybe a)
307−getIntField lua idx key =
472+getIndexedValue :: StackValue a => LuaState -> Int -> Int -> IO (Maybe a)
473+getIndexedValue lua idx key =
308474 rawgeti lua idx key
309475 *> peek lua (-1)
310476 <* pop lua 1
311477
312478-- | Set numeric key/value in table at the given index
313−setIntField :: StackValue a => LuaState -> Int -> Int -> a -> IO ()
314−setIntField lua idx key value = do
479+setIndexedValue :: StackValue a => LuaState -> Int -> Int -> a -> IO ()
480+setIndexedValue lua idx key value = do
315481 push lua value
316482 rawseti lua (idx `adjustIndexBy` 1) key
483+
484+-- | Set numeric key/value in table at the top of the stack.
485+addIndexedValue :: StackValue a => LuaState -> Int -> a -> IO ()
486+addIndexedValue lua = setIndexedValue lua (-1)
stack.full.yaml−1
@@ -24,5 +24,4 @@ extra-deps:
2424- doctemplates-0.1.0.2
2525- skylighting-0.3.1
2626- hslua-0.5.0
27−- hslua-aeson-0.1.0.3
2827resolver: lts-8.4
stack.pkg.yaml−1
@@ -19,6 +19,5 @@ packages:
1919 extra-dep: false
2020extra-deps:
2121- hslua-0.5.0
22−- hslua-aeson-0.1.0.3
2322- skylighting-0.3.2
2423resolver: lts-8.8
stack.yaml−1
@@ -9,7 +9,6 @@ packages:
99- '.'
1010extra-deps:
1111- hslua-0.5.0
12−- hslua-aeson-0.1.0.3
1312- skylighting-0.3.2
1413- foundation-0.0.6
1514resolver: lts-8.8
test/Tests/Lua.hs+6−2
@@ -64,10 +64,14 @@ roundtripEqual x = (x ==) <$> roundtripped
6464 roundtripped :: (Lua.StackValue a) => IO a
6565 roundtripped = do
6666 lua <- Lua.newstate
67+ Lua.openlibs lua
68+ pushPandocModule lua
69+ Lua.setglobal lua "pandoc"
70+ oldSize <- Lua.gettop lua
6771 Lua.push lua x
6872 size <- Lua.gettop lua
69− when (size /= 1) $
70− error ("not exactly one element on the stack: " ++ show size)
73+ when ((size - oldSize) /= 1) $
74+ error ("not exactly one additional element on the stack: " ++ show size)
7175 res <- Lua.peek lua (-1)
7276 retval <- case res of
7377 Nothing -> error "could not read from stack"
test/lua/markdown-reader.lua+1−2
@@ -1,7 +1,6 @@
11return {
22 {
3− RawBlock = function (blk)
4− local format, content = unpack(blk.c)
3+ RawBlock = function (format, content)
54 if format == "markdown" then
65 return pandoc.reader.markdown.read_block(content)
76 else
test/lua/plain-to-para.lua+2−2
@@ -1,6 +1,6 @@
11return {
2− { Plain = function (blk)
3− return pandoc.Para(blk.c)
2+ { Plain = function (content)
3+ return pandoc.Para(content)
44 end,
55 }
66}
test/lua/strmacro.lua+5−4
@@ -1,10 +1,11 @@
11return {
2− { Str = function (inline)
3− if inline.c == "{{helloworld}}" then
2+ {
3+ Str = function (str)
4+ if str == "{{helloworld}}" then
45 return pandoc.Emph {pandoc.Str "Hello, World"}
56 else
6− return inline
7+ return pandoc.Str(str)
78 end
8− end,
9+ end,
910 }
1011}