diff --git a/AUTHORS.md b/AUTHORS.md --- a/AUTHORS.md +++ b/AUTHORS.md @@ -1,10 +1,7 @@ # Contributors -- Anabra -- Aner Lucero -- Arata Mizuki -- Arfon Smith - Aaron Wolen +- Agustín Martín Barbero - Albert Krewinkel - Alex Ivkin - Alex Toldaiev @@ -16,18 +13,21 @@ - Alexandre Franke - Alfred Wechselberger - Amogh Rathore +- Anabra - Anders Waldenborg - Andreas Lööw - Andrew Dunning - Andy Morris +- Aner Lucero - Anti-Distinctlyminty - Antoine Latter - Antonio Terceiro - Arata Mizuki +- Arata Mizuki - Arfon Smith +- Arfon Smith - Arlo O'Keeffe - Artyom Kazak -- Agustín Martín Barbero - B. Scott Michel - Ben Firshman - Ben Gamari @@ -54,6 +54,7 @@ - Christian Despres - Christoffer Ackelman - Christoffer Sawicki +- Christophe Dervieux - Clare Macrae - Clint Adams - Conal Elliott @@ -82,17 +83,19 @@ - Emily Bourke - Emily Eisenberg - Eric Kow -- Erik Rask -- Eric Seidel - Eric Schrijver +- Eric Seidel +- Erik Rask - Ethan Riley - Étienne Bersac -- Felix Yan +- Ezwal - Félix Baylac-Jacqué +- Felix Yan - Florian Beeres - Florian Eitel - Florian Klink - Florian Kohrt +- Francesco Mazzoli - Francesco Occhipinti - François Gannaz - Frederik Elwert @@ -112,6 +115,7 @@ - Heiko Schlittermann - Henrik Tramberend - Henry de Valence +- Herwig Stuetz - Hubert Plociniczak - Ian Max Andolina - Igor Khorlo @@ -119,7 +123,6 @@ - Ilya V. Portnov - Ivan Trubach - Ivo Clarysse -- Jared Lander - J. B. Rainsberger - J. Lewis Muir - Jaime Marquínez Ferrándiz @@ -131,22 +134,24 @@ - Jan Schulz - Jan Tojnar - Jan-Otto Kröpke +- Jared Lander - Jason Ronallo - Jeff Arnold - Jeff Runningen - Jens Getreu - Jens Petersen +- Jérémy Bobbio - Jeroen de Haas - Jerry Sky - Jesse Rosenthal - Joe Hermaszewski - Joe Hillenbrand - John KetzerX +- John Luke Bentley - John MacFarlane - John Muccigrosso -- John Luke Bentley -- Jonas Smedegaard - Jonas Scholl +- Jonas Smedegaard - Jonathan Daugherty - Jose Luis Duran - José de Mattos Neto @@ -157,7 +162,6 @@ - Juliette Fourcot - Juliusz Gonera - Justin Bogner -- Jérémy Bobbio - Karl Pettersson - Keiichiro Shikano - Kelsey Hightower @@ -165,7 +169,6 @@ - Konstantin Zudov - Kristof Bastiaensen - Krystof Beuermann -- Herwig Stuetz - Lars-Dominik Braun - Laurent P. René de Cotret - Leif Metcalf @@ -201,6 +204,7 @@ - Michael Snoyman - Michael Thompson - Mike Tzou +- Milan Bracke - MinRK - Morton Fox - Nathan Gass @@ -222,8 +226,8 @@ - Owen McGrath - Pablo Rodríguez - Pascal Wagler -- Paul Tilley - Paul Rivier +- Paul Tilley - Paulo Tanimoto - Pete Ryland - Peter Fabinksi @@ -233,6 +237,7 @@ - Phillip Alday - Prayag Verma - Puneeth Chaganti +- Quinn - Ralf Stephan - Raniere Silva - Raymond Ehlers @@ -241,6 +246,7 @@ - Roman Beránek - RyanGlScott - Salim B +- Samuel Tardieu - Sascha Wilde - Scott Morrison - Sebastian Talmon @@ -253,8 +259,10 @@ - Sidarth Kapur - Sidharth Kapur - Simon Hengel +- Simon Schuster - Stefan Dresselhaus - Sumit Sahrawat +- TEC - Tarik Graba - Tatiana Porras - Thenaesh Elango @@ -266,12 +274,12 @@ - Tiziano Müller - Todd Sifleet - Tom Leese -- Tristan de Cacqueray - Tristan Stenner +- Tristan de Cacqueray - Uli Köhler - Urs Liska -- Václav Zeman - Václav Haisman +- Václav Zeman - Vaibhav Sagar - Vanessa McHale - Vasily Alferov @@ -279,8 +287,8 @@ - Viktor Kronvall - Vincent - Vlad Hanciuta -- Wandmalfarbe - Waldir Pimenta +- Wandmalfarbe - Wikiwide - William Lupton - Winnie Hellmann @@ -299,10 +307,11 @@ - chinapedia - cholonam - csforste -- dbecher-ito - d-dorazio +- dbecher-ito - ebiim - favonia +- hseg - infinity0x - jeongminkim-islab - kaizshang91 @@ -310,14 +319,14 @@ - lwolfsonkin - mbrackeantidot - mt_caret -- nkalvi - niszet +- nkalvi - nuew - obcat - oltolm - oquechy -- quasicomputational - qerub +- quasicomputational - robabla - roblabla - rodja.trappe @@ -326,11 +335,10 @@ - takahashim - taotieren - tecosaur -- TEC - tgkokk - the-solipsist -- timo-a - thsutton +- timo-a - vijayphoenix - wiefling - wuffi diff --git a/MANUAL.txt b/MANUAL.txt --- a/MANUAL.txt +++ b/MANUAL.txt @@ -1,7 +1,7 @@ --- title: Pandoc User's Guide author: John MacFarlane -date: October 22, 2021 +date: October 30, 2021 --- # Synopsis diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,13 +1,104 @@ # Revision history for pandoc -## pandoc 2.15 (NODATE) +## pandoc 2.16 (2021-10-31) + * Switch back from HsYAML to yaml for parsing YAML metadata (#6084). + HsYAML is around 20 times slower in parsing large YAML bibliographies. + In addition, HsYAML is not being actively maintained. This sets us back + in our attempts to free ourselves from C dependencies (#4535). But I + don't see a good alternative until a faster pure Haskell parser is available. + Notes: + + + We've removed the FromYAML instances for all types that had them, since + this is a HsYAML-specific typeclass [API change]. (The yaml package just + uses From/ToJSON instead of having a dedicated From/ToYAML class.) + + Unlike HsYAML (in the configuration we were using), yaml parses 'Y', 'N', + 'Yes', 'No', 'On', 'Off' as boolean values. Users may need to quote these + when they are meant to be interpreted as strings. Similarly, 'null' is + parsed as a YAML null value (and will be treated as an empty string by + pandoc rather than the string 'null'). Quoting it will force it to be + interpreted as a string. + + Some tests had to be adjusted accordingly. + + Pandoc now behaves in a more useful way when the YAML metadata contains + escaping errors: instead of just failng silently and falling back to + some other interpretation of the section, it raises a YAML parsing error. + + * Markdown writer: Ensure that special values are quoted in YAML metadata. + These include "Y", "yes", "on", and "off", which are now (with yaml library) + considered boolean values, as well as "null". + + * Change JSON encodings of some types. + + + For LineEnding use lowercase constructors, e.g. `crlf`, `native`. + + For HTMLSlideVariant use lowercase constructors. + + For ReaderOptions use e.g. `default-image-extension` + instead of `readerDefaultImageExtension` for field names. + + For Extension, use e.g. `tex_math_dollars` instead of + `Ext_tex_math_dollars` as constructor. + + For Extensions, use an array of Extensions, instead of + an object wrapping the tag `Extensions` and an integer. + (The integer representation is not supposed to be part of the + public API.) + + For Opt, use field names like `tab-stop` instead of `optTabStop`. + + * Docx writer: + + + Add IDs to native_numbering test (Tristan Stenner). + + Move ": " out of the caption bookmark (Tristan Stenner). + This is needed so that native references to the figure are included as + "As seen in Figure X, it is..." instead of "As seen in [Figure: X, it is..." + + * Lua (Albert Krewinkel, except as noted): + + + Use hslua module abstraction where possible. + + Fix placement of tests for Block elements in pandoc module tests + + Increase strictness when getting attribute keys + + Re-add `t` and `tag` property to Attr values. + Removal of these properties from Attr values was a regression. + + Fix `pandoc.utils.stringify` regression. The `pandoc.utils.stringify` + function returned empty strings when called with a string argument. + + Fix a copy/paste bug in Lua marshalling code (John MacFarlane, #7639). + This caused links to be changed to figures when Lua filters changed + link properties. + + Re-add `content` property to Link elements (#7647). + This was a regression introduced in version 2.15. + + Generate constants in module pandoc programmatically. + + Marshal SimpleTable, ListAttributes, Citation, and Block values as + userdata objects. Properties of Block values are marshalled lazily, + which generally improves performance considerably. Script users may also + notice the following differences: + + - Block element properties can no longer be accessed by numerical + indexing of the `.c` field. The `.c` property now serves as an alias + for `.content`, so some filter that used this undocumented method + for property access may continue to work, while others will need to + be updated and use proper property names. + - The marshalled Block elements now have a `show` method, and a + `__tostring` metamethod. Both return the Haskell string + representation of the element. + - Block values now have the Lua type `userdata` instead of `table`. + + * Add a short guide to pandoc's sources (Albert Krewinkel). + + * Fix epub files in epub reader tests, so that they are valid + according to epubcheck (#7586). + + * Allow time 1.13. + + * Require latest skylighting (0.12.1). + + * Fix build on GHC 9.2 (Joseph C. Sible). + + * Fix trypandoc so it builds with aeson > 2. + + +## pandoc 2.15 (2021-10-23) + * Add `--sandbox` option (#5045). - + Add sandbox feature for readers. When this option is used, - readers and writers only have access to input files (and - other files specified directly on command line). This restriction - is enforced in the type system. + + Add sandbox feature. When this option is used, readers and writers + only have access to input files (and other files specified directly on + command line). This restriction is enforced in the type system. + Filters, PDF production, custom writers are unaffected. This feature only insulates the actual readers and writers, not the pipeline around them in Text.Pandoc.App. diff --git a/data/pandoc.lua b/data/pandoc.lua --- a/data/pandoc.lua +++ b/data/pandoc.lua @@ -45,125 +45,19 @@ -- @section -- @local ---- Create a new indexing function. --- @param template function template --- @param indices list of indices, starting with the most deeply nested --- @return newly created function --- @local -function make_indexing_function(template, ...) - local indices = {...} - local loadstring = loadstring or load - local bracketed = {} - for i = 1, #indices do - local idx = indices[#indices - i + 1] - bracketed[i] = type(idx) == 'number' - and string.format('[%d]', idx) - or string.format('.%s', idx) - end - local fnstr = string.format('return ' .. template, table.concat(bracketed)) - return assert(loadstring(fnstr))() -end - ---- Create accessor functions using a function template. --- @param fn_template function template in which '%s' is replacd with indices --- @param accessors list of accessors --- @return mapping from accessor names to accessor functions --- @local -local function create_accessor_functions (fn_template, accessors) - local res = {} - function add_accessors(acc, ...) - if type(acc) == 'string' then - res[acc] = make_indexing_function(fn_template, ...) - elseif type(acc) == 'table' and #acc == 0 and next(acc) then - -- Named substructure: the given names are accessed via the substructure, - -- but the accessors are also added to the result table, enabling direct - -- access from the parent element. Mainly used for `attr`. - local name, substructure = next(acc) - res[name] = make_indexing_function(fn_template, ...) - for _, subname in ipairs(substructure) do - res[subname] = make_indexing_function(fn_template, subname, ...) - end - else - for i = 1, #(acc or {}) do - add_accessors(acc[i], i, ...) - end - end - end - add_accessors(accessors) - return res -end - ---- Get list of top-level fields from field descriptor table. --- E.g.: `top_level_fields{'foo', {bar='baz'}, {'qux', 'quux'}}` --- gives {'foo, 'bar', 'qux', 'quux'} --- @local -local function top_level_fields (fields) - local result = List:new{} - for _, v in ipairs(fields) do - if type(v) == 'string' then - table.insert(result, v) - elseif type(v) == 'table' and #v == 0 and next(v) then - table.insert(result, (next(v))) - else - result:extend(top_level_fields(v)) - end - end - return result -end - ---- Creates a function which behaves like next, but respects field names. --- @local -local function make_next_function (fields) - local field_indices = {} - for i, f in ipairs(fields) do - field_indices[f] = i - end - - return function (t, field) - local raw_idx = field == nil and 0 or field_indices[field] - local next_field = fields[raw_idx + 1] - return next_field, t[next_field] - end -end - --- Create a new table which allows to access numerical indices via accessor -- functions. -- @local -local function create_accessor_behavior (tag, accessors) +local function create_accessor_behavior (tag) local behavior = {tag = tag} - behavior.getters = create_accessor_functions( - 'function (x) return x.c%s end', - accessors - ) - behavior.setters = create_accessor_functions( - 'function (x, v) x.c%s = v end', - accessors - ) behavior.__eq = utils.equals behavior.__index = function(t, k) - if getmetatable(t).getters[k] then - return getmetatable(t).getters[k](t) - elseif k == "t" then + if k == "t" then return getmetatable(t)["tag"] - else - return getmetatable(t)[k] end end - behavior.__newindex = function(t, k, v) - if getmetatable(t).setters[k] then - getmetatable(t).setters[k](t, v) - else - rawset(t, k, v) - end - end behavior.__pairs = function (t) - if accessors == nil then - return next, t - end - local iterable_fields = type(accessors) == 'string' - and {accessors} - or top_level_fields(accessors) - return make_next_function(iterable_fields), t + return next, t end return behavior end @@ -242,8 +136,8 @@ -- @param fn Function to be called when constructing a new element -- @param accessors names to use as accessors for numerical fields -- @return function that constructs a new element -function AstElement:create_constructor(tag, fn, accessors) - local constr = self:make_subtype(tag, create_accessor_behavior(tag, accessors)) +function AstElement:create_constructor(tag, fn) + local constr = self:make_subtype(tag, create_accessor_behavior(tag)) function constr:new(...) return setmetatable(fn(...), self.behavior) end @@ -273,22 +167,6 @@ end end ---- Ensure that the given object is a definition pair, convert if necessary. --- @local -local function ensureDefinitionPairs (pair) - local inlines = ensureInlineList(pair[1] or {}) - local blocks = ensureList(pair[2] or {}):map(ensureList) - return {inlines, blocks} -end - ---- Try hard to turn the arguments into an Attr object. -local function ensureAttr(attr) - if type(attr) == 'userdata' then - return attr - end - return M.Attr(attr) -end - ------------------------------------------------------------------------ -- Meta -- @section Meta @@ -363,367 +241,5 @@ function M.MetaBool(bool) return bool end - ------------------------------------------------------------------------- --- Blocks --- @section Block - ---- Block elements -M.Block = AstElement:make_subtype'Block' -M.Block.behavior.clone = M.types.clone.Block - ---- 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 = ensureList(content)} end, - "content" -) - ---- Creates a bullet (i.e. unordered) list. --- @function BulletList --- @tparam {{Block,...},...} content list of items --- @treturn Block bullet list element -M.BulletList = M.Block:create_constructor( - "BulletList", - function(content) return {c = ensureList(content):map(ensureList)} end, - "content" -) - ---- Creates a code block element --- @function CodeBlock --- @tparam string text code string --- @tparam[opt] Attr attr element attributes --- @treturn Block code block element -M.CodeBlock = M.Block:create_constructor( - "CodeBlock", - function(text, attr) return {c = {ensureAttr(attr), text}} end, - {{attr = {"identifier", "classes", "attributes"}}, "text"} -) - ---- Creates a definition list, containing terms and their explanation. --- @function DefinitionList --- @tparam {{{Inline,...},{{Block,...}}},...} content list of items --- @treturn Block definition list element -M.DefinitionList = M.Block:create_constructor( - "DefinitionList", - function(content) - return {c = ensureList(content):map(ensureDefinitionPairs)} - end, - "content" -) - ---- Creates a div element --- @function Div --- @tparam {Block,...} content block content --- @tparam[opt] Attr attr element attributes --- @treturn Block div element -M.Div = M.Block:create_constructor( - "Div", - function(content, attr) - return {c = {ensureAttr(attr), ensureList(content)}} - end, - {{attr = {"identifier", "classes", "attributes"}}, "content"} -) - ---- Creates a header element. --- @function Header --- @tparam int level header level --- @tparam {Inline,...} content inline content --- @tparam[opt] Attr attr element attributes --- @treturn Block header element -M.Header = M.Block:create_constructor( - "Header", - function(level, content, attr) - return {c = {level, ensureAttr(attr), ensureInlineList(content)}} - end, - {"level", {attr = {"identifier", "classes", "attributes"}}, "content"} -) - ---- Creates a horizontal rule. --- @function HorizontalRule --- @treturn Block horizontal rule -M.HorizontalRule = M.Block:create_constructor( - "HorizontalRule", - function() return {} end -) - ---- Creates a line block element. --- @function LineBlock --- @tparam {{Inline,...},...} content inline content --- @treturn Block line block element -M.LineBlock = M.Block:create_constructor( - "LineBlock", - function(content) return {c = ensureList(content):map(ensureInlineList)} end, - "content" -) - ---- 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 ordered list element -M.OrderedList = M.Block:create_constructor( - "OrderedList", - function(items, listAttributes) - listAttributes = listAttributes or M.ListAttributes() - return {c = {listAttributes, ensureList(items):map(ensureList)}} - end, - {{listAttributes = {"start", "style", "delimiter"}}, "content"} -) - ---- Creates a para element. --- @function Para --- @tparam {Inline,...} content inline content --- @treturn Block paragraph element -M.Para = M.Block:create_constructor( - "Para", - function(content) return {c = ensureInlineList(content)} end, - "content" -) - ---- Creates a plain element. --- @function Plain --- @tparam {Inline,...} content inline content --- @treturn Block plain element -M.Plain = M.Block:create_constructor( - "Plain", - function(content) return {c = ensureInlineList(content)} end, - "content" -) - ---- Creates a raw content block of the specified format. --- @function RawBlock --- @tparam string format format of content --- @tparam string text string content --- @treturn Block raw block element -M.RawBlock = M.Block:create_constructor( - "RawBlock", - function(format, text) return {c = {format, text}} end, - {"format", "text"} -) - ---- Creates a table element. --- @function Table --- @tparam Caption caption table caption --- @tparam {ColSpec,...} colspecs column alignments and widths --- @tparam TableHead head table head --- @tparam {TableBody,..} bodies table bodies --- @treturn TableFoot foot table foot --- @tparam[opt] Attr attr attributes -M.Table = M.Block:create_constructor( - "Table", - function(caption, colspecs, head, bodies, foot, attr) - return { - c = { - ensureAttr(attr), - caption, - List:new(colspecs), - head, - List:new(bodies), - foot - } - } - end, - {"attr", "caption", "colspecs", "head", "bodies", "foot"} -) - - ------------------------------------------------------------------------- --- Element components --- @section components - --- Monkey-patch setters for `attr` fields to be more forgiving in the input that --- results in a valid Attr value. -function augment_attr_setter (setters) - if setters.attr then - local orig = setters.attr - setters.attr = function(k, v) - orig(k, ensureAttr(v)) - end - end -end -for _, blk in pairs(M.Block.constructor) do - augment_attr_setter(blk.behavior.setters) -end - --- Citation -M.Citation = AstElement:make_subtype'Citation' -M.Citation.behavior.clone = M.types.clone.Citation - ---- 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 hash hash number -function M.Citation:new (id, mode, prefix, suffix, note_num, hash) - return { - id = id, - mode = mode, - prefix = ensureList(prefix or {}), - suffix = ensureList(suffix or {}), - note_num = note_num or 0, - hash = hash or 0, - } -end - --- ListAttributes -M.ListAttributes = AstElement:make_subtype 'ListAttributes' -M.ListAttributes.behavior.clone = M.types.clone.ListAttributes - ---- Creates a set of list attributes. --- @function ListAttributes --- @tparam[opt] integer start number of the first list item --- @tparam[opt] string style style used for list numbering --- @tparam[opt] DefaultDelim|Period|OneParen|TwoParens delimiter delimiter of list numbers --- @treturn table list attributes table -function M.ListAttributes:new (start, style, delimiter) - start = start or 1 - style = style or 'DefaultStyle' - delimiter = delimiter or 'DefaultDelim' - return {start, style, delimiter} -end -M.ListAttributes.behavior._field_names = {start = 1, style = 2, delimiter = 3} -M.ListAttributes.behavior.__eq = utils.equals -M.ListAttributes.behavior.__index = function (t, k) - return rawget(t, getmetatable(t)._field_names[k]) or - getmetatable(t)[k] -end -M.ListAttributes.behavior.__newindex = function (t, k, v) - if getmetatable(t)._field_names[k] then - rawset(t, getmetatable(t)._field_names[k], v) - else - rawset(t, k, v) - end -end -M.ListAttributes.behavior.__pairs = function(t) - local field_names = M.ListAttributes.behavior._field_names - local fields = {} - for name, i in pairs(field_names) do - fields[i] = name - end - return make_next_function(fields), t, nil -end - --- --- Legacy and compatibility types --- - ---- Creates a simple (old style) table element. --- @function SimpleTable --- @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 table element -M.SimpleTable = function(caption, aligns, widths, headers, rows) - return { - caption = ensureInlineList(caption), - aligns = List:new(aligns), - widths = List:new(widths), - headers = List:new(headers), - rows = List:new(rows), - tag = "SimpleTable", - t = "SimpleTable", - } -end - - ------------------------------------------------------------------------- --- Constants --- @section constants - ---- Author name is mentioned in the text. --- @see Citation --- @see Cite -M.AuthorInText = "AuthorInText" - ---- Author name is suppressed. --- @see Citation --- @see Cite -M.SuppressAuthor = "SuppressAuthor" - ---- Default citation style is used. --- @see Citation --- @see Cite -M.NormalCitation = "NormalCitation" - ---- Table cells aligned left. --- @see Table -M.AlignLeft = "AlignLeft" - ---- Table cells right-aligned. --- @see Table -M.AlignRight = "AlignRight" - ---- Table cell content is centered. --- @see Table -M.AlignCenter = "AlignCenter" - ---- Table cells are alignment is unaltered. --- @see Table -M.AlignDefault = "AlignDefault" - ---- Default list number delimiters are used. --- @see OrderedList -M.DefaultDelim = "DefaultDelim" - ---- List numbers are delimited by a period. --- @see OrderedList -M.Period = "Period" - ---- List numbers are delimited by a single parenthesis. --- @see OrderedList -M.OneParen = "OneParen" - ---- List numbers are delimited by a double parentheses. --- @see OrderedList -M.TwoParens = "TwoParens" - ---- List are numbered in the default style --- @see OrderedList -M.DefaultStyle = "DefaultStyle" - ---- List items are numbered as examples. --- @see OrderedList -M.Example = "Example" - ---- List are numbered using decimal integers. --- @see OrderedList -M.Decimal = "Decimal" - ---- List are numbered using lower-case roman numerals. --- @see OrderedList -M.LowerRoman = "LowerRoman" - ---- List are numbered using upper-case roman numerals --- @see OrderedList -M.UpperRoman = "UpperRoman" - ---- List are numbered using lower-case alphabetic characters. --- @see OrderedList -M.LowerAlpha = "LowerAlpha" - ---- List are numbered using upper-case alphabetic characters. --- @see OrderedList -M.UpperAlpha = "UpperAlpha" - ------------------------------------------------------------------------- --- Functions which have moved to different modules -M.sha1 = utils.sha1 return M diff --git a/man/pandoc.1 b/man/pandoc.1 --- a/man/pandoc.1 +++ b/man/pandoc.1 @@ -1,7 +1,7 @@ '\" t -.\" Automatically generated by Pandoc 2.14.2 +.\" Automatically generated by Pandoc 2.16 .\" -.TH "Pandoc User\[cq]s Guide" "" "October 22, 2021" "pandoc 2.15" "" +.TH "Pandoc User\[cq]s Guide" "" "October 30, 2021" "pandoc 2.16" "" .hy .SH NAME pandoc - general markup converter @@ -554,13 +554,14 @@ pandoc uses a level-1 heading to render the document title. .TP \f[B]\f[CB]--base-header-level=\f[B]\f[R]\f[I]NUMBER\f[R] -\f[I]Deprecated. Use \f[CI]--shift-heading-level-by\f[I]=X instead, -where X = NUMBER - 1.\f[R] Specify the base level for headings (defaults -to 1). +\f[I]Deprecated. +Use \f[CI]--shift-heading-level-by\f[I]=X instead, where X = NUMBER - +1.\f[R] Specify the base level for headings (defaults to 1). .TP \f[B]\f[CB]--strip-empty-paragraphs\f[B]\f[R] -\f[I]Deprecated. Use the \f[CI]+empty_paragraphs\f[I] extension -instead.\f[R] Ignore paragraphs with no content. +\f[I]Deprecated. +Use the \f[CI]+empty_paragraphs\f[I] extension instead.\f[R] Ignore +paragraphs with no content. This option is useful for converting word processing documents where users have used empty paragraphs to create inter-paragraph space. .TP @@ -776,8 +777,8 @@ .TP \f[B]\f[CB]-D\f[B]\f[R] \f[I]FORMAT\f[R], \f[B]\f[CB]--print-default-template=\f[B]\f[R]\f[I]FORMAT\f[R] Print the system default template for an output \f[I]FORMAT\f[R]. -(See \f[C]-t\f[R] for a list of possible \f[I]FORMAT\f[R]s.) Templates -in the user data directory are ignored. +(See \f[C]-t\f[R] for a list of possible \f[I]FORMAT\f[R]s.) +Templates in the user data directory are ignored. This option may be used with \f[C]-o\f[R]/\f[C]--output\f[R] to redirect output to a file, but \f[C]-o\f[R]/\f[C]--output\f[R] must come before \f[C]--print-default-template\f[R] on the command line. @@ -805,8 +806,8 @@ \f[B]\f[CB]--dpi\f[B]\f[R]=\f[I]NUMBER\f[R] Specify the default dpi (dots per inch) value for conversion from pixels to inch/centimeters and vice versa. -(Technically, the correct term would be ppi: pixels per inch.) The -default is 96dpi. +(Technically, the correct term would be ppi: pixels per inch.) +The default is 96dpi. When images contain information about dpi internally, the encoded value is used instead of the default specified by this option. .TP @@ -1012,8 +1013,8 @@ \f[B]\f[CB]--markdown-headings=setext\f[B]\f[R]|\f[B]\f[CB]atx\f[B]\f[R] Specify whether to use ATX-style (\f[C]#\f[R]-prefixed) or Setext-style (underlined) headings for level 1 and 2 headings in Markdown output. -(The default is \f[C]atx\f[R].) ATX-style headings are always used for -levels 3+. +(The default is \f[C]atx\f[R].) +ATX-style headings are always used for levels 3+. This option also affects Markdown cells in \f[C]ipynb\f[R] output. .TP \f[B]\f[CB]--atx-headers\f[B]\f[R] @@ -1433,10 +1434,11 @@ The style is controlled by a CSL stylesheet specified using the \f[C]--csl\f[R] option or the \f[C]csl\f[R] field in metadata. (If no stylesheet is specified, the \f[C]chicago-author-date\f[R] style -will be used by default.) The citation processing transformation may be -applied before or after filters or Lua filters (see \f[C]--filter\f[R], -\f[C]--lua-filter\f[R]): these transformations are applied in the order -they appear on the command line. +will be used by default.) +The citation processing transformation may be applied before or after +filters or Lua filters (see \f[C]--filter\f[R], \f[C]--lua-filter\f[R]): +these transformations are applied in the order they appear on the +command line. For more information, see the section on Citations. .TP \f[B]\f[CB]--bibliography=\f[B]\f[R]\f[I]FILE\f[R] @@ -1451,8 +1453,8 @@ \f[B]\f[CB]--csl=\f[B]\f[R]\f[I]FILE\f[R] Set the \f[C]csl\f[R] field in the document\[cq]s metadata to \f[I]FILE\f[R], overriding any value set in the metadata. -(This is equivalent to \f[C]--metadata csl=FILE\f[R].) If \f[I]FILE\f[R] -is a URL, it will be fetched via HTTP. +(This is equivalent to \f[C]--metadata csl=FILE\f[R].) +If \f[I]FILE\f[R] is a URL, it will be fetched via HTTP. If \f[I]FILE\f[R] is not found relative to the working directory, it will be sought in the resource path (see \f[C]--resource-path\f[R]) and finally in the \f[C]csl\f[R] subdirectory of the pandoc user data @@ -1462,8 +1464,8 @@ Set the \f[C]citation-abbreviations\f[R] field in the document\[cq]s metadata to \f[I]FILE\f[R], overriding any value set in the metadata. (This is equivalent to -\f[C]--metadata citation-abbreviations=FILE\f[R].) If \f[I]FILE\f[R] is -a URL, it will be fetched via HTTP. +\f[C]--metadata citation-abbreviations=FILE\f[R].) +If \f[I]FILE\f[R] is a URL, it will be fetched via HTTP. If \f[I]FILE\f[R] is not found relative to the working directory, it will be sought in the resource path (see \f[C]--resource-path\f[R]) and finally in the \f[C]csl\f[R] subdirectory of the pandoc user data @@ -2451,8 +2453,9 @@ \f[C]title-meta\f[R], \f[C]author-meta\f[R], and \f[C]date-meta\f[R] variables. (By default these are set automatically, based on \f[C]title\f[R], -\f[C]author\f[R], and \f[C]date\f[R].) The page title in HTML is set by -\f[C]pagetitle\f[R], which is equal to \f[C]title\f[R] by default. +\f[C]author\f[R], and \f[C]date\f[R].) +The page title in HTML is set by \f[C]pagetitle\f[R], which is equal to +\f[C]title\f[R] by default. .RE .TP \f[B]\f[CB]subtitle\f[B]\f[R] @@ -3148,8 +3151,9 @@ The markdown reader and writer make by far the most use of extensions. Extensions only used by them are therefore covered in the section Pandoc\[cq]s Markdown below (See Markdown variants for -\f[C]commonmark\f[R] and \f[C]gfm\f[R].) In the following, extensions -that also work for other formats are covered. +\f[C]commonmark\f[R] and \f[C]gfm\f[R].) +In the following, extensions that also work for other formats are +covered. .PP Note that markdown extensions added to the \f[C]ipynb\f[R] format affect Markdown cells in Jupyter notebooks (as do command-line options like @@ -3932,8 +3936,8 @@ If highlighting is supported for your output format and language, then the code block above will appear highlighted, with numbered lines. (To see which languages are supported, type -\f[C]pandoc --list-highlight-languages\f[R].) Otherwise, the code block -above will appear as follows: +\f[C]pandoc --list-highlight-languages\f[R].) +Otherwise, the code block above will appear as follows: .IP .nf \f[C] @@ -4365,7 +4369,8 @@ \f[R] .fi .PP -Trouble! Here pandoc (like other Markdown implementations) will treat +Trouble! +Here pandoc (like other Markdown implementations) will treat \f[C]{ my code block }\f[R] as the second paragraph of item two, and not as a code block. .PP @@ -4645,9 +4650,10 @@ widths determined by the number of dashes in the line separating the table header from the table body. (For example \f[C]---|-\f[R] would make the first column 3/4 and the -second column 1/4 of the full text width.) On the other hand, if no -lines are wider than column width, then cell contents will not be -wrapped, and the cells will be sized to their contents. +second column 1/4 of the full text width.) +On the other hand, if no lines are wider than column width, then cell +contents will not be wrapped, and the cells will be sized to their +contents. .PP Note: pandoc also recognizes pipe tables of the following form, as can be produced by Emacs\[cq] orgtbl-mode: @@ -4680,8 +4686,9 @@ .PP it will be parsed as bibliographic information, not regular text. (It will be used, for example, in the title of standalone LaTeX or HTML -output.) The block may contain just a title, a title and an author, or -all three elements. +output.) +The block may contain just a title, a title and an author, or all three +elements. If you want to include an author but no title, or a title and a date but no author, you need a blank line: .IP @@ -4804,8 +4811,8 @@ .fi .PP Just be sure that the YAML file begins with \f[C]---\f[R] and ends with -\f[C]---\f[R] or \f[C]...\f[R].) Alternatively, you can use the -\f[C]--metadata-file\f[R] option. +\f[C]---\f[R] or \f[C]...\f[R].) +Alternatively, you can use the \f[C]--metadata-file\f[R] option. Using that approach however, you cannot reference content (like footnotes) from the main markdown input document. .PP @@ -4814,10 +4821,10 @@ Metadata can contain lists and objects (nested arbitrarily), but all string scalars will be interpreted as Markdown. Fields with names ending in an underscore will be ignored by pandoc. -(They may be given a role by external processors.) Field names must not -be interpretable as YAML numbers or boolean values (so, for example, -\f[C]yes\f[R], \f[C]True\f[R], and \f[C]15\f[R] cannot be used as field -names). +(They may be given a role by external processors.) +Field names must not be interpretable as YAML numbers or boolean values +(so, for example, \f[C]yes\f[R], \f[C]True\f[R], and \f[C]15\f[R] cannot +be used as field names). .PP A document may contain multiple metadata blocks. If two metadata blocks attempt to set the same field, the value from the @@ -5077,9 +5084,9 @@ must be escaped with backslashes. (This is to prevent accidental superscripting and subscripting through the ordinary use of \f[C]\[ti]\f[R] and \f[C]\[ha]\f[R], and also bad -interactions with footnotes.) Thus, if you want the letter P with `a -cat' in subscripts, use \f[C]P\[ti]a\[rs] cat\[ti]\f[R], not -\f[C]P\[ti]a cat\[ti]\f[R]. +interactions with footnotes.) +Thus, if you want the letter P with `a cat' in subscripts, use +\f[C]P\[ti]a\[rs] cat\[ti]\f[R], not \f[C]P\[ti]a cat\[ti]\f[R]. .SS Verbatim .PP To make a short span of text verbatim, put it inside backticks: @@ -5503,10 +5510,10 @@ The link consists of link text in square brackets, followed by a label in square brackets. (There cannot be space between the two unless the -\f[C]spaced_reference_links\f[R] extension is enabled.) The link -definition consists of the bracketed label, followed by a colon and a -space, followed by the URL, and optionally (after a space) a link title -either in quotes or in parentheses. +\f[C]spaced_reference_links\f[R] extension is enabled.) +The link definition consists of the bracketed label, followed by a colon +and a space, followed by the URL, and optionally (after a space) a link +title either in quotes or in parentheses. The label must not be parseable as a citation (assuming the \f[C]citations\f[R] extension is enabled): citations take precedence over link labels. @@ -6516,8 +6523,9 @@ By default, pandoc will use the Chicago Manual of Style author-date format. (You can override this default by copying a CSL style of your choice to -\f[C]default.csl\f[R] in your user data directory.) The CSL project -provides further information on finding and editing styles. +\f[C]default.csl\f[R] in your user data directory.) +The CSL project provides further information on finding and editing +styles. .PP The \f[C]--citation-abbreviations\f[R] option (or the \f[C]citation-abbreviations\f[R] metadata field) may be used to specify @@ -6564,7 +6572,8 @@ be rendered in parentheses. In-text citations (such as \f[C]\[at]foo [p. 33]\f[R]) will be rendered without parentheses. -(A comma will be added if appropriate.) Thus: +(A comma will be added if appropriate.) +Thus: .IP .nf \f[C] @@ -6677,7 +6686,8 @@ as hyperlinks. (If an entry contains a DOI, PMCID, PMID, or URL, but none of these fields are rendered by the style, then the title, or in the absence of a -title the whole entry, will be hyperlinked.) Defaults to true. +title the whole entry, will be hyperlinked.) +Defaults to true. .TP \f[B]\f[CB]lang\f[B]\f[R] The \f[C]lang\f[R] field will affect how the style is localized, for @@ -6780,9 +6790,9 @@ \f[C]w3.org\f[R] (for Slidy). (These paths can be changed by setting the \f[C]slidy-url\f[R], \f[C]slideous-url\f[R], \f[C]revealjs-url\f[R], or \f[C]s5-url\f[R] -variables; see Variables for HTML slides, above.) For DZSlides, the -(relatively short) JavaScript and CSS are included in the file by -default. +variables; see Variables for HTML slides, above.) +For DZSlides, the (relatively short) JavaScript and CSS are included in +the file by default. .PP With all HTML slide formats, the \f[C]--self-contained\f[R] option can be used to produce a single file that contains all of the data necessary @@ -7258,8 +7268,8 @@ .TP \f[B]\f[CB]date\f[B]\f[R] A string value in \f[C]YYYY-MM-DD\f[R] format. -(Only the year is necessary.) Pandoc will attempt to convert other -common date formats. +(Only the year is necessary.) +Pandoc will attempt to convert other common date formats. .TP \f[B]\f[CB]lang\f[B]\f[R] (or legacy: \f[B]\f[CB]language\f[B]\f[R]) A string value in BCP 47 format. @@ -7904,8 +7914,9 @@ Copyright 2006\[en]2021 John MacFarlane (jgm\[at]berkeley.edu). Released under the GPL, version 2 or greater. This software carries no warranty of any kind. -(See COPYRIGHT for full copyright and warranty notices.) For a full list -of contributors, see the file AUTHORS.md in the pandoc source code. +(See COPYRIGHT for full copyright and warranty notices.) +For a full list of contributors, see the file AUTHORS.md in the pandoc +source code. .PP The Pandoc source code and all documentation may be downloaded from . diff --git a/pandoc.cabal b/pandoc.cabal --- a/pandoc.cabal +++ b/pandoc.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: pandoc -version: 2.15 +version: 2.16 build-type: Simple license: GPL-2.0-or-later license-file: COPYING.md @@ -522,7 +522,6 @@ library import: common-options build-depends: Glob >= 0.7 && < 0.11, - HsYAML >= 0.2 && < 0.3, JuicyPixels >= 3.1.6.1 && < 3.4, SHA >= 1.6 && < 1.7, aeson >= 0.7 && < 2.1, @@ -567,12 +566,14 @@ network-uri >= 2.6 && < 2.8, pandoc-types >= 1.22.1 && < 1.23, parsec >= 3.1 && < 3.2, + pretty >= 1.1 && < 1.2, + pretty-show >= 1.10 && < 1.11, process >= 1.2.3 && < 1.7, random >= 1 && < 1.3, safe >= 0.3.18 && < 0.4, scientific >= 0.3 && < 0.4, - skylighting >= 0.12 && < 0.13, - skylighting-core >= 0.12 && < 0.13, + skylighting >= 0.12.1 && < 0.13, + skylighting-core >= 0.12.1 && < 0.13, split >= 0.2 && < 0.3, syb >= 0.1 && < 0.8, tagsoup >= 0.14.6 && < 0.15, @@ -580,15 +581,14 @@ texmath >= 0.12.3.2 && < 0.12.4, text >= 1.1.1.0 && < 1.3, text-conversions >= 0.3 && < 0.4, - time >= 1.5 && < 1.13, + time >= 1.5 && < 1.14, + unicode-collation >= 0.1.1 && < 0.2, unicode-transforms >= 0.3 && < 0.4, xml >= 1.3.12 && < 1.4, xml-conduit >= 1.9.1.1 && < 1.10, - unicode-collation >= 0.1.1 && < 0.2, + yaml >= 0.11 && < 0.12, zip-archive >= 0.2.3.4 && < 0.5, - zlib >= 0.5 && < 0.7, - pretty-show >= 1.10 && < 1.11, - pretty >= 1.1 && < 1.2 + zlib >= 0.5 && < 0.7 if os(windows) && arch(i386) build-depends: basement >= 0.0.10, foundation >= 0.0.23 @@ -781,6 +781,7 @@ Text.Pandoc.Lua.Marshaling.CommonState, Text.Pandoc.Lua.Marshaling.Context, Text.Pandoc.Lua.Marshaling.List, + Text.Pandoc.Lua.Marshaling.ListAttributes, Text.Pandoc.Lua.Marshaling.PandocError, Text.Pandoc.Lua.Marshaling.ReaderOptions, Text.Pandoc.Lua.Marshaling.SimpleTable, @@ -857,7 +858,7 @@ tasty-lua >= 1.0 && < 1.1, tasty-quickcheck >= 0.8 && < 0.11, text >= 1.1.1.0 && < 1.3, - time >= 1.5 && < 1.13, + time >= 1.5 && < 1.14, xml >= 1.3.12 && < 1.4, zip-archive >= 0.2.3.4 && < 0.5 other-modules: Tests.Old diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs --- a/src/Text/Pandoc/App.hs +++ b/src/Text/Pandoc/App.hs @@ -217,7 +217,7 @@ case optMetadataFiles opts of [] -> return mempty paths -> mconcat <$> - mapM (\path -> do raw <- readFileLazy path + mapM (\path -> do raw <- readFileStrict path yamlToMeta readerOpts (Just path) raw) paths let transforms = (case optShiftHeadingLevelBy opts of diff --git a/src/Text/Pandoc/App/Opt.hs b/src/Text/Pandoc/App/Opt.hs --- a/src/Text/Pandoc/App/Opt.hs +++ b/src/Text/Pandoc/App/Opt.hs @@ -29,7 +29,7 @@ import Control.Monad.State.Strict (StateT, modify, gets) import System.FilePath ( addExtension, (), takeExtension, takeDirectory ) import System.Directory ( canonicalizePath ) -import Data.Char (isLower, toLower) +import Data.Char (toLower) import Data.Maybe (fromMaybe) import GHC.Generics hiding (Meta) import Text.Pandoc.Filter (Filter (..)) @@ -40,11 +40,10 @@ ReferenceLocation (EndOfDocument), ObfuscationMethod (NoObfuscation), CiteMethod (Citeproc)) -import Text.Pandoc.Class (readFileLazy, fileExists, setVerbosity, report, +import Text.Pandoc.Class (readFileStrict, fileExists, setVerbosity, report, PandocMonad(lookupEnv), getUserDataDir) import Text.Pandoc.Error (PandocError (PandocParseError, PandocSomeError)) -import Text.Pandoc.Shared (camelCaseStrToHyphenated, defaultUserDataDir, - findM, ordNub) +import Text.Pandoc.Shared (defaultUserDataDir, findM, ordNub) import qualified Text.Pandoc.Parsing as P import Text.Pandoc.Readers.Metadata (yamlMap) import Text.Pandoc.Class.PandocPure @@ -54,21 +53,18 @@ import qualified Data.Text as T import qualified Data.Map as M import Text.Pandoc.Definition (Meta(..), MetaValue(..)) -import Data.Aeson (defaultOptions, Options(..)) +import Data.Aeson (defaultOptions, Options(..), Result(..), fromJSON, camelTo2) import Data.Aeson.TH (deriveJSON) import Control.Applicative ((<|>)) -import Data.YAML +import Data.Yaml -- | The type of line-endings to be used when writing plain-text. data LineEnding = LF | CRLF | Native deriving (Show, Generic) -instance FromYAML LineEnding where - parseYAML = withStr "LineEnding" $ \t -> - case T.toLower t of - "lf" -> return LF - "crlf" -> return CRLF - "native" -> return Native - _ -> fail $ "Unknown line ending type " ++ show t +-- see https://github.com/jgm/pandoc/pull/4083 +-- using generic deriving caused long compilation times +$(deriveJSON + defaultOptions{ constructorTagModifier = map toLower } ''LineEnding) -- | How to handle output blocks in ipynb. data IpynbOutput = @@ -77,13 +73,8 @@ | IpynbOutputBest deriving (Show, Generic) -instance FromYAML IpynbOutput where - parseYAML = withStr "LineEnding" $ \t -> - case t of - "none" -> return IpynbOutputNone - "all" -> return IpynbOutputAll - "best" -> return IpynbOutputBest - _ -> fail $ "Unknown ipynb output type " ++ show t +$(deriveJSON + defaultOptions{ fieldLabelModifier = map toLower . drop 11 } ''IpynbOutput) -- | Data structure for command line options. data Opt = Opt @@ -163,10 +154,16 @@ , optSandbox :: Bool } deriving (Generic, Show) -instance FromYAML (Opt -> Opt) where - parseYAML (Mapping _ _ m) = chain doOpt (M.toList m) - parseYAML n = failAtNode n "Expected a mapping" +$(deriveJSON + defaultOptions{ fieldLabelModifier = camelTo2 '-' . drop 3 } ''Opt) +instance FromJSON (Opt -> Opt) where + parseJSON (Object m) = + case fromJSON (Object m) of + Error err' -> fail err' + Success (m' :: M.Map Text Value) -> chain doOpt (M.toList m') + parseJSON _ = fail "Expected a mapping" + data DefaultsState = DefaultsState { curDefaults :: Maybe FilePath -- currently parsed file @@ -174,22 +171,21 @@ } deriving (Show) instance (PandocMonad m, MonadIO m) - => FromYAML (Opt -> StateT DefaultsState m Opt) where - parseYAML (Mapping _ _ m) = do - let opts = M.mapKeys toText m - dataDir <- case M.lookup "data-dir" opts of - Nothing -> return Nothing - Just v -> Just . unpack <$> parseYAML v - f <- parseOptions (M.toList m) - case M.lookup "defaults" opts of - Just v -> do - g <- parseDefaults v dataDir - return $ g >=> f >=> resolveVarsInOpt - Nothing -> return $ f >=> resolveVarsInOpt - where - toText (Scalar _ (SStr s)) = s - toText _ = "" - parseYAML n = failAtNode n "Expected a mapping" + => FromJSON (Opt -> StateT DefaultsState m Opt) where + parseJSON (Object o) = + case fromJSON (Object o) of + Error err' -> fail err' + Success (opts :: M.Map Text Value) -> do + dataDir <- case M.lookup "data-dir" opts of + Nothing -> return Nothing + Just v -> Just . unpack <$> parseJSON v + f <- parseOptions (M.toList opts) + case M.lookup "defaults" opts of + Just v -> do + g <- parseDefaults v dataDir + return $ g >=> f >=> resolveVarsInOpt + Nothing -> return $ f >=> resolveVarsInOpt + parseJSON _ = fail "Expected a mapping" resolveVarsInOpt :: forall m. (PandocMonad m, MonadIO m) => Opt -> StateT DefaultsState m Opt @@ -303,7 +299,7 @@ parseDefaults :: (PandocMonad m, MonadIO m) - => Node Pos + => Value -> Maybe FilePath -> Parser (Opt -> StateT DefaultsState m Opt) parseDefaults n dataDir = parseDefsNames n >>= \ds -> return $ \o -> do @@ -322,11 +318,11 @@ "Error: Circular defaults file reference in " ++ "'" ++ defsParent ++ "'" else foldM applyDefaults o defsChildren - where parseDefsNames x = (parseYAML x >>= \xs -> return $ map unpack xs) - <|> (parseYAML x >>= \x' -> return [unpack x']) + where parseDefsNames x = (parseJSON x >>= \xs -> return $ map unpack xs) + <|> (parseJSON x >>= \x' -> return [unpack x']) parseOptions :: Monad m - => [(Node Pos, Node Pos)] + => [(Text, Value)] -> Parser (Opt -> StateT DefaultsState m Opt) parseOptions ns = do f <- chain doOpt' ns @@ -336,269 +332,267 @@ chain f = foldM g id where g o n = f n >>= \o' -> return $ o' . o -doOpt' :: (Node Pos, Node Pos) -> Parser (Opt -> Opt) -doOpt' (k',v) = do - k <- parseStringKey k' +doOpt' :: (Text, Value) -> Parser (Opt -> Opt) +doOpt' (k,v) = do case k of "defaults" -> return id - _ -> doOpt (k',v) + _ -> doOpt (k,v) -doOpt :: (Node Pos, Node Pos) -> Parser (Opt -> Opt) -doOpt (k',v) = do - k <- parseStringKey k' +doOpt :: (Text, Value) -> Parser (Opt -> Opt) +doOpt (k,v) = do case k of "tab-stop" -> - parseYAML v >>= \x -> return (\o -> o{ optTabStop = x }) + parseJSON v >>= \x -> return (\o -> o{ optTabStop = x }) "preserve-tabs" -> - parseYAML v >>= \x -> return (\o -> o{ optPreserveTabs = x }) + parseJSON v >>= \x -> return (\o -> o{ optPreserveTabs = x }) "standalone" -> - parseYAML v >>= \x -> return (\o -> o{ optStandalone = x }) + parseJSON v >>= \x -> return (\o -> o{ optStandalone = x }) "table-of-contents" -> - parseYAML v >>= \x -> return (\o -> o{ optTableOfContents = x }) + parseJSON v >>= \x -> return (\o -> o{ optTableOfContents = x }) "toc" -> - parseYAML v >>= \x -> return (\o -> o{ optTableOfContents = x }) + parseJSON v >>= \x -> return (\o -> o{ optTableOfContents = x }) "from" -> - parseYAML v >>= \x -> return (\o -> o{ optFrom = x }) + parseJSON v >>= \x -> return (\o -> o{ optFrom = x }) "reader" -> - parseYAML v >>= \x -> return (\o -> o{ optFrom = x }) + parseJSON v >>= \x -> return (\o -> o{ optFrom = x }) "to" -> - parseYAML v >>= \x -> return (\o -> o{ optTo = x }) + parseJSON v >>= \x -> return (\o -> o{ optTo = x }) "writer" -> - parseYAML v >>= \x -> return (\o -> o{ optTo = x }) + parseJSON v >>= \x -> return (\o -> o{ optTo = x }) "shift-heading-level-by" -> - parseYAML v >>= \x -> return (\o -> o{ optShiftHeadingLevelBy = x }) + parseJSON v >>= \x -> return (\o -> o{ optShiftHeadingLevelBy = x }) "template" -> - parseYAML v >>= \x -> return (\o -> o{ optTemplate = unpack <$> x }) + parseJSON v >>= \x -> return (\o -> o{ optTemplate = unpack <$> x }) "variables" -> - parseYAML v >>= \x -> return (\o -> o{ optVariables = + parseJSON v >>= \x -> return (\o -> o{ optVariables = x <> optVariables o }) -- Note: x comes first because <> for Context is left-biased union -- and we want to favor later default files. See #5988. "metadata" -> yamlToMeta v >>= \x -> return (\o -> o{ optMetadata = optMetadata o <> x }) "metadata-files" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optMetadataFiles = optMetadataFiles o <> map unpack x }) "metadata-file" -> -- allow either a list or a single value - (parseYAML v >>= \x -> return (\o -> o{ optMetadataFiles = + (parseJSON v >>= \x -> return (\o -> o{ optMetadataFiles = optMetadataFiles o <> map unpack x })) <|> - (parseYAML v >>= \x -> + (parseJSON v >>= \x -> return (\o -> o{ optMetadataFiles = optMetadataFiles o <>[unpack x] })) "output-file" -> - parseYAML v >>= \x -> return (\o -> o{ optOutputFile = unpack <$> x }) + parseJSON v >>= \x -> return (\o -> o{ optOutputFile = unpack <$> x }) "input-files" -> - parseYAML v >>= \x -> return (\o -> o{ optInputFiles = + parseJSON v >>= \x -> return (\o -> o{ optInputFiles = optInputFiles o <> (map unpack <$> x) }) "input-file" -> -- allow either a list or a single value - (parseYAML v >>= \x -> return (\o -> o{ optInputFiles = + (parseJSON v >>= \x -> return (\o -> o{ optInputFiles = optInputFiles o <> (map unpack <$> x) })) <|> - (parseYAML v >>= \x -> return (\o -> o{ optInputFiles = + (parseJSON v >>= \x -> return (\o -> o{ optInputFiles = optInputFiles o <> ((\z -> [unpack z]) <$> x) })) "number-sections" -> - parseYAML v >>= \x -> return (\o -> o{ optNumberSections = x }) + parseJSON v >>= \x -> return (\o -> o{ optNumberSections = x }) "number-offset" -> - parseYAML v >>= \x -> return (\o -> o{ optNumberOffset = x }) + parseJSON v >>= \x -> return (\o -> o{ optNumberOffset = x }) "section-divs" -> - parseYAML v >>= \x -> return (\o -> o{ optSectionDivs = x }) + parseJSON v >>= \x -> return (\o -> o{ optSectionDivs = x }) "incremental" -> - parseYAML v >>= \x -> return (\o -> o{ optIncremental = x }) + parseJSON v >>= \x -> return (\o -> o{ optIncremental = x }) "self-contained" -> - parseYAML v >>= \x -> return (\o -> o{ optSelfContained = x }) + parseJSON v >>= \x -> return (\o -> o{ optSelfContained = x }) "html-q-tags" -> - parseYAML v >>= \x -> return (\o -> o{ optHtmlQTags = x }) + parseJSON v >>= \x -> return (\o -> o{ optHtmlQTags = x }) "highlight-style" -> - parseYAML v >>= \x -> return (\o -> o{ optHighlightStyle = x }) + parseJSON v >>= \x -> return (\o -> o{ optHighlightStyle = x }) "syntax-definition" -> - (parseYAML v >>= \x -> + (parseJSON v >>= \x -> return (\o -> o{ optSyntaxDefinitions = optSyntaxDefinitions o <> map unpack x })) <|> - (parseYAML v >>= \x -> + (parseJSON v >>= \x -> return (\o -> o{ optSyntaxDefinitions = optSyntaxDefinitions o <> [unpack x] })) "syntax-definitions" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optSyntaxDefinitions = optSyntaxDefinitions o <> map unpack x }) "top-level-division" -> - parseYAML v >>= \x -> return (\o -> o{ optTopLevelDivision = x }) + parseJSON v >>= \x -> return (\o -> o{ optTopLevelDivision = x }) "html-math-method" -> - parseYAML v >>= \x -> return (\o -> o{ optHTMLMathMethod = x }) + parseJSON v >>= \x -> return (\o -> o{ optHTMLMathMethod = x }) "abbreviations" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optAbbreviations = unpack <$> x }) "reference-doc" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optReferenceDoc = unpack <$> x }) "epub-subdirectory" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optEpubSubdirectory = unpack x }) "epub-metadata" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optEpubMetadata = unpack <$> x }) "epub-fonts" -> - parseYAML v >>= \x -> return (\o -> o{ optEpubFonts = optEpubFonts o <> + parseJSON v >>= \x -> return (\o -> o{ optEpubFonts = optEpubFonts o <> map unpack x }) "epub-chapter-level" -> - parseYAML v >>= \x -> return (\o -> o{ optEpubChapterLevel = x }) + parseJSON v >>= \x -> return (\o -> o{ optEpubChapterLevel = x }) "epub-cover-image" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optEpubCoverImage = unpack <$> x }) "toc-depth" -> - parseYAML v >>= \x -> return (\o -> o{ optTOCDepth = x }) + parseJSON v >>= \x -> return (\o -> o{ optTOCDepth = x }) "dump-args" -> - parseYAML v >>= \x -> return (\o -> o{ optDumpArgs = x }) + parseJSON v >>= \x -> return (\o -> o{ optDumpArgs = x }) "ignore-args" -> - parseYAML v >>= \x -> return (\o -> o{ optIgnoreArgs = x }) + parseJSON v >>= \x -> return (\o -> o{ optIgnoreArgs = x }) "verbosity" -> - parseYAML v >>= \x -> return (\o -> o{ optVerbosity = x }) + parseJSON v >>= \x -> return (\o -> o{ optVerbosity = x }) "trace" -> - parseYAML v >>= \x -> return (\o -> o{ optTrace = x }) + parseJSON v >>= \x -> return (\o -> o{ optTrace = x }) "log-file" -> - parseYAML v >>= \x -> return (\o -> o{ optLogFile = unpack <$> x }) + parseJSON v >>= \x -> return (\o -> o{ optLogFile = unpack <$> x }) "fail-if-warnings" -> - parseYAML v >>= \x -> return (\o -> o{ optFailIfWarnings = x }) + parseJSON v >>= \x -> return (\o -> o{ optFailIfWarnings = x }) "reference-links" -> - parseYAML v >>= \x -> return (\o -> o{ optReferenceLinks = x }) + parseJSON v >>= \x -> return (\o -> o{ optReferenceLinks = x }) "reference-location" -> - parseYAML v >>= \x -> return (\o -> o{ optReferenceLocation = x }) + parseJSON v >>= \x -> return (\o -> o{ optReferenceLocation = x }) "dpi" -> - parseYAML v >>= \x -> return (\o -> o{ optDpi = x }) + parseJSON v >>= \x -> return (\o -> o{ optDpi = x }) "wrap" -> - parseYAML v >>= \x -> return (\o -> o{ optWrap = x }) + parseJSON v >>= \x -> return (\o -> o{ optWrap = x }) "columns" -> - parseYAML v >>= \x -> return (\o -> o{ optColumns = x }) + parseJSON v >>= \x -> return (\o -> o{ optColumns = x }) "filters" -> - parseYAML v >>= \x -> return (\o -> o{ optFilters = optFilters o <> x }) + parseJSON v >>= \x -> return (\o -> o{ optFilters = optFilters o <> x }) "citeproc" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> if x then return (\o -> o{ optFilters = CiteprocFilter : optFilters o }) else return id "email-obfuscation" -> - parseYAML v >>= \x -> return (\o -> o{ optEmailObfuscation = x }) + parseJSON v >>= \x -> return (\o -> o{ optEmailObfuscation = x }) "identifier-prefix" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optIdentifierPrefix = x }) "strip-empty-paragraphs" -> - parseYAML v >>= \x -> return (\o -> o{ optStripEmptyParagraphs = x }) + parseJSON v >>= \x -> return (\o -> o{ optStripEmptyParagraphs = x }) "indented-code-classes" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optIndentedCodeClasses = x }) "data-dir" -> - parseYAML v >>= \x -> return (\o -> o{ optDataDir = unpack <$> x }) + parseJSON v >>= \x -> return (\o -> o{ optDataDir = unpack <$> x }) "cite-method" -> - parseYAML v >>= \x -> return (\o -> o{ optCiteMethod = x }) + parseJSON v >>= \x -> return (\o -> o{ optCiteMethod = x }) "listings" -> - parseYAML v >>= \x -> return (\o -> o{ optListings = x }) + parseJSON v >>= \x -> return (\o -> o{ optListings = x }) "pdf-engine" -> - parseYAML v >>= \x -> return (\o -> o{ optPdfEngine = unpack <$> x }) + parseJSON v >>= \x -> return (\o -> o{ optPdfEngine = unpack <$> x }) "pdf-engine-opts" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optPdfEngineOpts = map unpack x }) "pdf-engine-opt" -> - (parseYAML v >>= \x -> + (parseJSON v >>= \x -> return (\o -> o{ optPdfEngineOpts = map unpack x })) <|> - (parseYAML v >>= \x -> + (parseJSON v >>= \x -> return (\o -> o{ optPdfEngineOpts = [unpack x] })) "slide-level" -> - parseYAML v >>= \x -> return (\o -> o{ optSlideLevel = x }) + parseJSON v >>= \x -> return (\o -> o{ optSlideLevel = x }) "atx-headers" -> - parseYAML v >>= \x -> return (\o -> o{ optSetextHeaders = not x }) + parseJSON v >>= \x -> return (\o -> o{ optSetextHeaders = not x }) "markdown-headings" -> - parseYAML v >>= \x -> return (\o -> + parseJSON v >>= \x -> return (\o -> case T.toLower x of "atx" -> o{ optSetextHeaders = False } "setext" -> o{ optSetextHeaders = True } _ -> o) "ascii" -> - parseYAML v >>= \x -> return (\o -> o{ optAscii = x }) + parseJSON v >>= \x -> return (\o -> o{ optAscii = x }) "default-image-extension" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optDefaultImageExtension = x }) "extract-media" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optExtractMedia = unpack <$> x }) "track-changes" -> - parseYAML v >>= \x -> return (\o -> o{ optTrackChanges = x }) + parseJSON v >>= \x -> return (\o -> o{ optTrackChanges = x }) "file-scope" -> - parseYAML v >>= \x -> return (\o -> o{ optFileScope = x }) + parseJSON v >>= \x -> return (\o -> o{ optFileScope = x }) "title-prefix" -> - parseYAML v >>= \x -> return (\o -> o{ optTitlePrefix = x, + parseJSON v >>= \x -> return (\o -> o{ optTitlePrefix = x, optStandalone = True }) "css" -> - (parseYAML v >>= \x -> return (\o -> o{ optCss = optCss o <> + (parseJSON v >>= \x -> return (\o -> o{ optCss = optCss o <> map unpack x })) <|> - (parseYAML v >>= \x -> return (\o -> o{ optCss = optCss o <> + (parseJSON v >>= \x -> return (\o -> o{ optCss = optCss o <> [unpack x] })) "bibliography" -> - (parseYAML v >>= \x -> return (\o -> + (parseJSON v >>= \x -> return (\o -> o{ optBibliography = optBibliography o <> map unpack x })) <|> - (parseYAML v >>= \x -> return (\o -> + (parseJSON v >>= \x -> return (\o -> o{ optBibliography = optBibliography o <> [unpack x] })) "csl" -> - parseYAML v >>= \x -> return (\o -> o{ optCSL = unpack <$> x }) + parseJSON v >>= \x -> return (\o -> o{ optCSL = unpack <$> x }) "citation-abbreviations" -> - parseYAML v >>= \x -> return (\o -> o{ optCitationAbbreviations = + parseJSON v >>= \x -> return (\o -> o{ optCitationAbbreviations = unpack <$> x }) "ipynb-output" -> - parseYAML v >>= \x -> return (\o -> o{ optIpynbOutput = x }) + parseJSON v >>= \x -> return (\o -> o{ optIpynbOutput = x }) "include-before-body" -> - (parseYAML v >>= \x -> + (parseJSON v >>= \x -> return (\o -> o{ optIncludeBeforeBody = optIncludeBeforeBody o <> map unpack x })) <|> - (parseYAML v >>= \x -> + (parseJSON v >>= \x -> return (\o -> o{ optIncludeBeforeBody = optIncludeBeforeBody o <> [unpack x] })) "include-after-body" -> - (parseYAML v >>= \x -> + (parseJSON v >>= \x -> return (\o -> o{ optIncludeAfterBody = optIncludeAfterBody o <> map unpack x })) <|> - (parseYAML v >>= \x -> + (parseJSON v >>= \x -> return (\o -> o{ optIncludeAfterBody = optIncludeAfterBody o <> [unpack x] })) "include-in-header" -> - (parseYAML v >>= \x -> + (parseJSON v >>= \x -> return (\o -> o{ optIncludeInHeader = optIncludeInHeader o <> map unpack x })) <|> - (parseYAML v >>= \x -> + (parseJSON v >>= \x -> return (\o -> o{ optIncludeInHeader = optIncludeInHeader o <> [unpack x] })) "resource-path" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optResourcePath = map unpack x <> optResourcePath o }) "request-headers" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optRequestHeaders = x }) "no-check-certificate" -> - parseYAML v >>= \x -> + parseJSON v >>= \x -> return (\o -> o{ optNoCheckCertificate = x }) "eol" -> - parseYAML v >>= \x -> return (\o -> o{ optEol = x }) + parseJSON v >>= \x -> return (\o -> o{ optEol = x }) "strip-comments" -> - parseYAML v >>= \x -> return (\o -> o { optStripComments = x }) + parseJSON v >>= \x -> return (\o -> o { optStripComments = x }) "sandbox" -> - parseYAML v >>= \x -> return (\o -> o { optSandbox = x }) - _ -> failAtNode k' $ "Unknown option " ++ show k + parseJSON v >>= \x -> return (\o -> o { optSandbox = x }) + _ -> fail $ "Unknown option " ++ show k -- | Defaults for command-line options. defaultOpts :: Opt @@ -679,18 +673,12 @@ , optSandbox = False } -parseStringKey :: Node Pos -> Parser Text -parseStringKey k = case k of - Scalar _ (SStr t) -> return t - Scalar _ _ -> failAtNode k "Non-string key" - _ -> failAtNode k "Non-scalar key" - -yamlToMeta :: Node Pos -> Parser Meta -yamlToMeta (Mapping _ _ m) = - either (fail . show) return $ runEverything (yamlMap pMetaString m) - where - pMetaString = pure . MetaString <$> P.manyChar P.anyChar - runEverything p = +yamlToMeta :: Value -> Parser Meta +yamlToMeta (Object o) = + either (fail . show) return $ runEverything (yamlMap pMetaString o) + where + pMetaString = pure . MetaString <$> P.manyChar P.anyChar + runEverything p = runPure (P.readWithM p (def :: P.ParserState) ("" :: Text)) >>= fmap (Meta . flip P.runF def) yamlToMeta _ = return mempty @@ -703,14 +691,12 @@ applyDefaults opt file = do setVerbosity $ optVerbosity opt modify $ \defsState -> defsState{ curDefaults = Just file } - inp <- readFileLazy file - case decode1 inp of + inp <- readFileStrict file + case decodeEither' inp of Right f -> f opt - Left (errpos, errmsg) -> throwError $ - PandocParseError $ T.pack $ - "Error parsing " ++ file ++ " line " ++ - show (posLine errpos) ++ " column " ++ - show (posColumn errpos) ++ ":\n" ++ errmsg + Left err' -> throwError $ + PandocParseError + $ T.pack $ Data.Yaml.prettyPrintParseException err' fullDefaultsPath :: (PandocMonad m, MonadIO m) => Maybe FilePath @@ -738,14 +724,3 @@ cyclic = any hasDuplicate where hasDuplicate xs = length (ordNub xs) /= length xs - --- see https://github.com/jgm/pandoc/pull/4083 --- using generic deriving caused long compilation times -$(deriveJSON - defaultOptions{ fieldLabelModifier = drop 11 . map toLower } ''IpynbOutput) -$(deriveJSON - defaultOptions{ fieldLabelModifier = map toLower } ''LineEnding) -$(deriveJSON - defaultOptions{ fieldLabelModifier = - camelCaseStrToHyphenated . dropWhile isLower - } ''Opt) diff --git a/src/Text/Pandoc/Citeproc.hs b/src/Text/Pandoc/Citeproc.hs --- a/src/Text/Pandoc/Citeproc.hs +++ b/src/Text/Pandoc/Citeproc.hs @@ -268,7 +268,7 @@ rs <- yamlToRefs idpred def{ readerExtensions = pandocExtensions } (T.unpack <$> mbfp) - (L.fromStrict raw) + raw return $ mapMaybe metaValueToReference rs -- assumes we walk in same order as query diff --git a/src/Text/Pandoc/Extensions.hs b/src/Text/Pandoc/Extensions.hs --- a/src/Text/Pandoc/Extensions.hs +++ b/src/Text/Pandoc/Extensions.hs @@ -40,31 +40,8 @@ import GHC.Generics (Generic) import Safe (readMay) import Text.Parsec -import Data.Aeson.TH (deriveJSON, defaultOptions) - -newtype Extensions = Extensions Integer - deriving (Show, Read, Eq, Ord, Data, Typeable, Generic) - -instance Semigroup Extensions where - (Extensions a) <> (Extensions b) = Extensions (a .|. b) -instance Monoid Extensions where - mempty = Extensions 0 - mappend = (<>) - -extensionsFromList :: [Extension] -> Extensions -extensionsFromList = foldr enableExtension emptyExtensions - -emptyExtensions :: Extensions -emptyExtensions = Extensions 0 - -extensionEnabled :: Extension -> Extensions -> Bool -extensionEnabled x (Extensions exts) = testBit exts (fromEnum x) - -enableExtension :: Extension -> Extensions -> Extensions -enableExtension x (Extensions exts) = Extensions (setBit exts (fromEnum x)) - -disableExtension :: Extension -> Extensions -> Extensions -disableExtension x (Extensions exts) = Extensions (clearBit exts (fromEnum x)) +import Data.Aeson.TH (deriveJSON) +import Data.Aeson -- | Individually selectable syntax extensions. data Extension = @@ -162,6 +139,40 @@ | Ext_yaml_metadata_block -- ^ YAML metadata block deriving (Show, Read, Enum, Eq, Ord, Bounded, Data, Typeable, Generic) +$(deriveJSON defaultOptions{ constructorTagModifier = drop 4 } ''Extension) + +newtype Extensions = Extensions Integer + deriving (Show, Read, Eq, Ord, Data, Typeable, Generic) + +instance Semigroup Extensions where + (Extensions a) <> (Extensions b) = Extensions (a .|. b) +instance Monoid Extensions where + mempty = Extensions 0 + mappend = (<>) + +instance FromJSON Extensions where + parseJSON = + return . foldr enableExtension emptyExtensions . fromJSON + +instance ToJSON Extensions where + toJSON exts = toJSON $ + [ext | ext <- [minBound..maxBound], extensionEnabled ext exts] + +extensionsFromList :: [Extension] -> Extensions +extensionsFromList = foldr enableExtension emptyExtensions + +emptyExtensions :: Extensions +emptyExtensions = Extensions 0 + +extensionEnabled :: Extension -> Extensions -> Bool +extensionEnabled x (Extensions exts) = testBit exts (fromEnum x) + +enableExtension :: Extension -> Extensions -> Extensions +enableExtension x (Extensions exts) = Extensions (setBit exts (fromEnum x)) + +disableExtension :: Extension -> Extensions -> Extensions +disableExtension x (Extensions exts) = Extensions (clearBit exts (fromEnum x)) + -- | Extensions to be used with pandoc-flavored markdown. pandocExtensions :: Extensions pandocExtensions = extensionsFromList @@ -618,5 +629,3 @@ '+' -> (ext : extsToEnable, extsToDisable) _ -> (extsToEnable, ext : extsToDisable) -$(deriveJSON defaultOptions ''Extension) -$(deriveJSON defaultOptions ''Extensions) diff --git a/src/Text/Pandoc/Filter.hs b/src/Text/Pandoc/Filter.hs --- a/src/Text/Pandoc/Filter.hs +++ b/src/Text/Pandoc/Filter.hs @@ -19,7 +19,7 @@ ) where import System.CPUTime (getCPUTime) -import Data.Aeson.TH (deriveJSON, defaultOptions) +import Data.Aeson import GHC.Generics (Generic) import Text.Pandoc.Class (report, getVerbosity, PandocMonad) import Text.Pandoc.Definition (Pandoc) @@ -29,7 +29,6 @@ import qualified Text.Pandoc.Filter.JSON as JSONFilter import qualified Text.Pandoc.Filter.Lua as LuaFilter import qualified Text.Pandoc.Filter.Path as Path -import Data.YAML import qualified Data.Text as T import System.FilePath (takeExtension) import Control.Applicative ((<|>)) @@ -42,9 +41,9 @@ | CiteprocFilter -- built-in citeproc deriving (Show, Generic) -instance FromYAML Filter where - parseYAML node = - (withMap "Filter" $ \m -> do +instance FromJSON Filter where + parseJSON node = + (withObject "Filter" $ \m -> do ty <- m .: "type" fp <- m .:? "path" let missingPath = fail $ "Expected 'path' for filter of type " ++ show ty @@ -55,7 +54,7 @@ "json" -> filterWithPath JSONFilter fp _ -> fail $ "Unknown filter type " ++ show (ty :: T.Text)) node <|> - (withStr "Filter" $ \t -> do + (withText "Filter" $ \t -> do let fp = T.unpack t if fp == "citeproc" then return CiteprocFilter @@ -64,6 +63,13 @@ ".lua" -> LuaFilter fp _ -> JSONFilter fp) node +instance ToJSON Filter where + toJSON CiteprocFilter = object [ "type" .= String "citeproc" ] + toJSON (LuaFilter fp) = object [ "type" .= String "lua", + "path" .= String (T.pack fp) ] + toJSON (JSONFilter fp) = object [ "type" .= String "json", + "path" .= String (T.pack fp) ] + -- | Modify the given document using a filter. applyFilters :: (PandocMonad m, MonadIO m) => ReaderOptions @@ -96,5 +102,3 @@ expandFilterPath (LuaFilter fp) = LuaFilter <$> Path.expandFilterPath fp expandFilterPath (JSONFilter fp) = JSONFilter <$> Path.expandFilterPath fp expandFilterPath CiteprocFilter = return CiteprocFilter - -$(deriveJSON defaultOptions ''Filter) diff --git a/src/Text/Pandoc/Logging.hs b/src/Text/Pandoc/Logging.hs --- a/src/Text/Pandoc/Logging.hs +++ b/src/Text/Pandoc/Logging.hs @@ -24,7 +24,6 @@ ) where import Control.Monad (mzero) -import Data.YAML (withStr, FromYAML(..)) import Data.Aeson import Data.Aeson.Encode.Pretty (Config (..), defConfig, encodePretty', keyOrder) @@ -52,13 +51,6 @@ "INFO" -> return INFO _ -> mzero parseJSON _ = mzero - -instance FromYAML Verbosity where - parseYAML = withStr "Verbosity" $ \case - "ERROR" -> return ERROR - "WARNING" -> return WARNING - "INFO" -> return INFO - _ -> mzero data LogMessage = SkippedContent Text SourcePos diff --git a/src/Text/Pandoc/Lua/Filter.hs b/src/Text/Pandoc/Lua/Filter.hs --- a/src/Text/Pandoc/Lua/Filter.hs +++ b/src/Text/Pandoc/Lua/Filter.hs @@ -14,6 +14,7 @@ -} module Text.Pandoc.Lua.Filter ( LuaFilterFunction , LuaFilter + , peekLuaFilter , runFilterFile , walkInlines , walkInlineLists @@ -68,20 +69,24 @@ newtype LuaFilter = LuaFilter (Map Name LuaFilterFunction) instance Peekable LuaFilter where - peek idx = do - let constrs = listOfInlinesFilterName - : listOfBlocksFilterName - : metaFilterName - : pandocFilterNames - ++ blockElementNames - ++ inlineElementNames - let go constr acc = do - Lua.getfield idx constr - filterFn <- registerFilterFunction - return $ case filterFn of - Nothing -> acc - Just fn -> Map.insert constr fn acc - LuaFilter <$!> foldrM go Map.empty constrs + peek = Lua.forcePeek . peekLuaFilter + +-- | Retrieves a LuaFilter object from the stack. +peekLuaFilter :: LuaError e => Peeker e LuaFilter +peekLuaFilter idx = do + let constrs = listOfInlinesFilterName + : listOfBlocksFilterName + : metaFilterName + : pandocFilterNames + ++ blockElementNames + ++ inlineElementNames + let go constr acc = Lua.liftLua $ do + Lua.getfield idx constr + filterFn <- registerFilterFunction + return $ case filterFn of + Nothing -> acc + Just fn -> Map.insert constr fn acc + LuaFilter <$!> foldrM go Map.empty constrs -- | Register the function at the top of the stack as a filter function in the -- registry. diff --git a/src/Text/Pandoc/Lua/Init.hs b/src/Text/Pandoc/Lua/Init.hs --- a/src/Text/Pandoc/Lua/Init.hs +++ b/src/Text/Pandoc/Lua/Init.hs @@ -83,13 +83,8 @@ -- stack. putConstructorsInRegistry :: PandocLua () putConstructorsInRegistry = liftPandocLua $ do - constrsToReg $ Pandoc.Pandoc mempty mempty - constrsToReg $ Pandoc.Str mempty - constrsToReg $ Pandoc.Para mempty constrsToReg $ Pandoc.Meta mempty constrsToReg $ Pandoc.MetaList mempty - constrsToReg $ Pandoc.Citation mempty mempty mempty Pandoc.AuthorInText 0 0 - putInReg "ListAttributes" -- used for ListAttributes type alias putInReg "List" -- pandoc.List putInReg "SimpleTable" -- helper for backward-compatible table handling where diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs @@ -19,33 +19,40 @@ module Text.Pandoc.Lua.Marshaling.AST ( peekAttr , peekBlock + , peekBlockFuzzy , peekBlocks + , peekBlocksFuzzy , peekCaption , peekCitation + , peekColSpec + , peekDefinitionItem , peekFormat , peekInline + , peekInlineFuzzy , peekInlines - , peekListAttributes + , peekInlinesFuzzy , peekMeta , peekMetaValue , peekPandoc , peekMathType , peekQuoteType - - , peekFuzzyInlines - , peekFuzzyBlocks + , peekTableBody + , peekTableHead + , peekTableFoot , pushAttr , pushBlock + , pushCitation , pushInline , pushListAttributes + , pushMeta , pushMetaValue , pushPandoc ) where import Control.Applicative ((<|>), optional) import Control.Monad.Catch (throwM) -import Control.Monad ((<$!>), (>=>)) +import Control.Monad ((<$!>)) import Data.Data (showConstr, toConstr) import Data.Text (Text) import Data.Version (Version) @@ -53,9 +60,11 @@ import HsLua.Module.Version (peekVersionFuzzy) import Text.Pandoc.Definition import Text.Pandoc.Error (PandocError (PandocLuaError)) -import Text.Pandoc.Lua.Util (pushViaConstr', pushViaConstructor) +import Text.Pandoc.Lua.Util (pushViaConstr') import Text.Pandoc.Lua.Marshaling.Attr (peekAttr, pushAttr) import Text.Pandoc.Lua.Marshaling.List (pushPandocList) +import Text.Pandoc.Lua.Marshaling.ListAttributes + (peekListAttributes, pushListAttributes) import qualified HsLua as Lua import qualified Text.Pandoc.Lua.Util as LuaUtil @@ -101,32 +110,35 @@ instance Pushable Block where push = pushBlock --- Inline -instance Pushable Inline where - push = pushInline - --- Citation -instance Pushable Citation where - push = pushCitation +typeCitation :: LuaError e => DocumentedType e Citation +typeCitation = deftype "Citation" [] + [ property "id" "citation ID / key" + (pushText, citationId) + (peekText, \citation cid -> citation{ citationId = cid }) + , property "mode" "citation mode" + (pushString . show, citationMode) + (peekRead, \citation mode -> citation{ citationMode = mode }) + , property "prefix" "citation prefix" + (pushInlines, citationPrefix) + (peekInlines, \citation prefix -> citation{ citationPrefix = prefix }) + , property "suffix" "citation suffix" + (pushInlines, citationSuffix) + (peekInlines, \citation suffix -> citation{ citationPrefix = suffix }) + , property "note_num" "note number" + (pushIntegral, citationNoteNum) + (peekIntegral, \citation noteNum -> citation{ citationNoteNum = noteNum }) + , property "hash" "hash number" + (pushIntegral, citationHash) + (peekIntegral, \citation hash -> citation{ citationHash = hash }) + , method $ defun "clone" ### return <#> udparam typeCitation "obj" "" + =#> functionResult pushCitation "Citation" "copy of obj" + ] pushCitation :: LuaError e => Pusher e Citation -pushCitation (Citation cid prefix suffix mode noteNum hash) = - pushViaConstr' "Citation" - [ push cid, push mode, push prefix, push suffix, push noteNum, push hash - ] +pushCitation = pushUD typeCitation peekCitation :: LuaError e => Peeker e Citation -peekCitation = fmap (retrieving "Citation") - . typeChecked "table" Lua.istable $ \idx -> do - idx' <- liftLua $ absindex idx - Citation - <$!> peekFieldRaw peekText "id" idx' - <*> peekFieldRaw (peekList peekInline) "prefix" idx' - <*> peekFieldRaw (peekList peekInline) "suffix" idx' - <*> peekFieldRaw peekRead "mode" idx' - <*> peekFieldRaw peekIntegral "note_num" idx' - <*> peekFieldRaw peekIntegral "hash" idx' - +peekCitation = peekUD typeCitation instance Pushable Alignment where push = Lua.pushString . show @@ -220,75 +232,207 @@ Nothing -> peekUntagged _ -> failPeek "could not get meta value" +typeBlock :: LuaError e => DocumentedType e Block +typeBlock = deftype "Block" + [ operation Eq $ lambda + ### liftPure2 (==) + <#> parameter peekBlockFuzzy "Block" "a" "" + <#> parameter peekBlockFuzzy "Block" "b" "" + =#> boolResult "whether the two values are equal" + , operation Tostring $ lambda + ### liftPure show + <#> udparam typeBlock "self" "" + =#> functionResult pushString "string" "Haskell representation" + ] + [ possibleProperty "attr" "element attributes" + (pushAttr, \case + CodeBlock attr _ -> Actual attr + Div attr _ -> Actual attr + Header _ attr _ -> Actual attr + Table attr _ _ _ _ _ -> Actual attr + _ -> Absent) + (peekAttr, \case + CodeBlock _ code -> Actual . flip CodeBlock code + Div _ blks -> Actual . flip Div blks + Header lvl _ blks -> Actual . (\attr -> Header lvl attr blks) + Table _ c cs h bs f -> Actual . (\attr -> Table attr c cs h bs f) + _ -> const Absent) + , possibleProperty "bodies" "table bodies" + (pushPandocList pushTableBody, \case + Table _ _ _ _ bs _ -> Actual bs + _ -> Absent) + (peekList peekTableBody, \case + Table attr c cs h _ f -> Actual . (\bs -> Table attr c cs h bs f) + _ -> const Absent) + , possibleProperty "caption" "element caption" + (pushCaption, \case {Table _ capt _ _ _ _ -> Actual capt; _ -> Absent}) + (peekCaption, \case + Table attr _ cs h bs f -> Actual . (\c -> Table attr c cs h bs f) + _ -> const Absent) + , possibleProperty "colspecs" "column alignments and widths" + (pushPandocList pushColSpec, \case + Table _ _ cs _ _ _ -> Actual cs + _ -> Absent) + (peekList peekColSpec, \case + Table attr c _ h bs f -> Actual . (\cs -> Table attr c cs h bs f) + _ -> const Absent) + , possibleProperty "content" "element content" + (pushContent, getBlockContent) + (peekContent, setBlockContent) + , possibleProperty "foot" "table foot" + (pushTableFoot, \case {Table _ _ _ _ _ f -> Actual f; _ -> Absent}) + (peekTableFoot, \case + Table attr c cs h bs _ -> Actual . (\f -> Table attr c cs h bs f) + _ -> const Absent) + , possibleProperty "format" "format of raw content" + (pushFormat, \case {RawBlock f _ -> Actual f; _ -> Absent}) + (peekFormat, \case + RawBlock _ txt -> Actual . (`RawBlock` txt) + _ -> const Absent) + , possibleProperty "head" "table head" + (pushTableHead, \case {Table _ _ _ h _ _ -> Actual h; _ -> Absent}) + (peekTableHead, \case + Table attr c cs _ bs f -> Actual . (\h -> Table attr c cs h bs f) + _ -> const Absent) + , possibleProperty "level" "heading level" + (pushIntegral, \case {Header lvl _ _ -> Actual lvl; _ -> Absent}) + (peekIntegral, \case + Header _ attr inlns -> Actual . \lvl -> Header lvl attr inlns + _ -> const Absent) + , possibleProperty "listAttributes" "ordered list attributes" + (pushListAttributes, \case + OrderedList listAttr _ -> Actual listAttr + _ -> Absent) + (peekListAttributes, \case + OrderedList _ content -> Actual . (`OrderedList` content) + _ -> const Absent) + , possibleProperty "text" "text contents" + (pushText, getBlockText) + (peekText, setBlockText) + + , readonly "tag" "type of Block" + (pushString, showConstr . toConstr ) + + , alias "t" "tag" ["tag"] + , alias "c" "content" ["content"] + , alias "identifier" "element identifier" ["attr", "identifier"] + , alias "classes" "element classes" ["attr", "classes"] + , alias "attributes" "other element attributes" ["attr", "attributes"] + , alias "start" "ordered list start number" ["listAttributes", "start"] + , alias "style" "ordered list style" ["listAttributes", "style"] + , alias "delimiter" "numbering delimiter" ["listAttributes", "delimiter"] + + , method $ defun "clone" + ### return + <#> parameter peekBlock "Block" "block" "self" + =#> functionResult pushBlock "Block" "cloned Block" + + , method $ defun "show" + ### liftPure show + <#> parameter peekBlock "Block" "self" "" + =#> functionResult pushString "string" "Haskell string representation" + ] + where + boolResult = functionResult pushBool "boolean" + +getBlockContent :: Block -> Possible Content +getBlockContent = \case + -- inline content + Para inlns -> Actual $ ContentInlines inlns + Plain inlns -> Actual $ ContentInlines inlns + -- inline content + BlockQuote blks -> Actual $ ContentBlocks blks + Div _ blks -> Actual $ ContentBlocks blks + -- lines content + LineBlock lns -> Actual $ ContentLines lns + -- list items content + BulletList itms -> Actual $ ContentListItems itms + OrderedList _ itms -> Actual $ ContentListItems itms + -- definition items content + DefinitionList itms -> Actual $ ContentDefItems itms + _ -> Absent + +setBlockContent :: Block -> Content -> Possible Block +setBlockContent = \case + -- inline content + Para _ -> Actual . Para . inlineContent + Plain _ -> Actual . Plain . inlineContent + -- block content + BlockQuote _ -> Actual . BlockQuote . blockContent + Div attr _ -> Actual . Div attr . blockContent + -- lines content + LineBlock _ -> Actual . LineBlock . lineContent + -- list items content + BulletList _ -> Actual . BulletList . listItemContent + OrderedList la _ -> Actual . OrderedList la . listItemContent + -- definition items content + DefinitionList _ -> Actual . DefinitionList . defItemContent + _ -> const Absent + where + inlineContent = \case + ContentInlines inlns -> inlns + c -> throwM . PandocLuaError $ "expected Inlines, got " <> + contentTypeDescription c + blockContent = \case + ContentBlocks blks -> blks + ContentInlines inlns -> [Plain inlns] + c -> throwM . PandocLuaError $ "expected Blocks, got " <> + contentTypeDescription c + lineContent = \case + ContentLines lns -> lns + c -> throwM . PandocLuaError $ "expected list of lines, got " <> + contentTypeDescription c + defItemContent = \case + ContentDefItems itms -> itms + c -> throwM . PandocLuaError $ "expected definition items, got " <> + contentTypeDescription c + listItemContent = \case + ContentBlocks blks -> [blks] + ContentLines lns -> map ((:[]) . Plain) lns + ContentListItems itms -> itms + c -> throwM . PandocLuaError $ "expected list of items, got " <> + contentTypeDescription c + +getBlockText :: Block -> Possible Text +getBlockText = \case + CodeBlock _ lst -> Actual lst + RawBlock _ raw -> Actual raw + _ -> Absent + +setBlockText :: Block -> Text -> Possible Block +setBlockText = \case + CodeBlock attr _ -> Actual . CodeBlock attr + RawBlock f _ -> Actual . RawBlock f + _ -> const Absent + -- | Push a block element to the top of the Lua stack. pushBlock :: forall e. LuaError e => Block -> LuaE e () -pushBlock = \case - BlockQuote blcks -> pushViaConstructor @e "BlockQuote" blcks - BulletList items -> pushViaConstructor @e "BulletList" items - CodeBlock attr code -> pushViaConstr' @e "CodeBlock" - [ push code, pushAttr attr ] - DefinitionList items -> pushViaConstructor @e "DefinitionList" items - Div attr blcks -> pushViaConstr' @e "Div" - [push blcks, pushAttr attr] - Header lvl attr inlns -> pushViaConstr' @e "Header" - [push lvl, push inlns, pushAttr attr] - HorizontalRule -> pushViaConstructor @e "HorizontalRule" - LineBlock blcks -> pushViaConstructor @e "LineBlock" blcks - OrderedList lstAttr list -> pushViaConstr' @e "OrderedList" - [ push list, pushListAttributes @e lstAttr ] - Null -> pushViaConstructor @e "Null" - Para blcks -> pushViaConstructor @e "Para" blcks - Plain blcks -> pushViaConstructor @e "Plain" blcks - RawBlock f cs -> pushViaConstructor @e "RawBlock" f cs - Table attr blkCapt specs thead tbody tfoot -> - pushViaConstr' @e "Table" - [ pushCaption blkCapt, push specs, push thead, push tbody - , push tfoot, pushAttr attr] +pushBlock = pushUD typeBlock -- | Return the value at the given index as block if possible. peekBlock :: forall e. LuaError e => Peeker e Block -peekBlock = fmap (retrieving "Block") - . typeChecked "table" Lua.istable - $ \idx -> do - -- Get the contents of an AST element. - let mkBlock :: (a -> Block) -> Peeker e a -> Peek e Block - mkBlock f p = f <$!> peekFieldRaw p "c" idx - LuaUtil.getTag idx >>= \case - "BlockQuote" -> mkBlock BlockQuote peekBlocks - "BulletList" -> mkBlock BulletList (peekList peekBlocks) - "CodeBlock" -> mkBlock (uncurry CodeBlock) - (peekPair peekAttr peekText) - "DefinitionList" -> mkBlock DefinitionList - (peekList (peekPair peekInlines (peekList peekBlocks))) - "Div" -> mkBlock (uncurry Div) (peekPair peekAttr peekBlocks) - "Header" -> mkBlock (\(lvl, attr, lst) -> Header lvl attr lst) - (peekTriple peekIntegral peekAttr peekInlines) - "HorizontalRule" -> return HorizontalRule - "LineBlock" -> mkBlock LineBlock (peekList peekInlines) - "OrderedList" -> mkBlock (uncurry OrderedList) - (peekPair peekListAttributes (peekList peekBlocks)) - "Null" -> return Null - "Para" -> mkBlock Para peekInlines - "Plain" -> mkBlock Plain peekInlines - "RawBlock" -> mkBlock (uncurry RawBlock) - (peekPair peekFormat peekText) - "Table" -> mkBlock id - (retrieving "Table" . (liftLua . absindex >=> (\idx' -> cleanup $ do - attr <- liftLua (rawgeti idx' 1) *> peekAttr top - capt <- liftLua (rawgeti idx' 2) *> peekCaption top - cs <- liftLua (rawgeti idx' 3) *> peekList peekColSpec top - thead <- liftLua (rawgeti idx' 4) *> peekTableHead top - tbods <- liftLua (rawgeti idx' 5) *> peekList peekTableBody top - tfoot <- liftLua (rawgeti idx' 6) *> peekTableFoot top - return $! Table attr capt cs thead tbods tfoot))) - Name tag -> failPeek ("Unknown block type: " <> tag) +peekBlock = retrieving "Block" . peekUD typeBlock +-- | Retrieves a list of Block elements. peekBlocks :: LuaError e => Peeker e [Block] peekBlocks = peekList peekBlock peekInlines :: LuaError e => Peeker e [Inline] peekInlines = peekList peekInline +pushInlines :: LuaError e => Pusher e [Inline] +pushInlines = pushPandocList pushInline + +-- | Retrieves a single definition item from a the stack; it is expected +-- to be a pair of a list of inlines and a list of list of blocks. Uses +-- fuzzy parsing, i.e., tries hard to convert mismatching types into the +-- expected result. +peekDefinitionItem :: LuaError e => Peeker e ([Inline], [[Block]]) +peekDefinitionItem = peekPair peekInlinesFuzzy $ choice + [ peekList peekBlocksFuzzy + , \idx -> (:[]) <$!> peekBlocksFuzzy idx + ] + -- | Push Caption element pushCaption :: LuaError e => Caption -> LuaE e () pushCaption (Caption shortCaption longCaption) = do @@ -303,37 +447,48 @@ long <- peekFieldRaw peekBlocks "long" idx return $! Caption short long -peekColWidth :: LuaError e => Peeker e ColWidth -peekColWidth = retrieving "ColWidth" . \idx -> do - maybe ColWidthDefault ColWidth <$!> optional (peekRealFloat idx) +-- | Push a ColSpec value as a pair of Alignment and ColWidth. +pushColSpec :: LuaError e => Pusher e ColSpec +pushColSpec = pushPair (pushString . show) pushColWidth +-- | Peek a ColSpec value as a pair of Alignment and ColWidth. peekColSpec :: LuaError e => Peeker e ColSpec peekColSpec = peekPair peekRead peekColWidth -instance Pushable ColWidth where - push = \case - (ColWidth w) -> Lua.push w - ColWidthDefault -> Lua.pushnil +peekColWidth :: LuaError e => Peeker e ColWidth +peekColWidth = retrieving "ColWidth" . \idx -> do + maybe ColWidthDefault ColWidth <$!> optional (peekRealFloat idx) -instance Pushable Row where - push (Row attr cells) = Lua.push (attr, cells) +-- | Push a ColWidth value by pushing the width as a plain number, or +-- @nil@ for ColWidthDefault. +pushColWidth :: LuaError e => Pusher e ColWidth +pushColWidth = \case + (ColWidth w) -> Lua.push w + ColWidthDefault -> Lua.pushnil -instance Peekable Row where - peek = forcePeek . peekRow +-- | Push a table row as a pair of attr and the list of cells. +pushRow :: LuaError e => Pusher e Row +pushRow (Row attr cells) = + pushPair pushAttr (pushPandocList pushCell) (attr, cells) +-- | Push a table row from a pair of attr and the list of cells. peekRow :: LuaError e => Peeker e Row peekRow = ((uncurry Row) <$!>) . retrieving "Row" . peekPair peekAttr (peekList peekCell) -instance Pushable TableBody where - push (TableBody attr (RowHeadColumns rowHeadColumns) head' body) = do +-- | Pushes a 'TableBody' value as a Lua table with fields @attr@, +-- @row_head_columns@, @head@, and @body@. +pushTableBody :: LuaError e => Pusher e TableBody +pushTableBody (TableBody attr (RowHeadColumns rowHeadColumns) head' body) = do Lua.newtable LuaUtil.addField "attr" attr LuaUtil.addField "row_head_columns" rowHeadColumns LuaUtil.addField "head" head' LuaUtil.addField "body" body +-- | Retrieves a 'TableBody' value from a Lua table with fields @attr@, +-- @row_head_columns@, @head@, and @body@. peekTableBody :: LuaError e => Peeker e TableBody peekTableBody = fmap (retrieving "TableBody") . typeChecked "table" Lua.istable @@ -343,17 +498,25 @@ <*> peekFieldRaw (peekList peekRow) "head" idx <*> peekFieldRaw (peekList peekRow) "body" idx -instance Pushable TableHead where - push (TableHead attr rows) = Lua.push (attr, rows) +-- | Push a table head value as the pair of its Attr and rows. +pushTableHead :: LuaError e => Pusher e TableHead +pushTableHead (TableHead attr rows) = + pushPair pushAttr (pushPandocList pushRow) (attr, rows) +-- | Peek a table head value from a pair of Attr and rows. peekTableHead :: LuaError e => Peeker e TableHead peekTableHead = ((uncurry TableHead) <$!>) . retrieving "TableHead" . peekPair peekAttr (peekList peekRow) -instance Pushable TableFoot where - push (TableFoot attr cells) = Lua.push (attr, cells) +-- | Pushes a 'TableFoot' value as a pair of the Attr value and the list +-- of table rows. +pushTableFoot :: LuaError e => Pusher e TableFoot +pushTableFoot (TableFoot attr rows) = + pushPair pushAttr (pushPandocList pushRow) (attr, rows) +-- | Retrieves a 'TableFoot' value from a pair containing an Attr value +-- and a list of table rows. peekTableFoot :: LuaError e => Peeker e TableFoot peekTableFoot = ((uncurry TableFoot) <$!>) . retrieving "TableFoot" @@ -365,6 +528,8 @@ instance Peekable Cell where peek = forcePeek . peekCell +-- | Push a table cell as a table with fields @attr@, @alignment@, +-- @row_span@, @col_span@, and @contents@. pushCell :: LuaError e => Cell -> LuaE e () pushCell (Cell attr align (RowSpan rowSpan) (ColSpan colSpan) contents) = do Lua.newtable @@ -401,15 +566,49 @@ Str _ -> Actual . Str _ -> const Absent +-- | Helper type to represent all the different types a `content` +-- attribute can have. data Content = ContentBlocks [Block] | ContentInlines [Inline] + | ContentLines [[Inline]] + | ContentDefItems [([Inline], [[Block]])] + | ContentListItems [[Block]] +contentTypeDescription :: Content -> Text +contentTypeDescription = \case + ContentBlocks {} -> "list of Block items" + ContentInlines {} -> "list of Inline items" + ContentLines {} -> "list of Inline lists (i.e., a list of lines)" + ContentDefItems {} -> "list of definition items items" + ContentListItems {} -> "list items (i.e., list of list of Block elements)" + +pushContent :: LuaError e => Pusher e Content +pushContent = \case + ContentBlocks blks -> pushPandocList pushBlock blks + ContentInlines inlns -> pushPandocList pushInline inlns + ContentLines lns -> pushPandocList (pushPandocList pushInline) lns + ContentDefItems itms -> + let pushItem = pushPair (pushPandocList pushInline) + (pushPandocList (pushPandocList pushBlock)) + in pushPandocList pushItem itms + ContentListItems itms -> + pushPandocList (pushPandocList pushBlock) itms + +peekContent :: LuaError e => Peeker e Content +peekContent idx = + (ContentInlines <$!> peekInlinesFuzzy idx) <|> + (ContentLines <$!> peekList (peekList peekInlineFuzzy) idx) <|> + (ContentBlocks <$!> peekBlocksFuzzy idx ) <|> + (ContentListItems <$!> peekList peekBlocksFuzzy idx) <|> + (ContentDefItems <$!> peekList (peekDefinitionItem) idx) + setInlineContent :: Inline -> Content -> Possible Inline setInlineContent = \case -- inline content Cite cs _ -> Actual . Cite cs . inlineContent Emph _ -> Actual . Emph . inlineContent + Link a _ tgt -> Actual . (\inlns -> Link a inlns tgt) . inlineContent Quoted qt _ -> Actual . Quoted qt . inlineContent SmallCaps _ -> Actual . SmallCaps . inlineContent Span attr _ -> Actual . Span attr . inlineContent @@ -423,18 +622,19 @@ where inlineContent = \case ContentInlines inlns -> inlns - ContentBlocks _ -> throwM $ - PandocLuaError "expected Inlines, got Blocks" + c -> throwM . PandocLuaError $ "expected Inlines, got " <> + contentTypeDescription c blockContent = \case ContentBlocks blks -> blks ContentInlines [] -> [] - ContentInlines _ -> throwM $ - PandocLuaError "expected Blocks, got Inlines" + c -> throwM . PandocLuaError $ "expected Blocks, got " <> + contentTypeDescription c getInlineContent :: Inline -> Possible Content getInlineContent = \case Cite _ inlns -> Actual $ ContentInlines inlns Emph inlns -> Actual $ ContentInlines inlns + Link _ inlns _ -> Actual $ ContentInlines inlns Quoted _ inlns -> Actual $ ContentInlines inlns SmallCaps inlns -> Actual $ ContentInlines inlns Span _ inlns -> Actual $ ContentInlines inlns @@ -481,16 +681,6 @@ <#> parameter peekInline "inline" "Inline" "Object" =#> functionResult pushString "string" "stringified Inline" -pushContent :: LuaError e => Pusher e Content -pushContent = \case - ContentBlocks blks -> pushPandocList pushBlock blks - ContentInlines inlns -> pushPandocList pushInline inlns - -peekContent :: LuaError e => Peeker e Content -peekContent idx = - (ContentInlines <$!> peekList peekInline idx) <|> - (ContentBlocks <$!> peekList peekBlock idx) - typeInline :: LuaError e => DocumentedType e Inline typeInline = deftype "Inline" [ operation Tostring showInline @@ -545,7 +735,7 @@ Link _ _ (tgt, _) -> Actual tgt _ -> Absent) (peekText, \case - Link attr capt (_, title) -> Actual . Image attr capt . (,title) + Link attr capt (_, title) -> Actual . Link attr capt . (,title) _ -> const Absent) , possibleProperty "title" "title text" (pushText, getInlineTitle) @@ -576,34 +766,58 @@ peekInline :: forall e. LuaError e => Peeker e Inline peekInline = retrieving "Inline" . \idx -> peekUD typeInline idx +-- | Try extra hard to retrieve an Inline value from the stack. Treats +-- bare strings as @Str@ values. +peekInlineFuzzy :: LuaError e => Peeker e Inline +peekInlineFuzzy = retrieving "Inline" . choice + [ peekUD typeInline + , \idx -> Str <$!> peekText idx + ] + -- | Try extra-hard to return the value at the given index as a list of -- inlines. -peekFuzzyInlines :: LuaError e => Peeker e [Inline] -peekFuzzyInlines = choice - [ peekList peekInline - , fmap pure . peekInline - , \idx -> pure . Str <$!> peekText idx +peekInlinesFuzzy :: LuaError e => Peeker e [Inline] +peekInlinesFuzzy = choice + [ peekList peekInlineFuzzy + , fmap pure . peekInlineFuzzy ] -peekFuzzyBlocks :: LuaError e => Peeker e [Block] -peekFuzzyBlocks = choice - [ peekList peekBlock - , fmap pure . peekBlock - , \idx -> pure . Plain . pure . Str <$!> peekText idx +-- | Try extra hard to retrieve a Block value from the stack. Treats bar +-- Inline elements as if they were wrapped in 'Plain'. +peekBlockFuzzy :: LuaError e => Peeker e Block +peekBlockFuzzy = choice + [ peekBlock + , (\idx -> Plain <$!> peekInlinesFuzzy idx) ] +-- | Try extra-hard to return the value at the given index as a list of +-- blocks. +peekBlocksFuzzy :: LuaError e => Peeker e [Block] +peekBlocksFuzzy = choice + [ peekList peekBlockFuzzy + , (<$!>) pure . peekBlockFuzzy + ] -pushListAttributes :: forall e. LuaError e => ListAttributes -> LuaE e () -pushListAttributes (start, style, delimiter) = - pushViaConstr' "ListAttributes" - [ push start, push style, push delimiter ] +-- * Orphan Instances -peekListAttributes :: LuaError e => Peeker e ListAttributes -peekListAttributes = retrieving "ListAttributes" . peekTriple - peekIntegral - peekRead - peekRead +instance Pushable Inline where + push = pushInline +instance Pushable Citation where + push = pushCitation + +instance Pushable Row where + push = pushRow + +instance Pushable TableBody where + push = pushTableBody + +instance Pushable TableFoot where + push = pushTableFoot + +instance Pushable TableHead where + push = pushTableHead + -- These instances exist only for testing. It's a hack to avoid making -- the marshalling modules public. instance Peekable Inline where @@ -617,6 +831,9 @@ instance Peekable Pandoc where peek = forcePeek . peekPandoc + +instance Peekable Row where + peek = forcePeek . peekRow instance Peekable Version where peek = forcePeek . peekVersionFuzzy diff --git a/src/Text/Pandoc/Lua/Marshaling/Attr.hs b/src/Text/Pandoc/Lua/Marshaling/Attr.hs --- a/src/Text/Pandoc/Lua/Marshaling/Attr.hs +++ b/src/Text/Pandoc/Lua/Marshaling/Attr.hs @@ -56,6 +56,10 @@ ### return <#> parameter peekAttr "attr" "Attr" "" =#> functionResult pushAttr "Attr" "new Attr element" + , readonly "tag" "element type tag (always 'Attr')" + (pushText, const "Attr") + + , alias "t" "alias for `tag`" ["tag"] ] pushAttr :: LuaError e => Pusher e Attr @@ -67,7 +71,7 @@ TypeTable -> liftLua (rawlen idx) >>= \case 0 -> peekKeyValuePairs peekText peekText idx _ -> peekList (peekPair peekText peekText) idx - _ -> fail "unsupported type" + _ -> failPeek "unsupported type" pushAttribs :: LuaError e => Pusher e [(Text, Text)] pushAttribs = pushUD typeAttributeList @@ -135,7 +139,7 @@ lookupKey :: [(Text,Text)] -> Maybe Key -> Maybe Attribute lookupKey !kvs = \case - Just (StringKey str) -> AttributeValue <$> lookup str kvs + Just (StringKey str) -> AttributeValue <$!> lookup str kvs Just (IntKey n) -> AttributePair <$!> atMay kvs (n - 1) Nothing -> Nothing @@ -200,26 +204,30 @@ return $ ident `seq` classes `seq` attribs `seq` (ident, classes, attribs) -mkAttr :: LuaError e => LuaE e NumResults -mkAttr = do - attr <- ltype (nthBottom 1) >>= \case - TypeString -> forcePeek $ do - mident <- optional (peekText (nthBottom 1)) - mclass <- optional (peekList peekText (nthBottom 2)) - mattribs <- optional (peekAttribs (nthBottom 3)) - return (fromMaybe "" mident, fromMaybe [] mclass, fromMaybe [] mattribs) - TypeTable -> forcePeek $ peekAttrTable (nthBottom 1) - TypeUserdata -> forcePeek $ peekUD typeAttr (nthBottom 1) <|> do - attrList <- peekUD typeAttributeList (nthBottom 1) - return ("", [], attrList) - TypeNil -> pure nullAttr - TypeNone -> pure nullAttr - x -> failLua $ "Cannot create Attr from " ++ show x - pushAttr attr - return 1 +-- | Constructor for 'Attr'. +mkAttr :: LuaError e => DocumentedFunction e +mkAttr = defun "Attr" + ### (ltype (nthBottom 1) >>= \case + TypeString -> forcePeek $ do + mident <- optional (peekText (nthBottom 1)) + mclass <- optional (peekList peekText (nthBottom 2)) + mattribs <- optional (peekAttribs (nthBottom 3)) + return ( fromMaybe "" mident + , fromMaybe [] mclass + , fromMaybe [] mattribs) + TypeTable -> forcePeek $ peekAttrTable (nthBottom 1) + TypeUserdata -> forcePeek $ peekUD typeAttr (nthBottom 1) <|> do + attrList <- peekUD typeAttributeList (nthBottom 1) + return ("", [], attrList) + TypeNil -> pure nullAttr + TypeNone -> pure nullAttr + x -> failLua $ "Cannot create Attr from " ++ show x) + =#> functionResult pushAttr "Attr" "new Attr object" -mkAttributeList :: LuaError e => LuaE e NumResults -mkAttributeList = do - attribs <- forcePeek $ peekAttribs (nthBottom 1) - pushUD typeAttributeList attribs - return 1 +-- | Constructor for 'AttributeList'. +mkAttributeList :: LuaError e => DocumentedFunction e +mkAttributeList = defun "AttributeList" + ### return + <#> parameter peekAttribs "table|AttributeList" "attribs" "an attribute list" + =#> functionResult (pushUD typeAttributeList) "AttributeList" + "new AttributeList object" diff --git a/src/Text/Pandoc/Lua/Marshaling/List.hs b/src/Text/Pandoc/Lua/Marshaling/List.hs --- a/src/Text/Pandoc/Lua/Marshaling/List.hs +++ b/src/Text/Pandoc/Lua/Marshaling/List.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE UndecidableInstances #-} diff --git a/src/Text/Pandoc/Lua/Marshaling/ListAttributes.hs b/src/Text/Pandoc/Lua/Marshaling/ListAttributes.hs new file mode 100644 --- /dev/null +++ b/src/Text/Pandoc/Lua/Marshaling/ListAttributes.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} +{- | +Module : Text.Pandoc.Lua.Marshaling.ListAttributes +Copyright : © 2021 Albert Krewinkel +License : GNU GPL, version 2 or above +Maintainer : Albert Krewinkel + +Marshaling/unmarshaling functions and constructor for 'ListAttributes' +values. +-} +module Text.Pandoc.Lua.Marshaling.ListAttributes + ( typeListAttributes + , peekListAttributes + , pushListAttributes + , mkListAttributes + ) where + +import Data.Maybe (fromMaybe) +import HsLua +import Text.Pandoc.Definition ( ListAttributes, ListNumberStyle (DefaultStyle) + , ListNumberDelim (DefaultDelim)) + +typeListAttributes :: LuaError e => DocumentedType e ListAttributes +typeListAttributes = deftype "ListAttributes" + [ operation Eq $ lambda + ### liftPure2 (==) + <#> parameter peekListAttributes "a" "ListAttributes" "" + <#> parameter peekListAttributes "b" "ListAttributes" "" + =#> functionResult pushBool "boolean" "whether the two are equal" + ] + [ property "start" "number of the first list item" + (pushIntegral, \(start,_,_) -> start) + (peekIntegral, \(_,style,delim) -> (,style,delim)) + , property "style" "style used for list numbering" + (pushString . show, \(_,classes,_) -> classes) + (peekRead, \(start,_,delim) -> (start,,delim)) + , property "delimiter" "delimiter of list numbers" + (pushString . show, \(_,_,delim) -> delim) + (peekRead, \(start,style,_) -> (start,style,)) + , method $ defun "clone" + ### return + <#> udparam typeListAttributes "a" "" + =#> functionResult (pushUD typeListAttributes) "ListAttributes" + "cloned ListAttributes value" + ] + +-- | Pushes a 'ListAttributes' value as userdata object. +pushListAttributes :: LuaError e => Pusher e ListAttributes +pushListAttributes = pushUD typeListAttributes + +-- | Retrieve a 'ListAttributes' triple, either from userdata or from a +-- Lua tuple. +peekListAttributes :: LuaError e => Peeker e ListAttributes +peekListAttributes = retrieving "ListAttributes" . choice + [ peekUD typeListAttributes + , peekTriple peekIntegral peekRead peekRead + ] + +-- | Constructor for a new 'ListAttributes' value. +mkListAttributes :: LuaError e => DocumentedFunction e +mkListAttributes = defun "ListAttributes" + ### liftPure3 (\mstart mstyle mdelim -> + ( fromMaybe 1 mstart + , fromMaybe DefaultStyle mstyle + , fromMaybe DefaultDelim mdelim + )) + <#> optionalParameter peekIntegral "integer" "start" "number of first item" + <#> optionalParameter peekRead "string" "style" "list numbering style" + <#> optionalParameter peekRead "string" "delimiter" "list number delimiter" + =#> functionResult pushListAttributes "ListAttributes" "new ListAttributes" + #? "Creates a new ListAttributes object." diff --git a/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs b/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs --- a/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs +++ b/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs @@ -1,13 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {- | Module : Text.Pandoc.Lua.Marshaling.SimpleTable Copyright : © 2020-2021 Albert Krewinkel License : GNU GPL, version 2 or above - Maintainer : Albert Krewinkel - Stability : alpha Definition and marshaling of the 'SimpleTable' data type used as a convenience type when dealing with tables. @@ -16,14 +13,14 @@ ( SimpleTable (..) , peekSimpleTable , pushSimpleTable + , mkSimpleTable ) where -import Control.Monad ((<$!>)) import HsLua as Lua import Text.Pandoc.Definition -import Text.Pandoc.Lua.Util (pushViaConstructor) import Text.Pandoc.Lua.Marshaling.AST +import Text.Pandoc.Lua.Marshaling.List -- | A simple (legacy-style) table. data SimpleTable = SimpleTable @@ -32,23 +29,64 @@ , simpleTableColumnWidths :: [Double] , simpleTableHeader :: [[Block]] , simpleTableBody :: [[[Block]]] - } + } deriving (Eq, Show) +typeSimpleTable :: LuaError e => DocumentedType e SimpleTable +typeSimpleTable = deftype "SimpleTable" + [ operation Eq $ lambda + ### liftPure2 (==) + <#> udparam typeSimpleTable "a" "" + <#> udparam typeSimpleTable "b" "" + =#> functionResult pushBool "boolean" "whether the two objects are equal" + , operation Tostring $ lambda + ### liftPure show + <#> udparam typeSimpleTable "self" "" + =#> functionResult pushString "string" "Haskell string representation" + ] + [ property "caption" "table caption" + (pushPandocList pushInline, simpleTableCaption) + (peekInlinesFuzzy, \t capt -> t {simpleTableCaption = capt}) + , property "aligns" "column alignments" + (pushPandocList (pushString . show), simpleTableAlignments) + (peekList peekRead, \t aligns -> t{simpleTableAlignments = aligns}) + , property "widths" "relative column widths" + (pushPandocList pushRealFloat, simpleTableColumnWidths) + (peekList peekRealFloat, \t ws -> t{simpleTableColumnWidths = ws}) + , property "headers" "table header" + (pushRow, simpleTableHeader) + (peekRow, \t h -> t{simpleTableHeader = h}) + , property "rows" "table body rows" + (pushPandocList pushRow, simpleTableBody) + (peekList peekRow, \t bs -> t{simpleTableBody = bs}) + + , readonly "t" "type tag (always 'SimpleTable')" + (pushText, const "SimpleTable") + + , alias "header" "alias for `headers`" ["headers"] + ] + where + pushRow = pushPandocList (pushPandocList pushBlock) + +peekRow :: LuaError e => Peeker e [[Block]] +peekRow = peekList peekBlocksFuzzy + -- | Push a simple table to the stack by calling the -- @pandoc.SimpleTable@ constructor. pushSimpleTable :: forall e. LuaError e => SimpleTable -> LuaE e () -pushSimpleTable tbl = pushViaConstructor @e "SimpleTable" - (simpleTableCaption tbl) - (simpleTableAlignments tbl) - (simpleTableColumnWidths tbl) - (simpleTableHeader tbl) - (simpleTableBody tbl) +pushSimpleTable = pushUD typeSimpleTable -- | Retrieve a simple table from the stack. peekSimpleTable :: forall e. LuaError e => Peeker e SimpleTable -peekSimpleTable idx = retrieving "SimpleTable" $ SimpleTable - <$!> peekFieldRaw peekInlines "caption" idx - <*> peekFieldRaw (peekList peekRead) "aligns" idx - <*> peekFieldRaw (peekList peekRealFloat) "widths" idx - <*> peekFieldRaw (peekList peekBlocks) "headers" idx - <*> peekFieldRaw (peekList (peekList peekBlocks)) "rows" idx +peekSimpleTable = retrieving "SimpleTable" . peekUD typeSimpleTable + +-- | Constructor for the 'SimpleTable' type. +mkSimpleTable :: LuaError e => DocumentedFunction e +mkSimpleTable = defun "SimpleTable" + ### liftPure5 SimpleTable + <#> parameter peekInlinesFuzzy "Inlines" "caption" "table caption" + <#> parameter (peekList peekRead) "{Alignment,...}" "align" "column alignments" + <#> parameter (peekList peekRealFloat) "{number,...}" "widths" + "relative column widths" + <#> parameter peekRow "{Blocks,...}" "header" "table header row" + <#> parameter (peekList peekRow) "{{Blocks,...},...}" "body" "table body rows" + =#> functionResult pushSimpleTable "SimpleTable" "new SimpleTable object" diff --git a/src/Text/Pandoc/Lua/Module/MediaBag.hs b/src/Text/Pandoc/Lua/Module/MediaBag.hs --- a/src/Text/Pandoc/Lua/Module/MediaBag.hs +++ b/src/Text/Pandoc/Lua/Module/MediaBag.hs @@ -1,112 +1,126 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.Lua.Module.MediaBag Copyright : Copyright © 2017-2021 Albert Krewinkel License : GNU GPL, version 2 or above - Maintainer : Albert Krewinkel - Stability : alpha -The lua module @pandoc.mediabag@. +The Lua module @pandoc.mediabag@. -} module Text.Pandoc.Lua.Module.MediaBag - ( pushModule + ( documentedModule ) where import Prelude hiding (lookup) -import Control.Monad (zipWithM_) -import HsLua (LuaE, NumResults, Optional) -import HsLua.Marshalling (pushIterator) +import Data.Maybe (fromMaybe) +import HsLua ( LuaE, DocumentedFunction, Module (..) + , (<#>), (###), (=#>), (=?>), defun, functionResult + , optionalParameter , parameter) import Text.Pandoc.Class.CommonState (CommonState (..)) import Text.Pandoc.Class.PandocMonad (fetchItem, getMediaBag, modifyCommonState, setMediaBag) import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.Marshaling () -import Text.Pandoc.Lua.PandocLua (PandocLua (..), liftPandocLua, addFunction) +import Text.Pandoc.Lua.Marshaling.List (pushPandocList) +import Text.Pandoc.Lua.PandocLua (unPandocLua) import Text.Pandoc.MIME (MimeType) import qualified Data.ByteString.Lazy as BL -import qualified Data.Text as T import qualified HsLua as Lua import qualified Text.Pandoc.MediaBag as MB -- -- MediaBag submodule -- -pushModule :: PandocLua NumResults -pushModule = do - liftPandocLua Lua.newtable - addFunction "delete" delete - addFunction "empty" empty - addFunction "insert" insert - addFunction "items" items - addFunction "lookup" lookup - addFunction "list" list - addFunction "fetch" fetch - return 1 +documentedModule :: Module PandocError +documentedModule = Module + { moduleName = "pandoc.mediabag" + , moduleDescription = "mediabag access" + , moduleFields = [] + , moduleFunctions = + [ delete + , empty + , fetch + , insert + , items + , list + , lookup + ] + , moduleOperations = [] + } -- | Delete a single item from the media bag. -delete :: FilePath -> PandocLua NumResults -delete fp = 0 <$ modifyCommonState - (\st -> st { stMediaBag = MB.deleteMedia fp (stMediaBag st) }) +delete :: DocumentedFunction PandocError +delete = defun "delete" + ### (\fp -> unPandocLua $ modifyCommonState + (\st -> st { stMediaBag = MB.deleteMedia fp (stMediaBag st) })) + <#> parameter Lua.peekString "string" "filepath" "filename of item to delete" + =#> [] + -- | Delete all items from the media bag. -empty :: PandocLua NumResults -empty = 0 <$ modifyCommonState (\st -> st { stMediaBag = mempty }) +empty :: DocumentedFunction PandocError +empty = defun "empty" + ### unPandocLua (modifyCommonState (\st -> st { stMediaBag = mempty })) + =#> [] -- | Insert a new item into the media bag. -insert :: FilePath - -> Optional MimeType - -> BL.ByteString - -> PandocLua NumResults -insert fp optionalMime contents = do - mb <- getMediaBag - setMediaBag $ MB.insertMedia fp (Lua.fromOptional optionalMime) contents mb - return (Lua.NumResults 0) +insert :: DocumentedFunction PandocError +insert = defun "insert" + ### (\fp mmime contents -> unPandocLua $ do + mb <- getMediaBag + setMediaBag $ MB.insertMedia fp mmime contents mb + return (Lua.NumResults 0)) + <#> parameter Lua.peekString "string" "filepath" "item file path" + <#> optionalParameter Lua.peekText "string" "mimetype" "the item's MIME type" + <#> parameter Lua.peekLazyByteString "string" "contents" "binary contents" + =?> "Nothing" -- | Returns iterator values to be used with a Lua @for@ loop. -items :: PandocLua NumResults -items = do - mb <- getMediaBag - liftPandocLua $ do - let pushItem (fp, mimetype, contents) = do - Lua.pushString fp - Lua.pushText mimetype - Lua.pushByteString $ BL.toStrict contents - return (Lua.NumResults 3) - pushIterator pushItem (MB.mediaItems mb) +items :: DocumentedFunction PandocError +items = defun "items" + ### (do + mb <-unPandocLua getMediaBag + let pushItem (fp, mimetype, contents) = do + Lua.pushString fp + Lua.pushText mimetype + Lua.pushByteString $ BL.toStrict contents + return (Lua.NumResults 3) + Lua.pushIterator pushItem (MB.mediaItems mb)) + =?> "Iterator triple" -lookup :: FilePath - -> PandocLua NumResults -lookup fp = do - res <- MB.lookupMedia fp <$> getMediaBag - liftPandocLua $ case res of - Nothing -> 1 <$ Lua.pushnil - Just item -> do - Lua.push $ MB.mediaMimeType item - Lua.push $ MB.mediaContents item - return 2 +-- | Function to lookup a value in the mediabag. +lookup :: DocumentedFunction PandocError +lookup = defun "lookup" + ### (\fp -> unPandocLua (MB.lookupMedia fp <$> getMediaBag) >>= \case + Nothing -> 1 <$ Lua.pushnil + Just item -> 2 <$ do + Lua.pushText $ MB.mediaMimeType item + Lua.pushLazyByteString $ MB.mediaContents item) + <#> parameter Lua.peekString "string" "filepath" "path of item to lookup" + =?> "MIME type and contents" -list :: PandocLua NumResults -list = do - dirContents <- MB.mediaDirectory <$> getMediaBag - liftPandocLua $ do - Lua.newtable - zipWithM_ addEntry [1..] dirContents - return 1 +-- | Function listing all mediabag items. +list :: DocumentedFunction PandocError +list = defun "list" + ### (unPandocLua (MB.mediaDirectory <$> getMediaBag)) + =#> functionResult (pushPandocList pushEntry) "table" "list of entry triples" where - addEntry :: Lua.Integer -> (FilePath, MimeType, Int) -> LuaE PandocError () - addEntry idx (fp, mimeType, contentLength) = do + pushEntry :: (FilePath, MimeType, Int) -> LuaE PandocError () + pushEntry (fp, mimeType, contentLength) = do Lua.newtable - Lua.push ("path" :: T.Text) *> Lua.push fp *> Lua.rawset (-3) - Lua.push ("type" :: T.Text) *> Lua.push mimeType *> Lua.rawset (-3) - Lua.push ("length" :: T.Text) *> Lua.push contentLength *> Lua.rawset (-3) - Lua.rawseti (-2) idx + Lua.pushName "path" *> Lua.pushString fp *> Lua.rawset (-3) + Lua.pushName "type" *> Lua.pushText mimeType *> Lua.rawset (-3) + Lua.pushName "length" *> Lua.pushIntegral contentLength *> Lua.rawset (-3) -fetch :: T.Text - -> PandocLua NumResults -fetch src = do - (bs, mimeType) <- fetchItem src - liftPandocLua . Lua.push $ maybe "" T.unpack mimeType - liftPandocLua $ Lua.push bs - return 2 -- returns 2 values: contents, mimetype +-- | Lua function to retrieve a new item. +fetch :: DocumentedFunction PandocError +fetch = defun "fetch" + ### (\src -> do + (bs, mimeType) <- unPandocLua $ fetchItem src + Lua.pushText $ fromMaybe "" mimeType + Lua.pushByteString bs + return 2) + <#> parameter Lua.peekText "string" "src" "URI to fetch" + =?> "Returns two string values: the fetched contents and the mimetype." diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -1,5 +1,7 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {- | Module : Text.Pandoc.Lua.Module.Pandoc @@ -13,33 +15,43 @@ -} module Text.Pandoc.Lua.Module.Pandoc ( pushModule + , documentedModule ) where import Prelude hiding (read) -import Control.Applicative (optional) -import Control.Monad ((>=>), forM_, when) +import Control.Applicative ((<|>)) +import Control.Monad ((<$!>), forM_, when) import Control.Monad.Catch (catch, throwM) import Control.Monad.Except (throwError) +import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr) import Data.Default (Default (..)) import Data.Maybe (fromMaybe) -import HsLua as Lua hiding (pushModule) +import Data.Proxy (Proxy (Proxy)) +import Data.Text (Text) +import HsLua hiding (Div, pushModule) import HsLua.Class.Peekable (PeekError) import System.Exit (ExitCode (..)) import Text.Pandoc.Class.PandocIO (runIO) import Text.Pandoc.Definition -import Text.Pandoc.Lua.Filter (SingletonsList (..), walkInlines, - walkInlineLists, walkBlocks, walkBlockLists) +import Text.Pandoc.Lua.Filter (SingletonsList (..), LuaFilter, peekLuaFilter, + walkInlines, walkInlineLists, + walkBlocks, walkBlockLists) import Text.Pandoc.Lua.Marshaling () import Text.Pandoc.Lua.Marshaling.AST import Text.Pandoc.Lua.Marshaling.Attr (mkAttr, mkAttributeList) import Text.Pandoc.Lua.Marshaling.List (List (..)) -import Text.Pandoc.Lua.PandocLua (PandocLua, addFunction, liftPandocLua, +import Text.Pandoc.Lua.Marshaling.ListAttributes ( mkListAttributes + , peekListAttributes) +import Text.Pandoc.Lua.Marshaling.SimpleTable (mkSimpleTable) +import Text.Pandoc.Lua.Module.Utils (sha1) +import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, loadDefaultModule) import Text.Pandoc.Options (ReaderOptions (readerExtensions)) import Text.Pandoc.Process (pipeProcess) import Text.Pandoc.Readers (Reader (..), getReader) import Text.Pandoc.Walk (Walkable) +import qualified HsLua as Lua import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BSL import qualified Data.Text as T @@ -50,42 +62,80 @@ -- module to be loadable. pushModule :: PandocLua NumResults pushModule = do + liftPandocLua $ Lua.pushModule documentedModule loadDefaultModule "pandoc" - addFunction "read" read - addFunction "pipe" pipe - addFunction "walk_block" (walkElement peekBlock pushBlock) - addFunction "walk_inline" (walkElement peekInline pushInline) - -- Constructors - addFunction "Attr" (liftPandocLua mkAttr) - addFunction "AttributeList" (liftPandocLua mkAttributeList) - addFunction "Pandoc" mkPandoc + let copyNext = do + hasNext <- next (nth 2) + if not hasNext + then return () + else do + pushvalue (nth 2) + insert (nth 2) + rawset (nth 5) -- pandoc module + copyNext liftPandocLua $ do - let addConstr fn = do - pushName (functionName fn) - pushDocumentedFunction fn - rawset (nth 3) - forM_ inlineConstructors addConstr - -- add constructors to Inlines.constructor - newtable -- constructor - forM_ (inlineConstructors @PandocError) $ \fn -> do - let name = functionName fn - pushName name - pushName name - rawget (nth 4) - rawset (nth 3) - -- set as pandoc.Inline.constructor - pushName "Inline" - newtable *> pushName "constructor" *> pushvalue (nth 4) *> rawset (nth 3) - rawset (nth 4) - pop 1 -- remaining constructor table + pushnil -- initial key + copyNext + pop 1 + return 1 +documentedModule :: Module PandocError +documentedModule = Module + { moduleName = "pandoc" + , moduleDescription = T.unlines + [ "Lua functions for pandoc scripts; includes constructors for" + , "document elements, functions to parse text in a given" + , "format, and functions to filter and modify a subtree." + ] + , moduleFields = stringConstants ++ [inlineField, blockField] + , moduleOperations = [] + , moduleFunctions = mconcat + [ functions + , otherConstructors + , blockConstructors + , inlineConstructors + ] + } + +-- | Inline table field +inlineField :: Field PandocError +inlineField = Field + { fieldName = "Inline" + , fieldDescription = "Inline constructors, nested under 'constructors'." + -- the nesting happens for historical reasons and should probably be + -- changed. + , fieldPushValue = pushWithConstructorsSubtable inlineConstructors + } + +-- | @Block@ module field +blockField :: Field PandocError +blockField = Field + { fieldName = "Block" + , fieldDescription = "Inline constructors, nested under 'constructors'." + -- the nesting happens for historical reasons and should probably be + -- changed. + , fieldPushValue = pushWithConstructorsSubtable blockConstructors + } + +pushWithConstructorsSubtable :: [DocumentedFunction PandocError] + -> LuaE PandocError () +pushWithConstructorsSubtable constructors = do + newtable -- Field table + newtable -- constructor table + pushName "constructor" *> pushvalue (nth 2) *> rawset (nth 4) + forM_ constructors $ \fn -> do + pushName (functionName fn) + pushDocumentedFunction fn + rawset (nth 3) + pop 1 -- pop constructor table + inlineConstructors :: LuaError e => [DocumentedFunction e] inlineConstructors = [ defun "Cite" ### liftPure2 Cite <#> parameter (peekList peekCitation) "citations" "list of Citations" "" - <#> parameter peekFuzzyInlines "content" "Inline" "placeholder content" + <#> parameter peekInlinesFuzzy "content" "Inline" "placeholder content" =#> functionResult pushInline "Inline" "cite element" , defun "Code" ### liftPure2 (flip Code) @@ -98,7 +148,7 @@ let attr = fromMaybe nullAttr mattr title = fromMaybe mempty mtitle in Image attr caption (src, title)) - <#> parameter peekFuzzyInlines "Inlines" "caption" "image caption / alt" + <#> parameter peekInlinesFuzzy "Inlines" "caption" "image caption / alt" <#> parameter peekText "string" "src" "path/URL of the image file" <#> optionalParameter peekText "string" "title" "brief image description" <#> optionalParameter peekAttr "Attr" "attr" "image attributes" @@ -111,7 +161,7 @@ let attr = fromMaybe nullAttr mattr title = fromMaybe mempty mtitle in Link attr content (target, title)) - <#> parameter peekFuzzyInlines "Inlines" "content" "text for this link" + <#> parameter peekInlinesFuzzy "Inlines" "content" "text for this link" <#> parameter peekText "string" "target" "the link target" <#> optionalParameter peekText "string" "title" "brief link description" <#> optionalParameter peekAttr "Attr" "attr" "link attributes" @@ -123,12 +173,12 @@ =#> functionResult pushInline "Inline" "math element" , defun "Note" ### liftPure Note - <#> parameter peekFuzzyBlocks "content" "Blocks" "note content" + <#> parameter peekBlocksFuzzy "content" "Blocks" "note content" =#> functionResult pushInline "Inline" "note" , defun "Quoted" ### liftPure2 Quoted <#> parameter peekQuoteType "quotetype" "QuoteType" "type of quotes" - <#> parameter peekFuzzyInlines "content" "Inlines" "inlines in quotes" + <#> parameter peekInlinesFuzzy "content" "Inlines" "inlines in quotes" =#> functionResult pushInline "Inline" "quoted element" , defun "RawInline" ### liftPure2 RawInline @@ -144,11 +194,11 @@ =#> functionResult pushInline "Inline" "new space" , defun "Span" ### liftPure2 (\inlns mattr -> Span (fromMaybe nullAttr mattr) inlns) - <#> parameter peekFuzzyInlines "content" "Inlines" "inline content" + <#> parameter peekInlinesFuzzy "content" "Inlines" "inline content" <#> optionalParameter peekAttr "attr" "Attr" "additional attributes" =#> functionResult pushInline "Inline" "span element" , defun "Str" - ### liftPure (\s -> s `seq` Str s) + ### liftPure Str <#> parameter peekText "text" "string" "" =#> functionResult pushInline "Inline" "new Str object" , mkInlinesConstr "Strong" Strong @@ -158,62 +208,237 @@ , mkInlinesConstr "Underline" Underline ] +blockConstructors :: LuaError e => [DocumentedFunction e] +blockConstructors = + [ defun "BlockQuote" + ### liftPure BlockQuote + <#> blocksParam + =#> blockResult "BlockQuote element" + + , defun "BulletList" + ### liftPure BulletList + <#> blockItemsParam "list items" + =#> blockResult "BulletList element" + + , defun "CodeBlock" + ### liftPure2 (\code mattr -> CodeBlock (fromMaybe nullAttr mattr) code) + <#> textParam "text" "code block content" + <#> optAttrParam + =#> blockResult "CodeBlock element" + + , defun "DefinitionList" + ### liftPure DefinitionList + <#> parameter (choice + [ peekList peekDefinitionItem + , \idx -> (:[]) <$!> peekDefinitionItem idx + ]) + "{{Inlines, {Blocks,...}},...}" + "content" "definition items" + =#> blockResult "DefinitionList element" + + , defun "Div" + ### liftPure2 (\content mattr -> Div (fromMaybe nullAttr mattr) content) + <#> blocksParam + <#> optAttrParam + =#> blockResult "Div element" + + , defun "Header" + ### liftPure3 (\lvl content mattr -> + Header lvl (fromMaybe nullAttr mattr) content) + <#> parameter peekIntegral "integer" "level" "heading level" + <#> parameter peekInlinesFuzzy "Inlines" "content" "inline content" + <#> optAttrParam + =#> blockResult "Header element" + + , defun "HorizontalRule" + ### return HorizontalRule + =#> blockResult "HorizontalRule element" + + , defun "LineBlock" + ### liftPure LineBlock + <#> parameter (peekList peekInlinesFuzzy) "{Inlines,...}" "content" "lines" + =#> blockResult "LineBlock element" + + , defun "Null" + ### return Null + =#> blockResult "Null element" + + , defun "OrderedList" + ### liftPure2 (\items mListAttrib -> + let defListAttrib = (1, DefaultStyle, DefaultDelim) + in OrderedList (fromMaybe defListAttrib mListAttrib) items) + <#> blockItemsParam "ordered list items" + <#> optionalParameter peekListAttributes "ListAttributes" "listAttributes" + "specifier for the list's numbering" + =#> blockResult "OrderedList element" + + , defun "Para" + ### liftPure Para + <#> parameter peekInlinesFuzzy "Inlines" "content" "paragraph content" + =#> blockResult "Para element" + + , defun "Plain" + ### liftPure Plain + <#> parameter peekInlinesFuzzy "Inlines" "content" "paragraph content" + =#> blockResult "Plain element" + + , defun "RawBlock" + ### liftPure2 RawBlock + <#> parameter peekFormat "Format" "format" "format of content" + <#> parameter peekText "string" "text" "raw content" + =#> blockResult "RawBlock element" + + , defun "Table" + ### (\capt colspecs thead tbodies tfoot mattr -> + let attr = fromMaybe nullAttr mattr + in return $! attr `seq` capt `seq` colspecs `seq` thead `seq` tbodies + `seq` tfoot `seq` Table attr capt colspecs thead tbodies tfoot) + <#> parameter peekCaption "Caption" "caption" "table caption" + <#> parameter (peekList peekColSpec) "{ColSpec,...}" "colspecs" + "column alignments and widths" + <#> parameter peekTableHead "TableHead" "head" "table head" + <#> parameter (peekList peekTableBody) "{TableBody,...}" "bodies" + "table bodies" + <#> parameter peekTableFoot "TableFoot" "foot" "table foot" + <#> optAttrParam + =#> blockResult "Table element" + ] + where + blockResult = functionResult pushBlock "Block" + blocksParam = parameter peekBlocksFuzzy "Blocks" "content" "block content" + blockItemsParam = parameter peekItemsFuzzy "List of Blocks" "content" + peekItemsFuzzy idx = peekList peekBlocksFuzzy idx + <|> ((:[]) <$!> peekBlocksFuzzy idx) + +textParam :: LuaError e => Text -> Text -> Parameter e Text +textParam = parameter peekText "string" + +optAttrParam :: LuaError e => Parameter e (Maybe Attr) +optAttrParam = optionalParameter peekAttr "attr" "Attr" "additional attributes" + mkInlinesConstr :: LuaError e => Name -> ([Inline] -> Inline) -> DocumentedFunction e mkInlinesConstr name constr = defun name ### liftPure (\x -> x `seq` constr x) - <#> parameter peekFuzzyInlines "content" "Inlines" "" + <#> parameter peekInlinesFuzzy "content" "Inlines" "" =#> functionResult pushInline "Inline" "new object" +otherConstructors :: LuaError e => [DocumentedFunction e] +otherConstructors = + [ defun "Pandoc" + ### liftPure2 (\blocks mMeta -> Pandoc (fromMaybe nullMeta mMeta) blocks) + <#> parameter peekBlocksFuzzy "Blocks" "blocks" "document contents" + <#> optionalParameter peekMeta "Meta" "meta" "document metadata" + =#> functionResult pushPandoc "Pandoc" "new Pandoc document" + , defun "Citation" + ### (\cid mode mprefix msuffix mnote_num mhash -> + cid `seq` mode `seq` mprefix `seq` msuffix `seq` + mnote_num `seq` mhash `seq` return $! Citation + { citationId = cid + , citationMode = mode + , citationPrefix = fromMaybe mempty mprefix + , citationSuffix = fromMaybe mempty msuffix + , citationNoteNum = fromMaybe 0 mnote_num + , citationHash = fromMaybe 0 mhash + }) + <#> parameter peekText "string" "cid" "citation ID (e.g. bibtex key)" + <#> parameter peekRead "citation mode" "mode" "citation rendering mode" + <#> optionalParameter peekInlinesFuzzy "prefix" "Inlines" "" + <#> optionalParameter peekInlinesFuzzy "suffix" "Inlines" "" + <#> optionalParameter peekIntegral "note_num" "integer" "note number" + <#> optionalParameter peekIntegral "hash" "integer" "hash number" + =#> functionResult pushCitation "Citation" "new citation object" + #? "Creates a single citation." + + , mkAttr + , mkAttributeList + , mkListAttributes + , mkSimpleTable + ] + +stringConstants :: [Field e] +stringConstants = + let constrs :: forall a. Data a => Proxy a -> [String] + constrs _ = map showConstr . dataTypeConstrs . dataTypeOf @a $ undefined + nullaryConstructors = mconcat + [ constrs (Proxy @ListNumberStyle) + , constrs (Proxy @ListNumberDelim) + , constrs (Proxy @QuoteType) + , constrs (Proxy @MathType) + , constrs (Proxy @Alignment) + , constrs (Proxy @CitationMode) + ] + toField s = Field + { fieldName = T.pack s + , fieldDescription = T.pack s + , fieldPushValue = pushString s + } + in map toField nullaryConstructors + walkElement :: (Walkable (SingletonsList Inline) a, Walkable (SingletonsList Block) a, Walkable (List Inline) a, Walkable (List Block) a) - => Peeker PandocError a -> Pusher PandocError a - -> LuaE PandocError NumResults -walkElement peek' push' = do - x <- forcePeek $ peek' (nthBottom 1) - f <- peek (nthBottom 2) - let walk' = walkInlines f - >=> walkInlineLists f - >=> walkBlocks f - >=> walkBlockLists f - walk' x >>= push' - return (NumResults 1) + => a -> LuaFilter -> LuaE PandocError a +walkElement x f = walkInlines f x + >>= walkInlineLists f + >>= walkBlocks f + >>= walkBlockLists f -read :: T.Text -> Optional T.Text -> PandocLua NumResults -read content formatSpecOrNil = liftPandocLua $ do - let formatSpec = fromMaybe "markdown" (Lua.fromOptional formatSpecOrNil) - res <- Lua.liftIO . runIO $ - getReader formatSpec >>= \(rdr,es) -> - case rdr of - TextReader r -> - r def{ readerExtensions = es } content - _ -> throwError $ PandocSomeError - "Only textual formats are supported" - case res of - Right pd -> (1 :: NumResults) <$ Lua.push pd -- success, push Pandoc - Left (PandocUnknownReaderError f) -> Lua.raiseError $ - "Unknown reader: " <> f - Left (PandocUnsupportedExtensionError e f) -> Lua.raiseError $ - "Extension " <> e <> " not supported for " <> f - Left e -> Lua.raiseError $ show e +functions :: [DocumentedFunction PandocError] +functions = + [ defun "pipe" + ### (\command args input -> do + (ec, output) <- Lua.liftIO $ pipeProcess Nothing command args input + `catch` (throwM . PandocIOError "pipe") + case ec of + ExitSuccess -> 1 <$ Lua.pushLazyByteString output + ExitFailure n -> do + pushPipeError (PipeError (T.pack command) n output) + Lua.error) + <#> parameter peekString "string" "command" "path to executable" + <#> parameter (peekList peekString) "{string,...}" "args" + "list of arguments" + <#> parameter peekLazyByteString "string" "input" + "input passed to process via stdin" + =?> "output string, or error triple" --- | Pipes input through a command. -pipe :: String -- ^ path to executable - -> [String] -- ^ list of arguments - -> BL.ByteString -- ^ input passed to process via stdin - -> PandocLua NumResults -pipe command args input = liftPandocLua $ do - (ec, output) <- Lua.liftIO $ pipeProcess Nothing command args input - `catch` (throwM . PandocIOError "pipe") - case ec of - ExitSuccess -> 1 <$ Lua.push output - ExitFailure n -> do - pushPipeError (PipeError (T.pack command) n output) - Lua.error + , defun "read" + ### (\content mformatspec -> do + let formatSpec = fromMaybe "markdown" mformatspec + res <- Lua.liftIO . runIO $ getReader formatSpec >>= \case + (TextReader r, es) -> r def{ readerExtensions = es } content + _ -> throwError $ PandocSomeError + "Only textual formats are supported" + case res of + Right pd -> return pd -- success, got a Pandoc document + Left (PandocUnknownReaderError f) -> + Lua.failLua . T.unpack $ "Unknown reader: " <> f + Left (PandocUnsupportedExtensionError e f) -> + Lua.failLua . T.unpack $ + "Extension " <> e <> " not supported for " <> f + Left e -> + throwM e) + <#> parameter peekText "string" "content" "text to parse" + <#> optionalParameter peekText "string" "formatspec" "format and extensions" + =#> functionResult pushPandoc "Pandoc" "result document" + , sha1 + + , defun "walk_block" + ### walkElement + <#> parameter peekBlockFuzzy "Block" "block" "element to traverse" + <#> parameter peekLuaFilter "LuaFilter" "filter" "filter functions" + =#> functionResult pushBlock "Block" "modified Block" + + , defun "walk_inline" + ### walkElement + <#> parameter peekInlineFuzzy "Inline" "inline" "element to traverse" + <#> parameter peekLuaFilter "LuaFilter" "filter" "filter functions" + =#> functionResult pushInline "Inline" "modified Inline" + ] + data PipeError = PipeError { pipeErrorCommand :: T.Text , pipeErrorCode :: Int @@ -256,12 +481,3 @@ , if output == mempty then BSL.pack "" else output ] return (NumResults 1) - -mkPandoc :: PandocLua NumResults -mkPandoc = liftPandocLua $ do - doc <- forcePeek $ do - blks <- peekBlocks (nthBottom 1) - mMeta <- optional $ peekMeta (nthBottom 2) - pure $ Pandoc (fromMaybe nullMeta mMeta) blks - pushPandoc doc - return 1 diff --git a/src/Text/Pandoc/Lua/Module/System.hs b/src/Text/Pandoc/Lua/Module/System.hs --- a/src/Text/Pandoc/Lua/Module/System.hs +++ b/src/Text/Pandoc/Lua/Module/System.hs @@ -11,34 +11,28 @@ Pandoc's system Lua module. -} module Text.Pandoc.Lua.Module.System - ( pushModule + ( documentedModule ) where -import HsLua hiding (pushModule) +import HsLua import HsLua.Module.System (arch, env, getwd, os, with_env, with_tmpdir, with_wd) -import Text.Pandoc.Error (PandocError) -import Text.Pandoc.Lua.ErrorConversion () -import qualified HsLua as Lua - -- | Push the pandoc.system module on the Lua stack. -pushModule :: LuaE PandocError NumResults -pushModule = do - Lua.pushModule $ Module - { moduleName = "system" - , moduleDescription = "system functions" - , moduleFields = - [ arch - , os - ] - , moduleFunctions = - [ setName "environment" env - , setName "get_working_directory" getwd - , setName "with_environment" with_env - , setName "with_temporary_directory" with_tmpdir - , setName "with_working_directory" with_wd - ] - , moduleOperations = [] - } - return 1 +documentedModule :: LuaError e => Module e +documentedModule = Module + { moduleName = "pandoc.system" + , moduleDescription = "system functions" + , moduleFields = + [ arch + , os + ] + , moduleFunctions = + [ setName "environment" env + , setName "get_working_directory" getwd + , setName "with_environment" with_env + , setName "with_temporary_directory" with_tmpdir + , setName "with_working_directory" with_wd + ] + , moduleOperations = [] + } diff --git a/src/Text/Pandoc/Lua/Module/Types.hs b/src/Text/Pandoc/Lua/Module/Types.hs --- a/src/Text/Pandoc/Lua/Module/Types.hs +++ b/src/Text/Pandoc/Lua/Module/Types.hs @@ -10,40 +10,52 @@ Pandoc data type constructors. -} module Text.Pandoc.Lua.Module.Types - ( pushModule + ( documentedModule ) where -import HsLua (LuaE, NumResults, Peeker, Pusher) +import HsLua ( LuaE, NumResults, Peeker, Pusher, Module (..), Field (..) + , defun, functionResult, parameter, (###), (<#>), (=#>)) +import HsLua.Module.Version (peekVersionFuzzy, pushVersion) import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.ErrorConversion () import Text.Pandoc.Lua.Marshaling.AST -import Text.Pandoc.Lua.Util (addFunction) import qualified HsLua as Lua -import qualified HsLua.Module.Version as Version -- | Push the pandoc.types module on the Lua stack. -pushModule :: LuaE PandocError NumResults -pushModule = do - Lua.newtable - Lua.pushName "Version" *> Lua.pushModule Version.documentedModule - *> Lua.rawset (Lua.nth 3) - pushCloneTable - Lua.setfield (Lua.nth 2) "clone" - return 1 - -pushCloneTable :: LuaE PandocError NumResults -pushCloneTable = do - Lua.newtable - addFunction "Attr" $ cloneWith peekAttr pushAttr - addFunction "Block" $ cloneWith peekBlock pushBlock - addFunction "Citation" $ cloneWith peekCitation Lua.push - addFunction "Inline" $ cloneWith peekInline pushInline - addFunction "Meta" $ cloneWith peekMeta Lua.push - addFunction "MetaValue" $ cloneWith peekMetaValue pushMetaValue - addFunction "ListAttributes" $ cloneWith peekListAttributes pushListAttributes - addFunction "Pandoc" $ cloneWith peekPandoc pushPandoc - return 1 +documentedModule :: Module PandocError +documentedModule = Module + { moduleName = "pandoc.types" + , moduleDescription = + "Constructors for types that are not part of the pandoc AST." + , moduleFields = + [ Field + { fieldName = "clone" + , fieldDescription = "DEPRECATED! Helper functions for element cloning." + , fieldPushValue = do + Lua.newtable + addFunction "Meta" $ cloneWith peekMeta pushMeta + addFunction "MetaValue" $ cloneWith peekMetaValue pushMetaValue + } + ] + , moduleFunctions = + [ defun "Version" + ### return + <#> parameter peekVersionFuzzy "string|integer|{integer,...}|Version" + "version_specifier" + (mconcat [ "either a version string like `'2.7.3'`, " + , "a single integer like `2`, " + , "list of integers like `{2,7,3}`, " + , "or a Version object" + ]) + =#> functionResult pushVersion "Version" "A new Version object." + ] + , moduleOperations = [] + } + where addFunction name fn = do + Lua.pushName name + Lua.pushHaskellFunction fn + Lua.rawset (Lua.nth 3) cloneWith :: Peeker PandocError a -> Pusher PandocError a diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -13,7 +13,8 @@ Utility module for Lua, exposing internal helper functions. -} module Text.Pandoc.Lua.Module.Utils - ( pushModule + ( documentedModule + , sha1 ) where import Control.Applicative ((<|>)) @@ -21,7 +22,7 @@ import Data.Data (showConstr, toConstr) import Data.Default (def) import Data.Version (Version) -import HsLua as Lua hiding (pushModule) +import HsLua as Lua import HsLua.Class.Peekable (PeekError) import HsLua.Module.Version (peekVersionFuzzy, pushVersion) import Text.Pandoc.Definition @@ -29,7 +30,8 @@ import Text.Pandoc.Lua.Marshaling () import Text.Pandoc.Lua.Marshaling.AST ( peekBlock, peekInline, peekPandoc, pushBlock, pushInline, pushPandoc - , peekAttr, peekListAttributes, peekMeta, peekMetaValue) + , peekAttr, peekMeta, peekMetaValue) +import Text.Pandoc.Lua.Marshaling.ListAttributes (peekListAttributes) import Text.Pandoc.Lua.Marshaling.List (pushPandocList) import Text.Pandoc.Lua.Marshaling.SimpleTable ( SimpleTable (..), peekSimpleTable, pushSimpleTable ) @@ -38,7 +40,6 @@ import qualified Data.Digest.Pure.SHA as SHA import qualified Data.ByteString.Lazy as BSL import qualified Data.Text as T -import qualified HsLua.Packaging as Lua import qualified Text.Pandoc.Builder as B import qualified Text.Pandoc.Filter.JSON as JSONFilter import qualified Text.Pandoc.Shared as Shared @@ -46,8 +47,8 @@ import qualified Text.Pandoc.Writers.Shared as Shared -- | Push the "pandoc.utils" module to the Lua stack. -pandocUtilsModule :: Module PandocError -pandocUtilsModule = Module +documentedModule :: Module PandocError +documentedModule = Module { moduleName = "pandoc.utils" , moduleDescription = "pandoc utility functions" , moduleFields = [] @@ -91,12 +92,7 @@ , "Returns nil instead of a string if the conversion failed." ] - , defun "sha1" - ### liftPure (SHA.showDigest . SHA.sha1) - <#> parameter (fmap BSL.fromStrict . peekByteString) "string" - "input" "" - =#> functionResult pushString "string" "hexadecimal hash value" - #? "Compute the hash of the given string value." + , sha1 , defun "Version" ### liftPure (id @Version) @@ -145,8 +141,13 @@ ] } -pushModule :: LuaE PandocError NumResults -pushModule = 1 <$ Lua.pushModule pandocUtilsModule +-- | Documented Lua function to compute the hash of a string. +sha1 :: DocumentedFunction e +sha1 = defun "sha1" + ### liftPure (SHA.showDigest . SHA.sha1) + <#> parameter (fmap BSL.fromStrict . peekByteString) "string" "input" "" + =#> functionResult pushString "string" "hexadecimal hash value" + #? "Compute the hash of the given string value." -- | Convert pandoc structure to a string with formatting removed. @@ -184,10 +185,10 @@ [ (fmap PandocElement . peekPandoc) , (fmap InlineElement . peekInline) , (fmap BlockElement . peekBlock) + , (fmap MetaValueElement . peekMetaValue) , (fmap AttrElement . peekAttr) , (fmap ListAttributesElement . peekListAttributes) , (fmap MetaElement . peekMeta) - , (fmap MetaValueElement . peekMetaValue) ] -- | Converts an old/simple table into a normal table block element. diff --git a/src/Text/Pandoc/Lua/Packages.hs b/src/Text/Pandoc/Lua/Packages.hs --- a/src/Text/Pandoc/Lua/Packages.hs +++ b/src/Text/Pandoc/Lua/Packages.hs @@ -16,7 +16,6 @@ ) where import Control.Monad (forM_) -import HsLua (NumResults) import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, loadDefaultModule) @@ -43,24 +42,27 @@ Lua.rawseti (-2) (i + 1) -- | Load a pandoc module. -pandocPackageSearcher :: String -> PandocLua NumResults +pandocPackageSearcher :: String -> PandocLua Lua.NumResults pandocPackageSearcher pkgName = case pkgName of "pandoc" -> pushWrappedHsFun $ Lua.toHaskellFunction @PandocError Pandoc.pushModule - "pandoc.mediabag" -> pushWrappedHsFun $ Lua.toHaskellFunction @PandocError MediaBag.pushModule - "pandoc.path" -> pushWrappedHsFun - (Lua.NumResults 1 <$ Lua.pushModule @PandocError Path.documentedModule) - "pandoc.system" -> pushWrappedHsFun $ Lua.toHaskellFunction System.pushModule - "pandoc.types" -> pushWrappedHsFun $ Lua.toHaskellFunction @PandocError Types.pushModule - "pandoc.utils" -> pushWrappedHsFun $ Lua.toHaskellFunction @PandocError Utils.pushModule - "text" -> pushWrappedHsFun - (Lua.NumResults 1 <$ Lua.pushModule @PandocError Text.documentedModule) - "pandoc.List" -> pushWrappedHsFun $ Lua.toHaskellFunction @PandocError (loadDefaultModule pkgName) + "pandoc.mediabag" -> pushModuleLoader MediaBag.documentedModule + "pandoc.path" -> pushModuleLoader Path.documentedModule + "pandoc.system" -> pushModuleLoader System.documentedModule + "pandoc.types" -> pushModuleLoader Types.documentedModule + "pandoc.utils" -> pushModuleLoader Utils.documentedModule + "text" -> pushModuleLoader Text.documentedModule + "pandoc.List" -> pushWrappedHsFun . Lua.toHaskellFunction @PandocError $ + loadDefaultModule pkgName _ -> reportPandocSearcherFailure where + pushModuleLoader mdl = liftPandocLua $ do + Lua.pushHaskellFunction $ + Lua.NumResults 1 <$ Lua.pushModule @PandocError mdl + return (Lua.NumResults 1) pushWrappedHsFun f = liftPandocLua $ do Lua.pushHaskellFunction f return 1 reportPandocSearcherFailure = liftPandocLua $ do Lua.push ("\n\t" <> pkgName <> "is not one of pandoc's default packages") - return (1 :: NumResults) + return (Lua.NumResults 1) diff --git a/src/Text/Pandoc/Lua/PandocLua.hs b/src/Text/Pandoc/Lua/PandocLua.hs --- a/src/Text/Pandoc/Lua/PandocLua.hs +++ b/src/Text/Pandoc/Lua/PandocLua.hs @@ -22,7 +22,6 @@ ( PandocLua (..) , runPandocLua , liftPandocLua - , addFunction , loadDefaultModule ) where @@ -75,13 +74,6 @@ instance Pushable a => Exposable PandocError (PandocLua a) where partialApply _narg x = 1 <$ (unPandocLua x >>= Lua.push) - --- | Add a function to the table at the top of the stack, using the given name. -addFunction :: Exposable PandocError a => Name -> a -> PandocLua () -addFunction name fn = liftPandocLua $ do - Lua.pushName name - Lua.pushHaskellFunction $ toHaskellFunction fn - Lua.rawset (-3) -- | Load a pure Lua module included with pandoc. Leaves the result on -- the stack and returns @NumResults 1@. diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs --- a/src/Text/Pandoc/Lua/Util.hs +++ b/src/Text/Pandoc/Lua/Util.hs @@ -18,8 +18,6 @@ module Text.Pandoc.Lua.Util ( getTag , addField - , addFunction - , pushViaConstructor , callWithTraceback , dofileWithTraceback , pushViaConstr' @@ -35,41 +33,6 @@ Lua.push key Lua.push value Lua.rawset (Lua.nth 3) - --- | Add a function to the table at the top of the stack, using the --- given name. -addFunction :: Exposable e a => String -> a -> LuaE e () -addFunction name fn = do - Lua.push name - Lua.pushHaskellFunction $ toHaskellFunction fn - Lua.rawset (-3) - --- | Helper class for pushing a single value to the stack via a lua --- function. See @pushViaCall@. -class LuaError e => PushViaCall e a where - pushViaCall' :: LuaError e => Name -> LuaE e () -> NumArgs -> a - -instance LuaError e => PushViaCall e (LuaE e ()) where - pushViaCall' fn pushArgs num = do - Lua.pushName @e fn - Lua.rawget Lua.registryindex - pushArgs - Lua.call num 1 - -instance (LuaError e, Pushable a, PushViaCall e b) => - PushViaCall e (a -> b) where - pushViaCall' fn pushArgs num x = - pushViaCall' @e fn (pushArgs *> Lua.push 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 :: forall e a. LuaError e => PushViaCall e a => Name -> a -pushViaCall fn = pushViaCall' @e fn (return ()) 0 - --- | Call a pandoc element constructor within Lua, passing all given arguments. -pushViaConstructor :: forall e a. LuaError e => PushViaCall e a => Name -> a -pushViaConstructor pandocFn = pushViaCall @e ("pandoc." <> pandocFn) -- | Get the tag of a value. This is an optimized and specialized version of -- @Lua.getfield idx "tag"@. It only checks for the field on the table at index diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs --- a/src/Text/Pandoc/Options.hs +++ b/src/Text/Pandoc/Options.hs @@ -34,10 +34,10 @@ , defaultKaTeXURL ) where import Control.Applicative ((<|>)) -import Data.Char (toLower) import Data.Maybe (fromMaybe) import Data.Data (Data) import Data.Default +import Data.Char (toLower) import Data.Text (Text) import qualified Data.Set as Set import Data.Typeable (Typeable) @@ -46,10 +46,9 @@ import Text.DocTemplates (Context(..), Template) import Text.Pandoc.Extensions import Text.Pandoc.Highlighting (Style, pygments) -import Text.Pandoc.Shared (camelCaseStrToHyphenated) -import Data.Aeson.TH (deriveJSON, defaultOptions, Options(..), - SumEncoding(..)) -import Data.YAML +import Text.Pandoc.UTF8 (toStringLazy) +import Data.Aeson.TH (deriveJSON) +import Data.Aeson class HasSyntaxExtensions a where getExtensions :: a -> Extensions @@ -106,9 +105,9 @@ | KaTeX Text -- url of KaTeX files deriving (Show, Read, Eq, Data, Typeable, Generic) -instance FromYAML HTMLMathMethod where - parseYAML node = - (withMap "HTMLMathMethod" $ \m -> do +instance FromJSON HTMLMathMethod where + parseJSON node = + (withObject "HTMLMathMethod" $ \m -> do method <- m .: "method" mburl <- m .:? "url" case method :: Text of @@ -121,43 +120,68 @@ "katex" -> return $ KaTeX $ fromMaybe defaultKaTeXURL mburl _ -> fail $ "Unknown HTML math method " ++ show method) node - <|> (withStr "HTMLMathMethod" $ \method -> - case method of - "plain" -> return PlainMath - "webtex" -> return $ WebTeX "" - "gladtex" -> return GladTeX - "mathml" -> return MathML - "mathjax" -> return $ MathJax defaultMathJaxURL - "katex" -> return $ KaTeX defaultKaTeXURL - _ -> fail $ "Unknown HTML math method " ++ show method) node + <|> (case node of + String "plain" -> return PlainMath + String "webtex" -> return $ WebTeX "" + String "gladtex" -> return GladTeX + String "mathml" -> return MathML + String "mathjax" -> return $ MathJax defaultMathJaxURL + String "katex" -> return $ KaTeX defaultKaTeXURL + _ -> fail $ "Unknown HTML math method " <> + toStringLazy (encode node)) +instance ToJSON HTMLMathMethod where + toJSON PlainMath = String "plain" + toJSON (WebTeX "") = String "webtex" + toJSON (WebTeX url) = object ["method" .= String "webtex", + "url" .= String url] + toJSON GladTeX = String "gladtex" + toJSON MathML = String "mathml" + toJSON (MathJax "") = String "mathjax" + toJSON (MathJax url) = object ["method" .= String "mathjax", + "url" .= String url] + toJSON (KaTeX "") = String "katex" + toJSON (KaTeX url) = object ["method" .= String "katex", + "url" .= String url] + data CiteMethod = Citeproc -- use citeproc to render them | Natbib -- output natbib cite commands | Biblatex -- output biblatex cite commands deriving (Show, Read, Eq, Data, Typeable, Generic) -instance FromYAML CiteMethod where - parseYAML = withStr "Citeproc" $ \t -> - case t of - "citeproc" -> return Citeproc - "natbib" -> return Natbib - "biblatex" -> return Biblatex - _ -> fail $ "Unknown citation method " ++ show t +instance FromJSON CiteMethod where + parseJSON v = + case v of + String "citeproc" -> return Citeproc + String "natbib" -> return Natbib + String "biblatex" -> return Biblatex + _ -> fail $ "Unknown citation method: " <> + toStringLazy (encode v) +instance ToJSON CiteMethod where + toJSON Citeproc = String "citeproc" + toJSON Natbib = String "natbib" + toJSON Biblatex = String "biblatex" + -- | Methods for obfuscating email addresses in HTML. data ObfuscationMethod = NoObfuscation | ReferenceObfuscation | JavascriptObfuscation deriving (Show, Read, Eq, Data, Typeable, Generic) -instance FromYAML ObfuscationMethod where - parseYAML = withStr "Citeproc" $ \t -> - case t of - "none" -> return NoObfuscation - "references" -> return ReferenceObfuscation - "javascript" -> return JavascriptObfuscation - _ -> fail $ "Unknown obfuscation method " ++ show t +instance FromJSON ObfuscationMethod where + parseJSON v = + case v of + String "none" -> return NoObfuscation + String "references" -> return ReferenceObfuscation + String "javascript" -> return JavascriptObfuscation + _ -> fail $ "Unknown obfuscation method " ++ toStringLazy (encode v) +instance ToJSON ObfuscationMethod where + toJSON NoObfuscation = String "none" + toJSON ReferenceObfuscation = String "references" + toJSON JavascriptObfuscation = String "javascript" + -- | Varieties of HTML slide shows. data HTMLSlideVariant = S5Slides | SlidySlides @@ -173,28 +197,44 @@ | AllChanges deriving (Show, Read, Eq, Data, Typeable, Generic) -instance FromYAML TrackChanges where - parseYAML = withStr "TrackChanges" $ \t -> - case t of - "accept" -> return AcceptChanges - "reject" -> return RejectChanges - "all" -> return AllChanges - _ -> fail $ "Unknown track changes method " ++ show t +-- update in doc/filters.md if this changes: +instance FromJSON TrackChanges where + parseJSON v = + case v of + String "accept" -> return AcceptChanges + String "reject" -> return RejectChanges + String "all" -> return AllChanges + String "accept-changes" -> return AcceptChanges + String "reject-changes" -> return RejectChanges + String "all-changes" -> return AllChanges + _ -> fail $ "Unknown track changes method " <> toStringLazy (encode v) +instance ToJSON TrackChanges where + toJSON AcceptChanges = String "accept-changes" + toJSON RejectChanges = String "reject-changes" + toJSON AllChanges = String "all-changes" + -- | Options for wrapping text in the output. data WrapOption = WrapAuto -- ^ Automatically wrap to width | WrapNone -- ^ No non-semantic newlines | WrapPreserve -- ^ Preserve wrapping of input source deriving (Show, Read, Eq, Data, Typeable, Generic) -instance FromYAML WrapOption where - parseYAML = withStr "WrapOption" $ \t -> - case t of - "auto" -> return WrapAuto - "none" -> return WrapNone - "preserve" -> return WrapPreserve - _ -> fail $ "Unknown wrap method " ++ show t +instance FromJSON WrapOption where + parseJSON v = + case v of + String "auto" -> return WrapAuto + String "wrap-auto" -> return WrapAuto + String "none" -> return WrapNone + String "wrap-none" -> return WrapNone + String "preserve" -> return WrapPreserve + String "wrap-preserve" -> return WrapPreserve + _ -> fail $ "Unknown wrap method " <> toStringLazy (encode v) +instance ToJSON WrapOption where + toJSON WrapAuto = "wrap-auto" + toJSON WrapNone = "wrap-none" + toJSON WrapPreserve = "wrap-preserve" -- | Options defining the type of top-level headers. data TopLevelDivision = TopLevelPart -- ^ Top-level headers become parts @@ -204,15 +244,24 @@ -- heuristics deriving (Show, Read, Eq, Data, Typeable, Generic) -instance FromYAML TopLevelDivision where - parseYAML = withStr "TopLevelDivision" $ \t -> - case t of - "part" -> return TopLevelPart - "chapter" -> return TopLevelChapter - "section" -> return TopLevelSection - "default" -> return TopLevelDefault - _ -> fail $ "Unknown top level division " ++ show t +instance FromJSON TopLevelDivision where + parseJSON v = + case v of + String "part" -> return TopLevelPart + String "top-level-part" -> return TopLevelPart + String "chapter" -> return TopLevelChapter + String "top-level-chapter" -> return TopLevelChapter + String "section" -> return TopLevelSection + String "top-level-section" -> return TopLevelSection + String "default" -> return TopLevelDefault + String "top-level-default" -> return TopLevelDefault + _ -> fail $ "Unknown top level division " <> toStringLazy (encode v) +instance ToJSON TopLevelDivision where + toJSON TopLevelPart = "top-level-part" + toJSON TopLevelChapter = "top-level-chapter" + toJSON TopLevelSection = "top-level-section" + toJSON TopLevelDefault = "top-level-default" -- | Locations for footnotes and references in markdown output data ReferenceLocation = EndOfBlock -- ^ End of block @@ -220,14 +269,21 @@ | EndOfDocument -- ^ at end of document deriving (Show, Read, Eq, Data, Typeable, Generic) -instance FromYAML ReferenceLocation where - parseYAML = withStr "ReferenceLocation" $ \t -> - case t of - "block" -> return EndOfBlock - "section" -> return EndOfSection - "document" -> return EndOfDocument - _ -> fail $ "Unknown reference location " ++ show t +instance FromJSON ReferenceLocation where + parseJSON v = + case v of + String "block" -> return EndOfBlock + String "end-of-block" -> return EndOfBlock + String "section" -> return EndOfSection + String "end-of-section" -> return EndOfSection + String "document" -> return EndOfDocument + String "end-of-document" -> return EndOfDocument + _ -> fail $ "Unknown reference location " <> toStringLazy (encode v) +instance ToJSON ReferenceLocation where + toJSON EndOfBlock = "end-of-block" + toJSON EndOfSection = "end-of-section" + toJSON EndOfDocument = "end-of-document" -- | Options for writers data WriterOptions = WriterOptions @@ -316,42 +372,9 @@ defaultKaTeXURL = "https://cdnjs.cloudflare.com/ajax/libs/KaTeX/0.11.1/" -- Update documentation in doc/filters.md if this is changed. -$(deriveJSON defaultOptions{ constructorTagModifier = - camelCaseStrToHyphenated - } ''TrackChanges) - -$(deriveJSON defaultOptions{ constructorTagModifier = - camelCaseStrToHyphenated - } ''WrapOption) - -$(deriveJSON defaultOptions{ constructorTagModifier = - camelCaseStrToHyphenated . drop 8 - } ''TopLevelDivision) - -$(deriveJSON defaultOptions{ constructorTagModifier = - camelCaseStrToHyphenated - } ''ReferenceLocation) - --- Update documentation in doc/filters.md if this is changed. -$(deriveJSON defaultOptions ''ReaderOptions) - -$(deriveJSON defaultOptions{ - constructorTagModifier = map toLower, - sumEncoding = TaggedObject{ - tagFieldName = "method", - contentsFieldName = "url" } - } ''HTMLMathMethod) - -$(deriveJSON defaultOptions{ constructorTagModifier = - camelCaseStrToHyphenated - } ''CiteMethod) - -$(deriveJSON defaultOptions{ constructorTagModifier = - \case - "NoObfuscation" -> "none" - "ReferenceObfuscation" -> "references" - "JavascriptObfuscation" -> "javascript" - _ -> "none" - } ''ObfuscationMethod) +$(deriveJSON defaultOptions{ fieldLabelModifier = + camelTo2 '-' . drop 6 } + ''ReaderOptions) -$(deriveJSON defaultOptions ''HTMLSlideVariant) +$(deriveJSON defaultOptions{ constructorTagModifier = map toLower } + ''HTMLSlideVariant) diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -28,7 +28,7 @@ import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T -import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString as BS import System.FilePath (addExtension, takeExtension, takeDirectory) import qualified System.FilePath.Windows as Windows import qualified System.FilePath.Posix as Posix @@ -72,14 +72,12 @@ yamlToMeta :: PandocMonad m => ReaderOptions -> Maybe FilePath - -> BL.ByteString + -> BS.ByteString -> m Meta yamlToMeta opts mbfp bstr = do let parser = do oldPos <- getPosition - case mbfp of - Nothing -> return () - Just fp -> setPosition $ initialPos fp + setPosition $ initialPos (fromMaybe "" mbfp) meta <- yamlBsToMeta (fmap B.toMetaValue <$> parseBlocks) bstr setPosition oldPos return $ runF meta defaultParserState @@ -95,7 +93,7 @@ => (Text -> Bool) -> ReaderOptions -> Maybe FilePath - -> BL.ByteString + -> BS.ByteString -> m [MetaValue] yamlToRefs idpred opts mbfp bstr = do let parser = do diff --git a/src/Text/Pandoc/Readers/Metadata.hs b/src/Text/Pandoc/Readers/Metadata.hs --- a/src/Text/Pandoc/Readers/Metadata.hs +++ b/src/Text/Pandoc/Readers/Metadata.hs @@ -17,102 +17,61 @@ yamlMetaBlock, yamlMap ) where -import Control.Monad + import Control.Monad.Except (throwError) -import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString as B import qualified Data.Map as M -import Data.Maybe import Data.Text (Text) import qualified Data.Text as T -import qualified Data.YAML as YAML -import qualified Data.YAML.Event as YE +import qualified Data.Yaml as Yaml +import Data.Aeson (Value(..), Object, Result(..), fromJSON, (.:?), withObject) +import Data.Aeson.Types (parse) +import Text.Pandoc.Shared (tshow) import Text.Pandoc.Class.PandocMonad (PandocMonad (..)) -import Text.Pandoc.Definition +import Text.Pandoc.Definition hiding (Null) import Text.Pandoc.Error -import Text.Pandoc.Parsing hiding (tableWith) -import Text.Pandoc.Shared -import qualified Data.Text.Lazy as TL +import Text.Pandoc.Parsing hiding (tableWith, parse) + + import qualified Text.Pandoc.UTF8 as UTF8 yamlBsToMeta :: (PandocMonad m, HasLastStrPosition st) => ParserT Sources st m (Future st MetaValue) - -> BL.ByteString + -> B.ByteString -> ParserT Sources st m (Future st Meta) yamlBsToMeta pMetaValue bstr = do - case YAML.decodeNode' YAML.failsafeSchemaResolver False False bstr of - Right (YAML.Doc (YAML.Mapping _ _ o):_) - -> fmap Meta <$> yamlMap pMetaValue o - Right [] -> return . return $ mempty - Right [YAML.Doc (YAML.Scalar _ YAML.SNull)] - -> return . return $ mempty - -- the following is what we get from a comment: - Right [YAML.Doc (YAML.Scalar _ (YAML.SUnknown _ ""))] - -> return . return $ mempty + case Yaml.decodeAllEither' bstr of + Right (Object o:_) -> fmap Meta <$> yamlMap pMetaValue o + Right [Null] -> return . return $ mempty Right _ -> Prelude.fail "expected YAML object" - Left (yamlpos, err') - -> do pos <- getPosition - setPosition $ incSourceLine - (setSourceColumn pos (YE.posColumn yamlpos)) - (YE.posLine yamlpos - 1) - Prelude.fail err' - -fakePos :: YAML.Pos -fakePos = YAML.Pos (-1) (-1) 1 0 - -lookupYAML :: Text - -> YAML.Node YE.Pos - -> Maybe (YAML.Node YE.Pos) -lookupYAML t (YAML.Mapping _ _ m) = - M.lookup (YAML.Scalar fakePos (YAML.SUnknown YE.untagged t)) m - `mplus` - M.lookup (YAML.Scalar fakePos (YAML.SStr t)) m -lookupYAML _ _ = Nothing + Left err' -> do + throwError $ PandocParseError + $ T.pack $ Yaml.prettyPrintParseException err' -- Returns filtered list of references. yamlBsToRefs :: (PandocMonad m, HasLastStrPosition st) => ParserT Sources st m (Future st MetaValue) -> (Text -> Bool) -- ^ Filter for id - -> BL.ByteString + -> B.ByteString -> ParserT Sources st m (Future st [MetaValue]) yamlBsToRefs pMetaValue idpred bstr = - case YAML.decodeNode' YAML.failsafeSchemaResolver False False bstr of - Right (YAML.Doc o@YAML.Mapping{}:_) - -> case lookupYAML "references" o of - Just (YAML.Sequence _ _ ns) -> do - let g n = case lookupYAML "id" n of - Just n' -> - case nodeToKey n' of - Nothing -> False - Just t -> idpred t || - case lookupYAML "other-ids" n of - Just (YAML.Sequence _ _ ns') -> - let ts' = mapMaybe nodeToKey ns' - in any idpred ts' - _ -> False - Nothing -> False - sequence <$> - mapM (yamlToMetaValue pMetaValue) (filter g ns) - Just _ -> - Prelude.fail "expecting sequence in 'references' field" - Nothing -> - Prelude.fail "expecting 'references' field" - - Right [] -> return . return $ mempty - Right [YAML.Doc (YAML.Scalar _ YAML.SNull)] - -> return . return $ mempty - Right _ -> Prelude.fail "expecting YAML object" - Left (yamlpos, err') - -> do pos <- getPosition - setPosition $ incSourceLine - (setSourceColumn pos (YE.posColumn yamlpos)) - (YE.posLine yamlpos - 1) - Prelude.fail err' - - -nodeToKey :: YAML.Node YE.Pos -> Maybe Text -nodeToKey (YAML.Scalar _ (YAML.SStr t)) = Just t -nodeToKey (YAML.Scalar _ (YAML.SUnknown _ t)) = Just t -nodeToKey _ = Nothing + case Yaml.decodeEither' bstr of + Right (Object m) -> do + let isSelected (String t) = idpred t + isSelected _ = False + let hasSelectedId (Object o) = + case parse (withObject "ref" (.:? "id")) (Object o) of + Success (Just id') -> isSelected id' + _ -> False + hasSelectedId _ = False + case parse (withObject "metadata" (.:? "references")) (Object m) of + Success (Just refs) -> sequence <$> + mapM (yamlToMetaValue pMetaValue) (filter hasSelectedId refs) + _ -> return $ return [] + Right _ -> return . return $ [] + Left err' -> do + throwError $ PandocParseError + $ T.pack $ Yaml.prettyPrintParseException err' normalizeMetaValue :: (PandocMonad m, HasLastStrPosition st) => ParserT Sources st m (Future st MetaValue) @@ -133,47 +92,36 @@ isSpaceChar '\t' = True isSpaceChar _ = False -checkBoolean :: Text -> Maybe Bool -checkBoolean t - | t == T.pack "true" || t == T.pack "True" || t == T.pack "TRUE" = Just True - | t == T.pack "false" || t == T.pack "False" || t == T.pack "FALSE" = Just False - | otherwise = Nothing - yamlToMetaValue :: (PandocMonad m, HasLastStrPosition st) => ParserT Sources st m (Future st MetaValue) - -> YAML.Node YE.Pos + -> Value -> ParserT Sources st m (Future st MetaValue) -yamlToMetaValue pMetaValue (YAML.Scalar _ x) = - case x of - YAML.SStr t -> normalizeMetaValue pMetaValue t - YAML.SBool b -> return $ return $ MetaBool b - YAML.SFloat d -> return $ return $ MetaString $ tshow d - YAML.SInt i -> return $ return $ MetaString $ tshow i - YAML.SUnknown _ t -> - case checkBoolean t of - Just b -> return $ return $ MetaBool b - Nothing -> normalizeMetaValue pMetaValue t - YAML.SNull -> return $ return $ MetaString "" - -yamlToMetaValue pMetaValue (YAML.Sequence _ _ xs) = - fmap MetaList . sequence - <$> mapM (yamlToMetaValue pMetaValue) xs -yamlToMetaValue pMetaValue (YAML.Mapping _ _ o) = - fmap MetaMap <$> yamlMap pMetaValue o -yamlToMetaValue _ _ = return $ return $ MetaString "" +yamlToMetaValue pMetaValue v = + case v of + String t -> normalizeMetaValue pMetaValue t + Bool b -> return $ return $ MetaBool b + Number d -> normalizeMetaValue pMetaValue $ + case fromJSON v of + Success (x :: Int) -> tshow x + _ -> tshow d + Null -> return $ return $ MetaString "" + Array{} -> do + case fromJSON v of + Error err' -> throwError $ PandocParseError $ T.pack err' + Success xs -> fmap MetaList . sequence <$> + mapM (yamlToMetaValue pMetaValue) xs + Object o -> fmap MetaMap <$> yamlMap pMetaValue o yamlMap :: (PandocMonad m, HasLastStrPosition st) => ParserT Sources st m (Future st MetaValue) - -> M.Map (YAML.Node YE.Pos) (YAML.Node YE.Pos) + -> Object -> ParserT Sources st m (Future st (M.Map Text MetaValue)) yamlMap pMetaValue o = do - kvs <- forM (M.toList o) $ \(key, v) -> do - k <- maybe (throwError $ PandocParseError - "Non-string key in YAML mapping") - return $ nodeToKey key - return (k, v) - let kvs' = filter (not . ignorable . fst) kvs - fmap M.fromList . sequence <$> mapM toMeta kvs' + case fromJSON (Object o) of + Error err' -> throwError $ PandocParseError $ T.pack err' + Success (m' :: M.Map Text Value) -> do + let kvs = filter (not . ignorable . fst) $ M.toList m' + fmap M.fromList . sequence <$> mapM toMeta kvs where ignorable t = "_" `T.isSuffixOf` t toMeta (k, v) = do @@ -194,7 +142,7 @@ -- by including --- and ..., we allow yaml blocks with just comments: let rawYaml = T.unlines ("---" : (rawYamlLines ++ ["..."])) optional blanklines - yamlBsToMeta parser $ UTF8.fromTextLazy $ TL.fromStrict rawYaml + yamlBsToMeta parser $ UTF8.fromText rawYaml stopLine :: Monad m => ParserT Sources st m () stopLine = try $ (string "---" <|> string "...") >> blankline >> return () diff --git a/src/Text/Pandoc/Translations.hs b/src/Text/Pandoc/Translations.hs --- a/src/Text/Pandoc/Translations.hs +++ b/src/Text/Pandoc/Translations.hs @@ -33,10 +33,11 @@ import qualified Data.Aeson.Types as Aeson import qualified Data.Map as M import qualified Data.Text as T -import qualified Data.YAML as YAML +import qualified Data.Yaml as Yaml import GHC.Generics (Generic) import Text.Pandoc.Shared (safeRead) import qualified Text.Pandoc.UTF8 as UTF8 +import Data.Yaml (prettyPrintParseException) data Term = Abstract @@ -73,14 +74,6 @@ show t parseJSON invalid = Aeson.typeMismatch "Term" invalid -instance YAML.FromYAML Term where - parseYAML (YAML.Scalar _ (YAML.SStr t)) = - case safeRead t of - Just t' -> pure t' - Nothing -> Prelude.fail $ "Invalid Term name " ++ - show t - parseYAML invalid = YAML.typeMismatch "Term" invalid - instance FromJSON Translations where parseJSON o@(Object{}) = do xs <- parseJSON o >>= mapM addItem . M.toList @@ -94,27 +87,12 @@ inv -> Aeson.typeMismatch "String" inv parseJSON invalid = Aeson.typeMismatch "Translations" invalid -instance YAML.FromYAML Translations where - parseYAML = YAML.withMap "Translations" $ - \tr -> Translations .M.fromList <$> mapM addItem (M.toList tr) - where addItem (n@(YAML.Scalar _ (YAML.SStr k)), v) = - case safeRead k of - Nothing -> YAML.typeMismatch "Term" n - Just t -> - case v of - (YAML.Scalar _ (YAML.SStr s)) -> - return (t, T.strip s) - n' -> YAML.typeMismatch "String" n' - addItem (n, _) = YAML.typeMismatch "String" n - lookupTerm :: Term -> Translations -> Maybe T.Text lookupTerm t (Translations tm) = M.lookup t tm readTranslations :: T.Text -> Either T.Text Translations readTranslations s = - case YAML.decodeStrict $ UTF8.fromText s of - Left (pos,err') -> Left $ T.pack $ err' ++ - " (line " ++ show (YAML.posLine pos) ++ " column " ++ - show (YAML.posColumn pos) ++ ")" + case Yaml.decodeAllEither' $ UTF8.fromText s of + Left err' -> Left $ T.pack $ prettyPrintParseException err' Right (t:_) -> Right t Right [] -> Left "empty YAML document" diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -880,8 +880,7 @@ (" " \\* ARABIC \">" <> tshow fignum - <> ""), - Str ":", Space] : alt + <> "")] : Str ": " : alt else alt return $ Elem (mknode "w:p" [] (map Elem paraProps ++ contents)) diff --git a/src/Text/Pandoc/Writers/Docx/Table.hs b/src/Text/Pandoc/Writers/Docx/Table.hs --- a/src/Text/Pandoc/Writers/Docx/Table.hs +++ b/src/Text/Pandoc/Writers/Docx/Table.hs @@ -98,8 +98,8 @@ addLabel :: Text -> Text -> Int -> [Block] -> [Block] addLabel tableid tablename tablenum bs = case bs of - (Para ils : rest) -> Para (label : Space : ils) : rest - (Plain ils : rest) -> Plain (label : Space : ils) : rest + (Para ils : rest) -> Para (label : Str ": " : ils) : rest + (Plain ils : rest) -> Plain (label : Str ": " : ils) : rest _ -> Para [label] : bs where label = Span (tableid,[],[]) @@ -108,8 +108,7 @@ (" " \\* ARABIC \">" <> tshow tablenum - <> ""), - Str ":"] + <> "")] -- | Parts of a table data RowType = HeadRow | BodyRow | FootRow diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -140,10 +140,20 @@ | otherwise = if hasNewlines x then hang 0 ("|" <> cr) x - else if isNothing $ foldM needsDoubleQuotes True x - then "\"" <> fmap escapeInDoubleQuotes x <> "\"" - else x + else case x of + Text _ t | isSpecialString t -> + "\"" <> fmap escapeInDoubleQuotes x <> "\"" + _ | isNothing (foldM needsDoubleQuotes True x) -> + "\"" <> fmap escapeInDoubleQuotes x <> "\"" + | otherwise -> x where + isSpecialString t = Set.member t specialStrings + specialStrings = Set.fromList + ["y", "Y", "yes", "Yes", "YES", "n", "N", + "no", "No", "NO", "true", "True", "TRUE", + "false", "False", "FALSE", "on", "On", "ON", + "off", "Off", "OFF", "null", "Null", + "NULL", "~", "*"] needsDoubleQuotes isFirst t = if T.any isBadAnywhere t || (isFirst && T.any isYamlPunct (T.take 1 t)) diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -7,8 +7,8 @@ packages: - '.' extra-deps: -- skylighting-core-0.12 -- skylighting-0.12 +- skylighting-core-0.12.1 +- skylighting-0.12.1 - doctemplates-0.10 - emojis-0.1.2 - doclayout-0.3.1.1 diff --git a/test/command/4819.md b/test/command/4819.md --- a/test/command/4819.md +++ b/test/command/4819.md @@ -49,9 +49,7 @@ ... ^D Pandoc - Meta - { unMeta = fromList [ ( "foo" , MetaInlines [ Str "no" ] ) ] - } + Meta { unMeta = fromList [ ( "foo" , MetaBool False ) ] } [] ``` diff --git a/test/command/6741.md b/test/command/6741.md --- a/test/command/6741.md +++ b/test/command/6741.md @@ -35,13 +35,13 @@ type: article-journal - author: - family: Suzuki - given: Y + given: Y. - family: Minami - given: T + given: T. - family: Laeng - given: B + given: B. - family: Nakauchi - given: S + given: S. container-title: Acta Psychologica DOI: 10.1016/j.actpsy.2019.102882 id: suzuki2019 diff --git a/test/command/pandoc-citeproc-312.md b/test/command/pandoc-citeproc-312.md --- a/test/command/pandoc-citeproc-312.md +++ b/test/command/pandoc-citeproc-312.md @@ -6,7 +6,7 @@ references: - author: - literal: NN - id: Y + id: 'Y' issued: - year: 1950 title: 'Date: Year' diff --git a/test/command/pandoc-citeproc-327.md b/test/command/pandoc-citeproc-327.md --- a/test/command/pandoc-citeproc-327.md +++ b/test/command/pandoc-citeproc-327.md @@ -45,7 +45,7 @@ ::: {#ref-LiLiaoDongWanHaiYuDiQiDongWuCiJiShengChanLiYanJiuJiShengJingGuaYiXingPingJie2017 .csl-entry} [\[1\] ]{.csl-left-margin}[李轶平, 于旭光, 孙明, 等. [辽东湾海域底栖动物次级生产力研究及生境适宜性评价](http://kns.cnki.net/kns/detail/detail.aspx?QueryID=4&CurRec=4&recid=&FileName=CHAN201706006&DbName=CJFDLAST2018&DbCode=CJFQ&yx=Y&pr=&URLID=21.1110.S.20171129.1725.006)\[J\]. -水产科学, 2017(06): 728--734.]{.csl-right-inline} +水产科学, 2017(6): 728--734.]{.csl-right-inline} ::: ::: ``` diff --git a/test/command/yaml-metadata-blocks.md b/test/command/yaml-metadata-blocks.md --- a/test/command/yaml-metadata-blocks.md +++ b/test/command/yaml-metadata-blocks.md @@ -51,11 +51,11 @@ , ( "float" , MetaInlines [ Str "2.5" ] ) , ( "int" , MetaInlines [ Str "8" ] ) , ( "more" , MetaBool False ) - , ( "nothing" , MetaInlines [ Str "null" ] ) + , ( "nothing" , MetaString "" ) , ( "scientific" , MetaInlines [ Str "3.7e-5" ] ) ]) ) - , ( "nothing" , MetaInlines [ Str "null" ] ) + , ( "nothing" , MetaString "" ) , ( "scientific" , MetaInlines [ Str "3.7e-5" ] ) ] } diff --git a/test/docx/golden/image.docx b/test/docx/golden/image.docx Binary files a/test/docx/golden/image.docx and b/test/docx/golden/image.docx differ diff --git a/test/docx/image_writer_test.native b/test/docx/image_writer_test.native --- a/test/docx/image_writer_test.native +++ b/test/docx/image_writer_test.native @@ -1,8 +1,10 @@ [Para [Str "No",Space,Str "width",Space,Str "given:"] -,Para [Image ("",[],[]) [Str "testimg"] ("lalune.jpg","fig:")] +,Para [Image ("fig:testimg",[],[]) [Str "testimg"] ("lalune.jpg","fig:")] ,Para [Str "With",Space,Str "height",Space,Str "10cm:"] -,Para [Image ("",[],[("height","10cm")]) [Str "2testimg"] ("lalune.jpg","fig:")] +,Para [Image ("fig:2testimg",[],[("height","10cm")]) [Str "2testimg"] ("lalune.jpg","fig:")] ,Para [Str "With",Space,Str "width",Space,Str "6cm:"] ,Para [Image ("",[],[("width","6cm")]) [Str "3testimg"] ("lalune.jpg","fig:")] ,Header 1 ("with-height-3in-and-width-6in",[],[]) [Str "With",Space,Str "height",Space,Str "3in",Space,Str "and",Space,Str "width",Space,Str "6in:"] -,Para [Image ("",[],[("width","6in"),("height","3in")]) [Str "4testimg"] ("lalune.jpg","fig:")]] +,Para [Image ("",[],[("width","6in"),("height","3in")]) [Str "4testimg"] ("lalune.jpg","fig:")] +,Para [RawInline (Format "openxml") ""] +,Para [RawInline (Format "openxml") ""]] diff --git a/test/epub/epub2_cover.epub b/test/epub/epub2_cover.epub Binary files a/test/epub/epub2_cover.epub and b/test/epub/epub2_cover.epub differ diff --git a/test/epub/epub2_no_cover.epub b/test/epub/epub2_no_cover.epub Binary files a/test/epub/epub2_no_cover.epub and b/test/epub/epub2_no_cover.epub differ diff --git a/test/epub/epub2_picture.epub b/test/epub/epub2_picture.epub Binary files a/test/epub/epub2_picture.epub and b/test/epub/epub2_picture.epub differ diff --git a/test/epub/features.epub b/test/epub/features.epub Binary files a/test/epub/features.epub and b/test/epub/features.epub differ diff --git a/test/epub/formatting.epub b/test/epub/formatting.epub Binary files a/test/epub/formatting.epub and b/test/epub/formatting.epub differ diff --git a/test/epub/img.epub b/test/epub/img.epub Binary files a/test/epub/img.epub and b/test/epub/img.epub differ diff --git a/test/epub/img_no_cover.epub b/test/epub/img_no_cover.epub Binary files a/test/epub/img_no_cover.epub and b/test/epub/img_no_cover.epub differ diff --git a/test/epub/wasteland.epub b/test/epub/wasteland.epub Binary files a/test/epub/wasteland.epub and b/test/epub/wasteland.epub differ diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -40,6 +40,13 @@ end ) }, + group 'Properties' { + test('has t and tag property', function () + local attr = pandoc.Attr('') + assert.are_equal(attr.t, 'Attr') + assert.are_equal(attr.tag, 'Attr') + end) + }, group 'AttributeList' { test('allows access via fields', function () local attributes = pandoc.Attr('', {}, {{'a', '1'}, {'b', '2'}}).attributes @@ -141,7 +148,198 @@ end) } }, + group "Inline elements" { + test('Link has property `content`', function () + local link = pandoc.Link('example', 'https://example.org') + assert.are_same(link.content, {pandoc.Str 'example'}) + link.content = 'commercial' + link.target = 'https://example.com' + assert.are_equal(link, pandoc.Link('commercial', 'https://example.com')) + end) + }, + group "Block elements" { + group "BulletList" { + test('access items via property `content`', function () + local para = pandoc.Para 'one' + local blist = pandoc.BulletList{{para}} + assert.are_same({{para}}, blist.content) + end), + test('property `content` uses fuzzy marshalling', function () + local old = pandoc.Plain 'old' + local new = pandoc.Plain 'new' + local blist = pandoc.BulletList{{old}} + blist.content = {{new}} + assert.are_same({{new}}, blist:clone().content) + blist.content = new + assert.are_same({{new}}, blist:clone().content) + end), + }, + group "OrderedList" { + test('access items via property `content`', function () + local para = pandoc.Plain 'one' + local olist = pandoc.OrderedList{{para}} + assert.are_same({{para}}, olist.content) + end), + test('forgiving constructor', function () + local plain = pandoc.Plain 'old' + local olist = pandoc.OrderedList({plain}, {3, 'Example', 'Period'}) + local listAttribs = pandoc.ListAttributes(3, 'Example', 'Period') + assert.are_same(olist.listAttributes, listAttribs) + end), + test('has list attribute aliases', function () + local olist = pandoc.OrderedList({}, {4, 'Decimal', 'OneParen'}) + assert.are_equal(olist.start, 4) + assert.are_equal(olist.style, 'Decimal') + assert.are_equal(olist.delimiter, 'OneParen') + end) + }, + group 'DefinitionList' { + test('access items via property `content`', function () + local deflist = pandoc.DefinitionList{ + {'apple', {{pandoc.Plain 'fruit'}, {pandoc.Plain 'company'}}}, + {pandoc.Str 'coffee', 'Best when hot.'} + } + assert.are_equal(#deflist.content, 2) + assert.are_same(deflist.content[1][1], {pandoc.Str 'apple'}) + assert.are_same(deflist.content[1][2][2], + {pandoc.Plain{pandoc.Str 'company'}}) + assert.are_same(deflist.content[2][2], + {{pandoc.Plain{pandoc.Str 'Best when hot.'}}}) + end), + test('modify items via property `content`', function () + local deflist = pandoc.DefinitionList{ + {'apple', {{{'fruit'}}, {{'company'}}}} + } + deflist.content[1][1] = pandoc.Str 'orange' + deflist.content[1][2][1] = {pandoc.Plain 'tasty fruit'} + local newlist = pandoc.DefinitionList{ + { {pandoc.Str 'orange'}, + {{pandoc.Plain 'tasty fruit'}, {pandoc.Plain 'company'}} + } + } + assert.are_equal(deflist, newlist) + end), + }, + group 'Para' { + test('access inline via property `content`', function () + local para = pandoc.Para{'Moin, ', pandoc.Space(), 'Sylt!'} + assert.are_same( + para.content, + {pandoc.Str 'Moin, ', pandoc.Space(), pandoc.Str 'Sylt!'} + ) + end), + test('modifying `content` changes the element', function () + local para = pandoc.Para{'Moin, ', pandoc.Space(), pandoc.Str 'Sylt!'} + + para.content[3] = 'Hamburg!' + assert.are_same( + para:clone().content, + {pandoc.Str 'Moin, ', pandoc.Space(), pandoc.Str 'Hamburg!'} + ) + + para.content = 'Huh' + assert.are_same( + para:clone().content, + {pandoc.Str 'Huh'} + ) + end), + }, + group 'LineBlock' { + test('access lines via property `content`', function () + local spc = pandoc.Space() + local lineblock = pandoc.LineBlock{ + {'200', spc, 'Main', spc, 'St.'}, + {'Berkeley', spc, 'CA', spc, '94718'} + } + assert.are_equal(#lineblock.content, 2) -- has two lines + assert.are_same(lineblock.content[2][1], pandoc.Str 'Berkeley') + end), + test('modifying `content` alter the element', function () + local spc = pandoc.Space() + local lineblock = pandoc.LineBlock{ + {'200', spc, 'Main', spc, 'St.'}, + {'Berkeley', spc, 'CA', spc, '94718'} + } + lineblock.content[1][1] = '404' + assert.are_same( + lineblock:clone().content[1], + {pandoc.Str '404', spc, pandoc.Str 'Main', spc, pandoc.Str 'St.'} + ) + + lineblock.content = {{'line1'}, {'line2'}} + assert.are_same( + lineblock:clone(), + pandoc.LineBlock{ + {pandoc.Str 'line1'}, + {pandoc.Str 'line2'} + } + ) + end) + }, + }, + group 'Other types' { + group 'SimpleTable' { + test('can access properties', function () + local spc = pandoc.Space() + local caption = {pandoc.Str 'Languages', spc, pandoc.Str 'overview.'} + local aligns = {pandoc.AlignDefault, pandoc.AlignDefault} + local widths = {0, 0} -- let pandoc determine col widths + local headers = {{pandoc.Plain({pandoc.Str "Language"})}, + {pandoc.Plain({pandoc.Str "Typing"})}} + local rows = { + {{pandoc.Plain "Haskell"}, {pandoc.Plain "static"}}, + {{pandoc.Plain "Lua"}, {pandoc.Plain "Dynamic"}}, + } + local simple_table = pandoc.SimpleTable( + caption, + aligns, + widths, + headers, + rows + ) + assert.are_same(simple_table.caption, caption) + assert.are_same(simple_table.aligns, aligns) + assert.are_same(simple_table.widths, widths) + assert.are_same(simple_table.headers, headers) + assert.are_same(simple_table.rows, rows) + end), + test('can modify properties', function () + local new_table = pandoc.SimpleTable( + {'Languages'}, + {pandoc.AlignDefault, pandoc.AlignDefault}, + {0.5, 0.5}, + {{pandoc.Plain({pandoc.Str "Language"})}, + {pandoc.Plain({pandoc.Str "Typing"})}}, + { + {{pandoc.Plain "Haskell"}, {pandoc.Plain "static"}}, + {{pandoc.Plain "Lua"}, {pandoc.Plain "Dynamic"}}, + } + ) + + new_table.caption = {pandoc.Str 'Good', pandoc.Space(), + pandoc.Str 'languages'} + new_table.aligns[1] = pandoc.AlignLeft + new_table.widths = {0, 0} + new_table.headers[2] = {pandoc.Plain{pandoc.Str 'compiled/interpreted'}} + new_table.rows[1][2] = {pandoc.Plain{pandoc.Str 'both'}} + new_table.rows[2][2] = {pandoc.Plain{pandoc.Str 'interpreted'}} + + local expected_table = pandoc.SimpleTable( + {pandoc.Str 'Good', pandoc.Space(), pandoc.Str 'languages'}, + {pandoc.AlignLeft, pandoc.AlignDefault}, + {0, 0}, + {{pandoc.Plain 'Language'}, {pandoc.Plain 'compiled/interpreted'}}, + { + {{pandoc.Plain 'Haskell'}, {pandoc.Plain 'both'}}, + {{pandoc.Plain 'Lua'}, {pandoc.Plain 'interpreted'}} + } + ) + assert.are_same(expected_table, new_table) + end) + } + }, + group 'clone' { test('clones Attr', function () local attr = pandoc.Attr('test', {'my-class'}, {foo = 'bar'}) @@ -176,6 +374,8 @@ local cloned = cite:clone() cite.id = 'newton' assert.are_same(cloned.id, 'leibniz') + assert.are_same(cite.id, 'newton') + assert.are_same(cite.mode, cloned.mode) end), }, @@ -217,6 +417,12 @@ } }) assert.are_same(expected, pandoc.read(valid_markdown)) + end), + test('unsupported extension', function () + assert.error_matches( + function () pandoc.read('foo', 'gfm+empty_paragraphs') end, + 'Extension empty_paragraphs not supported for gfm' + ) end), test('failing read', function () assert.error_matches( diff --git a/trypandoc/trypandoc.hs b/trypandoc/trypandoc.hs --- a/trypandoc/trypandoc.hs +++ b/trypandoc/trypandoc.hs @@ -52,12 +52,12 @@ let result = case runPure $ reader (tabFilter 4 text) >>= writer of Right s -> s Left err -> error (show err) - let output = encode $ object [ T.pack "html" .= result - , T.pack "name" .= + let output = encode $ object [ "html" .= result + , "name" .= if fromFormat == "markdown_strict" then T.pack "pandoc (strict)" else T.pack "pandoc" - , T.pack "version" .= pandocVersion] + , "version" .= pandocVersion] respond $ responseLBS status200 [(hContentType,"text/json; charset=UTF-8")] output checkLength :: Text -> IO Text