aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlbert Krewinkel <[email protected]>2023-03-19 23:31:32 +0100
committerAlbert Krewinkel <[email protected]>2023-03-20 08:30:04 +0100
commita53a6edfa58590163b5316805a0d719b904a3eb3 (patch)
tree4a328b0c54b40c04dd10d2d284a5919684c5f82e
parenta37eda971377397e7a2cc71553e5e5d7c0326a9b (diff)
lua-filters.md: Generate docs for pandoc.utils
The documentation in the Haskell sources has been updated.
-rw-r--r--doc/lua-filters.md315
-rw-r--r--pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Utils.hs464
-rw-r--r--tools/update-lua-module-docs.lua4
3 files changed, 485 insertions, 298 deletions
diff --git a/doc/lua-filters.md b/doc/lua-filters.md
index a78455577..584825b61 100644
--- a/doc/lua-filters.md
+++ b/doc/lua-filters.md
@@ -3789,73 +3789,81 @@ input resulted in an error.
<!-- END: AUTOGENERATED CONTENT -->
+<!-- BEGIN: AUTOGENERATED CONTENT for module pandoc.utils -->
+
# Module pandoc.utils
This module exposes internal pandoc functions and utility
functions.
-The module is loaded as part of the `pandoc` module and
-available as `pandoc.utils`. In versions up-to and including
-pandoc 2.6, this module had to be loaded explicitly. Example:
-
- pandoc.utils = require 'pandoc.utils'
+## Functions {#pandoc.utils-functions}
-Use the above for backwards compatibility.
+### blocks_to_inlines {#pandoc.utils.blocks_to_inlines}
-### `blocks_to_inlines (blocks[, sep])` {#pandoc.utils.blocks_to_inlines}
+`blocks_to_inlines (blocks[, sep])`
Squash a list of blocks into a list of inlines.
+Usage
+
+ local blocks = {
+ pandoc.Para{ pandoc.Str 'Paragraph1' },
+ pandoc.Para{ pandoc.Emph 'Paragraph2' }
+ }
+ local inlines = pandoc.utils.blocks_to_inlines(blocks)
+ assert(
+ inlines == pandoc.Inlines {
+ pandoc.Str 'Paragraph1',
+ pandoc.Linebreak(),
+ pandoc.Emph{ pandoc.Str 'Paragraph2' }
+ }
+ )
+
Parameters:
`blocks`
-: List of [Block](#type-block) elements to be flattened.
+: List of [Block] elements to be flattened. ([Blocks])
`sep`
-: List of [Inline](#type-inline) elements inserted as separator
- between two consecutive blocks; defaults to
- `{pandoc.LineBreak()}`.
+: List of [Inline] elements inserted as separator between two
+ consecutive blocks; defaults to `{pandoc.LineBreak()}`.
+ ([Inlines])
Returns:
-- [Inlines][]
+- ([Inlines])
-Usage:
+*Since: 2.2.3*
- local blocks = {
- pandoc.Para{ pandoc.Str 'Paragraph1' },
- pandoc.Para{ pandoc.Emph 'Paragraph2' }
- }
- local inlines = pandoc.utils.blocks_to_inlines(blocks)
- -- inlines = {
- -- pandoc.Str 'Paragraph1',
- -- pandoc.Space(), pandoc.Str'¶', pandoc.Space(),
- -- pandoc.Emph{ pandoc.Str 'Paragraph2' }
- -- }
+### citeproc {#pandoc.utils.citeproc}
-### `citeproc (doc)` {#pandoc.utils.citeproc}
+`citeproc (doc)`
Process the citations in the file, replacing them with rendered
citations and adding a bibliography. See the manual section on
citation rendering for details.
+Usage:
+
+ -- Lua filter that behaves like `--citeproc`
+ function Pandoc (doc)
+ return pandoc.utils.citeproc(doc)
+ end
+
Parameters:
`doc`
-: document ([Pandoc](#type-pandoc))
+: document ([Pandoc])
Returns:
-- processed document ([Pandoc](#type-pandoc))
+- processed document ([Pandoc])
-Usage:
+*Since: 2.19.1*
- -- Lua filter that behaves like `--citeproc`
- function Pandoc (doc)
- return pandoc.utils.citeproc(doc)
- end
+### equals {#pandoc.utils.equals}
-### `equals (element1, element2)` {#pandoc.utils.equals}
+`equals (element1, element2)`
Test equality of AST elements. Elements in Lua are considered
equal if and only if the objects obtained by unmarshaling are
@@ -3866,23 +3874,26 @@ operator instead.
Parameters:
-`element1`, `element2`
-: Objects to be compared (any type)
+`element1`
+: (any)
+
+`element2`
+: (any)
Returns:
- Whether the two objects represent the same element (boolean)
-### `from_simple_table (table)` {#pandoc.utils.from_simple_table}
+*Since: 2.5*
+
+### from_simple_table {#pandoc.utils.from_simple_table}
+
+`from_simple_table (simple_tbl)`
Creates a [Table] block element from a [SimpleTable]. This is
useful for dealing with legacy code which was written for pandoc
versions older than 2.10.
-Returns:
-
-- table block element ([Table])
-
Usage:
local simple = pandoc.SimpleTable(table)
@@ -3891,21 +3902,28 @@ Usage:
-- create normal table block again
table = pandoc.utils.from_simple_table(simple)
-### `make_sections (number_sections, base_level, blocks)` {#pandoc.utils.make_sections}
+Parameters:
-**Deprecated** Use
-[`pandoc.structure.make_sections`](#pandoc.structure.make_sections)
-instead.
+`simple_tbl`
+: ([SimpleTable])
+
+Returns:
+
+- table block element ([Block])
+
+*Since: 2.11*
+
+### make_sections {#pandoc.utils.make_sections}
-Converts list of [Block](#type-block) elements into sections.
-`Div`s will be created beginning at each `Header`
-and containing following content until the next `Header`
-of comparable level. If `number_sections` is true,
-a `number` attribute will be added to each `Header`
-containing the section number. If `base_level` is
-non-null, `Header` levels will be reorganized so
-that there are no gaps, and so that the base level
-is the level specified.
+`make_sections (number_sections, baselevel, blocks)`
+
+Converts a list of [Block] elements into sections. `Div`s will be
+created beginning at each `Header` and containing following
+content until the next `Header` of comparable level. If
+`number_sections` is true, a `number` attribute will be added to
+each `Header` containing the section number. If `base_level` is
+non-null, `Header` levels will be reorganized so that there are no
+gaps, and so that the base level is the level specified.
Parameters:
@@ -3913,17 +3931,20 @@ Parameters:
: whether section divs should get an additional `number`
attribute containing the section number. (boolean)
-`base_level`
-: shift top-level headings to this level. (integer|nil)
+`baselevel`
+: shift top-level headings to this level
+ ([integer]{unknown-type="integer"}\|nil)
`blocks`
-: list of blocks to process ([Blocks][])
+: list of blocks to process ([Blocks])
Returns:
-- [Blocks][].
+- blocks with sections ([Blocks])
+
+*Since: 2.8*
-### references {#pandoc.references}
+### references {#pandoc.utils.references}
`references (doc)`
@@ -3937,15 +3958,6 @@ used in CSL JSON; the return value can be use as `references`
metadata, which is one of the values used by pandoc and citeproc
when generating bibliographies.
-Parameters:
-
-`doc`
-: document ([Pandoc](#type-pandoc))
-
-Returns:
-
-- list of references. (table)
-
Usage:
-- Include all cited references in document
@@ -3955,7 +3967,18 @@ Usage:
return doc
end
-### run\_json\_filter {#pandoc.utils.run_json_filter}
+Parameters:
+
+`doc`
+: document ([Pandoc])
+
+Returns:
+
+- lift of references. (table)
+
+*Since: 2.17*
+
+### run_json_filter {#pandoc.utils.run_json_filter}
`run_json_filter (doc, filter[, args])`
@@ -3964,83 +3987,83 @@ Filter the given doc by passing it through a JSON filter.
Parameters:
`doc`
-: the Pandoc document to filter
+: the Pandoc document to filter ([Pandoc])
`filter`
-: filter to run
+: filter to run (string)
`args`
: list of arguments passed to the filter. Defaults to
- `{FORMAT}`.
+ `{FORMAT}`. ({[strings]{unknown-type="strings"},\...})
Returns:
-- ([Pandoc](#type-pandoc)) Filtered document
+- filtered document ([Pandoc])
-Usage:
+*Since: 2.1.1*
- -- Assumes `some_blocks` contains blocks for which a
- -- separate literature section is required.
- local sub_doc = pandoc.Pandoc(some_blocks, metadata)
- sub_doc_with_bib = pandoc.utils.run_json_filter(
- sub_doc,
- 'pandoc-citeproc'
- )
- some_blocks = sub_doc.blocks -- some blocks with bib
+### normalize_date {#pandoc.utils.normalize_date}
+
+`normalize_date (date)`
-### normalize\_date {#pandoc.utils.normalize_date}
+Parse a date and convert (if possible) to "YYYY-MM-DD" format. We
+limit years to the range 1601-9999 (ISO 8601 accepts greater than
+or equal to 1583, but MS Word only accepts dates starting 1601).
+Returns nil instead of a string if the conversion failed.
-`normalize_date (date_string)`
+Parameters:
-Parse a date and convert (if possible) to "YYYY-MM-DD" format.
-We limit years to the range 1601-9999 (ISO 8601 accepts greater
-than or equal to 1583, but MS Word only accepts dates starting
-1601).
+`date`
+: the date string (string)
Returns:
-- A date string, or nil when the conversion failed.
+- normalized date, or nil if normalization failed. ([string or
+ nil]{unknown-type="string or nil"})
+
+*Since: 2.0.6*
### sha1 {#pandoc.utils.sha1}
-`sha1 (contents)`
+`sha1 (input)`
-Returns the SHA1 has of the contents.
+Computes the SHA1 hash of the given string input.
-Returns:
+Parameters:
-- SHA1 hash of the contents.
+`input`
+: (string)
-Usage:
+Returns:
- local fp = pandoc.utils.sha1("foobar")
+- hexadecimal hash value (string)
+
+*Since: 2.0.6*
### stringify {#pandoc.utils.stringify}
`stringify (element)`
-Converts the given element (Pandoc, Meta, Block, or Inline) into
-a string with all formatting removed.
-
-Returns:
+Converts the given element (Pandoc, Meta, Block, or Inline) into a
+string with all formatting removed.
-- A plain string representation of the given element.
+Parameters:
-Usage:
+`element`
+: some pandoc AST element ([AST
+ element]{unknown-type="AST element"})
- local inline = pandoc.Emph{pandoc.Str 'Moin'}
- -- outputs "Moin"
- print(pandoc.utils.stringify(inline))
+Returns:
-### to\_roman\_numeral {#pandoc.utils.to_roman_numeral}
+- A plain string representation of the given element. (string)
-`to_roman_numeral (integer)`
+*Since: 2.0.6*
-Converts an integer \< 4000 to uppercase roman numeral.
+### to_roman_numeral {#pandoc.utils.to_roman_numeral}
-Returns:
+`to_roman_numeral (n)`
-- A roman numeral string.
+Converts an integer \< 4000 to uppercase roman numeral.
Usage:
@@ -4048,15 +4071,23 @@ Usage:
local pandoc_birth_year = to_roman_numeral(2006)
-- pandoc_birth_year == 'MMVI'
-### to\_simple\_table {#pandoc.utils.to_simple_table}
-
-`to_simple_table (table)`
+Parameters:
-Creates a [SimpleTable] out of a [Table] block.
+`n`
+: positive integer below 4000
+ ([integer]{unknown-type="integer"})
Returns:
-- a simple table object ([SimpleTable])
+- A roman numeral. (string)
+
+*Since: 2.0.6*
+
+### to_simple_table {#pandoc.utils.to_simple_table}
+
+`to_simple_table (tbl)`
+
+Converts a table into an old/simple table.
Usage:
@@ -4066,38 +4097,64 @@ Usage:
-- create normal table block again
table = pandoc.utils.from_simple_table(simple)
+Parameters:
+
+`tbl`
+: a table ([Block])
+
+Returns:
+
+- SimpleTable object ([SimpleTable])
+
+*Since: 2.11*
+
### type {#pandoc.utils.type}
`type (value)`
Pandoc-friendly version of Lua's default `type` function,
-returning the type of a value. This function works with all types
-listed in section [Lua type reference][], except if noted
-otherwise.
+returning type information similar to what is presented in the
+manual.
The function works by checking the metafield `__name`. If the
argument has a string-valued metafield `__name`, then it returns
that string. Otherwise it behaves just like the normal `type`
function.
+Usage: -- Prints one of 'string', 'boolean', 'Inlines', 'Blocks',
+-- 'table', and 'nil', corresponding to the Haskell constructors
+-- MetaString, MetaBool, MetaInlines, MetaBlocks, MetaMap, -- and
+an unset value, respectively. function Meta (meta) print('type of
+metavalue `author`:', pandoc.utils.type(meta.author)) end
+
Parameters:
`value`
-: any Lua value
+: any Lua value (any)
Returns:
- type of the given value (string)
-Usage:
+*Since: 2.17*
- -- Prints one of 'string', 'boolean', 'Inlines', 'Blocks',
- -- 'table', and 'nil', corresponding to the Haskell constructors
- -- MetaString, MetaBool, MetaInlines, MetaBlocks, MetaMap,
- -- and an unset value, respectively.
- function Meta (meta)
- print('type of metavalue `author`:', pandoc.utils.type(meta.author))
- end
+### Version {#pandoc.utils.Version}
+
+`Version (v)`
+
+Creates a Version object.
+
+Parameters:
+
+`v`
+: version description ([version string, list of integers, or
+ integer]{unknown-type="version string, list of integers, or integer"})
+
+Returns:
+
+- new Version object ([Version]{unknown-type="Version"})
+
+<!-- END: AUTOGENERATED CONTENT -->
<!-- BEGIN: AUTOGENERATED CONTENT for module pandoc.mediabag -->
@@ -6084,12 +6141,14 @@ Returns:
<!-- BEGIN: GENERATED REFERENCE LINKS -->
- [Pandoc]: #type-pandoc
- [`list`]: #pandoc.mediabag.list
- [Inline]: Inline
[Block]: #type-block
- [Inlines]: Inlines
[Blocks]: #type-blocks
+ [Inline]: #type-inline
+ [Inlines]: #type-inlines
+ [Pandoc]: #type-pandoc
+ [Table]: #type-table
+ [SimpleTable]: #type-simpletable
+ [`list`]: #pandoc.mediabag.list
[null]: #pandoc.json.null
[this blog post]: http://neilmitchell.blogspot.co.uk/2015/10/filepaths-are-subtle-symlinks-are-hard.html
[WriterOptions]: #type-writeroptions
diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Utils.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Utils.hs
index b87efd756..44c03bfd4 100644
--- a/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Utils.hs
+++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Utils.hs
@@ -46,65 +46,27 @@ import qualified Text.Pandoc.Writers.Shared as Shared
documentedModule :: Module PandocError
documentedModule = Module
{ moduleName = "pandoc.utils"
- , moduleDescription = "pandoc utility functions"
+ , moduleDescription = T.unlines
+ [ "This module exposes internal pandoc functions and utility"
+ , "functions."
+ ]
, moduleFields = []
, moduleOperations = []
, moduleTypeInitializers = []
- , moduleFunctions =
- [ defun "blocks_to_inlines"
- ### (\blks mSep -> do
- let sep = maybe Shared.defaultBlocksSeparator B.fromList mSep
- return $ B.toList (Shared.blocksToInlinesWithSep sep blks))
- <#> parameter (peekList peekBlock) "list of blocks"
- "blocks" ""
- <#> opt (parameter (peekList peekInline) "Inlines" "sep" "")
- =#> functionResult pushInlines "list of inlines" ""
- `since` v[2,2,3]
-
- , defun "citeproc"
- ### unPandocLua . processCitations
- <#> parameter peekPandoc "Pandoc" "doc" "document"
- =#> functionResult pushPandoc "Pandoc" "processed document"
- #? T.unwords
- [ "Process the citations in the file, replacing them with "
- , "rendered citations and adding a bibliography. "
- , "See the manual section on citation rendering for details."
- ]
- `since` v[2,19,1]
-
- , defun "equals"
- ### equal
- <#> parameter pure "AST element" "elem1" ""
- <#> parameter pure "AST element" "elem2" ""
- =#> functionResult pushBool "boolean" "true iff elem1 == elem2"
- `since` v[2,5]
-
- , defun "make_sections"
- ### liftPure3 Shared.makeSections
- <#> parameter peekBool "boolean" "numbering" "add header numbers"
- <#> parameter (\i -> (Nothing <$ peekNil i) <|> (Just <$!> peekIntegral i))
- "integer or nil" "baselevel" ""
- <#> parameter (peekList peekBlock) "list of blocks"
- "blocks" "document blocks to process"
- =#> functionResult pushBlocks "list of Blocks"
- "processes blocks"
- `since` v[2,8]
-
- , defun "normalize_date"
- ### liftPure Shared.normalizeDate
- <#> parameter peekText "string" "date" "the date string"
- =#> functionResult (maybe pushnil pushText) "string or nil"
- "normalized date, or nil if normalization failed."
- #? T.unwords
- [ "Parse a date and convert (if possible) to \"YYYY-MM-DD\" format. We"
- , "limit years to the range 1601-9999 (ISO 8601 accepts greater than"
- , "or equal to 1583, but MS Word only accepts dates starting 1601)."
- , "Returns nil instead of a string if the conversion failed."
- ]
- `since` v [2,0,6]
-
- , sha1
- `since` v [2,0,6]
+ , moduleFunctions = -- FIXME: order alphabetically
+ [ blocks_to_inlines `since` v[2,2,3]
+ , citeproc `since` v[2,19,1]
+ , equals `since` v[2,5]
+ , from_simple_table `since` v[2,11]
+ , make_sections `since` v[2,8]
+ , references `since` v[2,17]
+ , run_json_filter `since` v[2,1,1]
+ , normalize_date `since` v[2,0,6]
+ , sha1 `since` v[2,0,6]
+ , stringify `since` v[2,0,6]
+ , to_roman_numeral `since` v[2,0,6]
+ , to_simple_table `since` v[2,11]
+ , type' `since` v[2,17]
, defun "Version"
### liftPure (id @Version)
@@ -113,101 +75,225 @@ documentedModule = Module
"v" "version description"
=#> functionResult pushVersion "Version" "new Version object"
#? "Creates a Version object."
-
- , defun "references"
- ### (unPandocLua . getReferences Nothing)
- <#> parameter peekPandoc "Pandoc" "doc" "document"
- =#> functionResult (pushPandocList pushReference) "table"
- "lift of references"
- #? mconcat
- [ "Get references defined inline in the metadata and via an external "
- , "bibliography. Only references that are actually cited in the "
- , "document (either with a genuine citation or with `nocite`) are "
- , "returned. URL variables are converted to links."
- ]
- `since` v[2,17]
-
- , defun "run_json_filter"
- ### (\doc filterPath margs -> do
- args <- case margs of
- Just xs -> return xs
- Nothing -> do
- Lua.getglobal "FORMAT"
- (forcePeek ((:[]) <$!> peekString top) <* pop 1)
- applyJSONFilter def args filterPath doc
- )
- <#> parameter peekPandoc "Pandoc" "doc" "input document"
- <#> parameter peekString "filepath" "filter_path" "path to filter"
- <#> opt (parameter (peekList peekString) "list of strings"
- "args" "arguments to pass to the filter")
- =#> functionResult pushPandoc "Pandoc" "filtered document"
- `since` v[2,1,1]
-
- , defun "stringify"
- ### stringify
- <#> parameter pure "AST element" "elem" "some pandoc AST element"
- =#> functionResult pushText "string" "stringified element"
- `since` v [2,0,6]
-
- , defun "from_simple_table"
- ### from_simple_table
- <#> parameter peekSimpleTable "SimpleTable" "simple_tbl" ""
- =?> "Simple table"
- `since` v[2,11]
-
- , defun "to_roman_numeral"
- ### liftPure Shared.toRomanNumeral
- <#> parameter (peekIntegral @Int) "integer" "n" "number smaller than 4000"
- =#> functionResult pushText "string" "roman numeral"
- #? "Converts a number < 4000 to uppercase roman numeral."
- `since` v[2,0,6]
-
- , defun "to_simple_table"
- ### to_simple_table
- <#> parameter peekTable "Block" "tbl" "a table"
- =#> functionResult pushSimpleTable "SimpleTable" "SimpleTable object"
- #? "Converts a table into an old/simple table."
- `since` v[2,11]
-
- , defun "type"
- ### (\idx -> getmetafield idx "__name" >>= \case
- TypeString -> fromMaybe mempty <$> tostring top
- _ -> ltype idx >>= typename)
- <#> parameter pure "any" "object" ""
- =#> functionResult pushByteString "string" "type of the given value"
- #? ("Pandoc-friendly version of Lua's default `type` function, " <>
- "returning the type of a value. If the argument has a " <>
- "string-valued metafield `__name`, then it gives that string. " <>
- "Otherwise it behaves just like the normal `type` function.")
- `since` v[2,17]
]
}
where
v = makeVersion
+blocks_to_inlines :: LuaError e => DocumentedFunction e
+blocks_to_inlines = defun "blocks_to_inlines"
+ ### (\blks mSep -> do
+ let sep = maybe Shared.defaultBlocksSeparator B.fromList mSep
+ return $ B.toList (Shared.blocksToInlinesWithSep sep blks))
+ <#> parameter (peekList peekBlock) "Blocks"
+ "blocks"
+ "List of [[Block]] elements to be flattened."
+ <#> opt (parameter (peekList peekInline) "Inlines" "sep"
+ ("List of [[Inline]] elements inserted as separator between\n" <>
+ "two consecutive blocks; defaults to `{pandoc.LineBreak()}`."))
+ =#> functionResult pushInlines "Inlines" ""
+ #? T.unlines
+ [ "Squash a list of blocks into a list of inlines."
+ , ""
+ , "Usage"
+ , ""
+ , " local blocks = {"
+ , " pandoc.Para{ pandoc.Str 'Paragraph1' },"
+ , " pandoc.Para{ pandoc.Emph 'Paragraph2' }"
+ , " }"
+ , " local inlines = pandoc.utils.blocks_to_inlines(blocks)"
+ , " assert("
+ , " inlines == pandoc.Inlines {"
+ , " pandoc.Str 'Paragraph1',"
+ , " pandoc.Linebreak(),"
+ , " pandoc.Emph{ pandoc.Str 'Paragraph2' }"
+ , " }"
+ , " )"
+ ]
+
+citeproc :: DocumentedFunction PandocError
+citeproc = defun "citeproc"
+ ### unPandocLua . processCitations
+ <#> parameter peekPandoc "Pandoc" "doc" "document"
+ =#> functionResult pushPandoc "Pandoc" "processed document"
+ #? T.unlines
+ [ "Process the citations in the file, replacing them with "
+ , "rendered citations and adding a bibliography. "
+ , "See the manual section on citation rendering for details."
+ , ""
+ , "Usage:"
+ , ""
+ , " -- Lua filter that behaves like `--citeproc`"
+ , " function Pandoc (doc)"
+ , " return pandoc.utils.citeproc(doc)"
+ , " end"
+ ]
+
+equals :: LuaError e => DocumentedFunction e
+equals = defun "equals"
+ ### equal
+ <#> parameter pure "any" "element1" ""
+ <#> parameter pure "any" "element2" ""
+ =#> functionResult pushBool "boolean"
+ "Whether the two objects represent the same element"
+ #? T.unlines
+ [ "Test equality of AST elements. Elements in Lua are considered"
+ , "equal if and only if the objects obtained by unmarshaling are"
+ , "equal."
+ , ""
+ , "**This function is deprecated.** Use the normal Lua `==` equality"
+ , "operator instead."
+ ]
+
+-- | Converts an old/simple table into a normal table block element.
+from_simple_table :: LuaError e => DocumentedFunction e
+from_simple_table = defun "from_simple_table"
+ ### liftPure
+ (\(SimpleTable capt aligns widths head' body) ->
+ Table
+ nullAttr
+ (Caption Nothing [Plain capt | not (null capt)])
+ (zipWith (\a w -> (a, toColWidth w)) aligns widths)
+ (TableHead nullAttr [blockListToRow head' | not (null head') ])
+ [TableBody nullAttr 0 [] $ map blockListToRow body | not (null body)]
+ (TableFoot nullAttr []))
+ <#> parameter peekSimpleTable "SimpleTable" "simple_tbl" ""
+ =#> functionResult pushBlock "Block" "table block element"
+ #? T.unlines
+ [ "Creates a [[Table]] block element from a [[SimpleTable]]. This is"
+ , "useful for dealing with legacy code which was written for pandoc"
+ , "versions older than 2.10."
+ , ""
+ , "Usage:"
+ , ""
+ , " local simple = pandoc.SimpleTable(table)"
+ , " -- modify, using pre pandoc 2.10 methods"
+ , " simple.caption = pandoc.SmallCaps(simple.caption)"
+ , " -- create normal table block again"
+ , " table = pandoc.utils.from_simple_table(simple)"
+ ]
+ where
+ blockListToRow :: [[Block]] -> Row
+ blockListToRow = Row nullAttr . map (B.simpleCell . B.fromList)
+
+ toColWidth :: Double -> ColWidth
+ toColWidth 0 = ColWidthDefault
+ toColWidth w = ColWidth w
+
+make_sections :: LuaError e => DocumentedFunction e
+make_sections = defun "make_sections"
+ ### liftPure3 Shared.makeSections
+ <#> parameter peekBool "boolean" "number_sections"
+ ("whether section divs should get an additional `number`\n" <>
+ "attribute containing the section number.")
+ <#> parameter (\i -> (Nothing <$ peekNil i) <|> (Just <$!> peekIntegral i))
+ "integer|nil" "baselevel"
+ "shift top-level headings to this level"
+ <#> parameter (peekList peekBlock) "Blocks"
+ "blocks" "list of blocks to process"
+ =#> functionResult pushBlocks "Blocks"
+ "blocks with sections"
+ #? T.unlines
+ [ "Converts a list of [[Block]] elements into sections."
+ , "`Div`s will be created beginning at each `Header`"
+ , "and containing following content until the next `Header`"
+ , "of comparable level. If `number_sections` is true,"
+ , "a `number` attribute will be added to each `Header`"
+ , "containing the section number. If `base_level` is"
+ , "non-null, `Header` levels will be reorganized so"
+ , "that there are no gaps, and so that the base level"
+ , "is the level specified."
+ ]
+
+normalize_date :: DocumentedFunction e
+normalize_date = defun "normalize_date"
+ ### liftPure Shared.normalizeDate
+ <#> parameter peekText "string" "date" "the date string"
+ =#> functionResult (maybe pushnil pushText) "string or nil"
+ "normalized date, or nil if normalization failed."
+ #? T.unwords
+ [ "Parse a date and convert (if possible) to \"YYYY-MM-DD\" format. We"
+ , "limit years to the range 1601-9999 (ISO 8601 accepts greater than"
+ , "or equal to 1583, but MS Word only accepts dates starting 1601)."
+ , "Returns nil instead of a string if the conversion failed."
+ ]
+
+-- | List of references in CSL format.
+references :: DocumentedFunction PandocError
+references = defun "references"
+ ### (unPandocLua . getReferences Nothing)
+ <#> parameter peekPandoc "Pandoc" "doc" "document"
+ =#> functionResult (pushPandocList pushReference) "table"
+ "lift of references."
+ #? T.unlines
+ [ "Get references defined inline in the metadata and via an external"
+ , "bibliography. Only references that are actually cited in the"
+ , "document (either with a genuine citation or with `nocite`) are"
+ , "returned. URL variables are converted to links."
+ , ""
+ , "The structure used represent reference values corresponds to that"
+ , "used in CSL JSON; the return value can be use as `references`"
+ , "metadata, which is one of the values used by pandoc and citeproc"
+ , "when generating bibliographies."
+ , ""
+ , "Usage:"
+ , ""
+ , " -- Include all cited references in document"
+ , " function Pandoc (doc)"
+ , " doc.meta.references = pandoc.utils.references(doc)"
+ , " doc.meta.bibliography = nil"
+ , " return doc"
+ , " end"
+ ]
+
+run_json_filter :: DocumentedFunction PandocError
+run_json_filter = defun "run_json_filter"
+ ### (\doc filterPath margs -> do
+ args <- case margs of
+ Just xs -> return xs
+ Nothing -> do
+ Lua.getglobal "FORMAT"
+ (forcePeek ((:[]) <$!> peekString top) <* pop 1)
+ applyJSONFilter def args filterPath doc
+ )
+ <#> parameter peekPandoc "Pandoc" "doc" "the Pandoc document to filter"
+ <#> parameter peekString "string" "filter" "filter to run"
+ <#> opt (parameter (peekList peekString) "{string,...}" "args"
+ "list of arguments passed to the filter. Defaults to `{FORMAT}`.")
+ =#> functionResult pushPandoc "Pandoc" "filtered document"
+ #? "Filter the given doc by passing it through a JSON filter."
+
-- | 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."
-
+ #? "Computes the SHA1 hash of the given string input."
-- | Convert pandoc structure to a string with formatting removed.
-- Footnotes are skipped (since we don't want their contents in link
-- labels).
-stringify :: LuaError e => StackIndex -> LuaE e T.Text
-stringify idx = forcePeek . retrieving "stringifyable element" $
- choice
- [ (fmap Shared.stringify . peekPandoc)
- , (fmap Shared.stringify . peekInline)
- , (fmap Shared.stringify . peekBlock)
- , (fmap Shared.stringify . peekCitation)
- , (fmap stringifyMetaValue . peekMetaValue)
- , (fmap (const "") . peekAttr)
- , (fmap (const "") . peekListAttributes)
- ] idx
+stringify :: LuaError e => DocumentedFunction e
+stringify = defun "stringify"
+ ### (\idx ->
+ forcePeek . retrieving "stringifyable element" $
+ choice
+ [ (fmap Shared.stringify . peekPandoc)
+ , (fmap Shared.stringify . peekInline)
+ , (fmap Shared.stringify . peekBlock)
+ , (fmap Shared.stringify . peekCitation)
+ , (fmap stringifyMetaValue . peekMetaValue)
+ , (fmap (const "") . peekAttr)
+ , (fmap (const "") . peekListAttributes)
+ ] idx)
+ <#> parameter pure "AST element" "element" "some pandoc AST element"
+ =#> functionResult pushText "string"
+ "A plain string representation of the given element."
+ #? T.unlines
+ [ "Converts the given element (Pandoc, Meta, Block, or Inline) into"
+ , "a string with all formatting removed."
+ ]
where
stringifyMetaValue :: MetaValue -> T.Text
stringifyMetaValue mv = case mv of
@@ -217,39 +303,77 @@ stringify idx = forcePeek . retrieving "stringifyable element" $
MetaMap m -> mconcat $ map (stringifyMetaValue . snd) (Map.toList m)
_ -> Shared.stringify mv
--- | Converts an old/simple table into a normal table block element.
-from_simple_table :: SimpleTable -> LuaE PandocError NumResults
-from_simple_table (SimpleTable capt aligns widths head' body) = do
- pushBlock $ Table
- nullAttr
- (Caption Nothing [Plain capt | not (null capt)])
- (zipWith (\a w -> (a, toColWidth w)) aligns widths)
- (TableHead nullAttr [blockListToRow head' | not (null head') ])
- [TableBody nullAttr 0 [] $ map blockListToRow body | not (null body)]
- (TableFoot nullAttr [])
- return (NumResults 1)
- where
- blockListToRow :: [[Block]] -> Row
- blockListToRow = Row nullAttr . map (B.simpleCell . B.fromList)
-
- toColWidth :: Double -> ColWidth
- toColWidth 0 = ColWidthDefault
- toColWidth w = ColWidth w
+
+to_roman_numeral :: LuaError e => DocumentedFunction e
+to_roman_numeral = defun "to_roman_numeral"
+ ### liftPure Shared.toRomanNumeral
+ <#> parameter (peekIntegral @Int) "integer" "n"
+ "positive integer below 4000"
+ =#> functionResult pushText "string" "A roman numeral."
+ #? T.unlines
+ [ "Converts an integer < 4000 to uppercase roman numeral."
+ , ""
+ , "Usage:"
+ , ""
+ , " local to_roman_numeral = pandoc.utils.to_roman_numeral"
+ , " local pandoc_birth_year = to_roman_numeral(2006)"
+ , " -- pandoc_birth_year == 'MMVI'"
+ ]
-- | Converts a table into an old/simple table.
-to_simple_table :: Block -> LuaE PandocError SimpleTable
-to_simple_table = \case
- Table _attr caption specs thead tbodies tfoot -> do
- let (capt, aligns, widths, headers, rows) =
- Shared.toLegacyTable caption specs thead tbodies tfoot
- return $ SimpleTable capt aligns widths headers rows
- blk -> Lua.failLua $ mconcat
- [ "Expected Table, got ", showConstr (toConstr blk), "." ]
-
-peekTable :: LuaError e => Peeker e Block
-peekTable idx = peekBlock idx >>= \case
- t@(Table {}) -> return t
- b -> Lua.failPeek $ mconcat
- [ "Expected Table, got "
- , UTF8.fromString $ showConstr (toConstr b)
- , "." ]
+to_simple_table :: DocumentedFunction PandocError
+to_simple_table = defun "to_simple_table"
+ ### (\case
+ Table _attr caption specs thead tbodies tfoot -> do
+ let (capt, aligns, widths, headers, rows) =
+ Shared.toLegacyTable caption specs thead tbodies tfoot
+ return $ SimpleTable capt aligns widths headers rows
+ blk -> Lua.failLua $ mconcat
+ [ "Expected Table, got ", showConstr (toConstr blk), "." ])
+ <#> parameter peekTable "Block" "tbl" "a table"
+ =#> functionResult pushSimpleTable "SimpleTable" "SimpleTable object"
+ #? T.unlines
+ [ "Converts a table into an old/simple table."
+ , ""
+ , "Usage:"
+ , ""
+ , " local simple = pandoc.utils.to_simple_table(table)"
+ , " -- modify, using pre pandoc 2.10 methods"
+ , " simple.caption = pandoc.SmallCaps(simple.caption)"
+ , " -- create normal table block again"
+ , " table = pandoc.utils.from_simple_table(simple)"
+ ]
+ where
+ peekTable :: LuaError e => Peeker e Block
+ peekTable idx = peekBlock idx >>= \case
+ t@(Table {}) -> return t
+ b -> Lua.failPeek $ mconcat
+ [ "Expected Table, got "
+ , UTF8.fromString $ showConstr (toConstr b)
+ , "." ]
+
+type' :: DocumentedFunction e
+type' = defun "type"
+ ### (\idx -> getmetafield idx "__name" >>= \case
+ TypeString -> fromMaybe mempty <$> tostring top
+ _ -> ltype idx >>= typename)
+ <#> parameter pure "any" "value" "any Lua value"
+ =#> functionResult pushByteString "string" "type of the given value"
+ #? T.unlines
+ [ "Pandoc-friendly version of Lua's default `type` function, returning"
+ , "type information similar to what is presented in the manual."
+ , ""
+ , "The function works by checking the metafield `__name`. If the"
+ , "argument has a string-valued metafield `__name`, then it returns"
+ , "that string. Otherwise it behaves just like the normal `type`"
+ , "function."
+ , ""
+ , "Usage:"
+ , " -- Prints one of 'string', 'boolean', 'Inlines', 'Blocks',"
+ , " -- 'table', and 'nil', corresponding to the Haskell constructors"
+ , " -- MetaString, MetaBool, MetaInlines, MetaBlocks, MetaMap,"
+ , " -- and an unset value, respectively."
+ , " function Meta (meta)"
+ , " print('type of metavalue `author`:', pandoc.utils.type(meta.author))"
+ , " end"
+ ]
diff --git a/tools/update-lua-module-docs.lua b/tools/update-lua-module-docs.lua
index 61842605e..21044b9d6 100644
--- a/tools/update-lua-module-docs.lua
+++ b/tools/update-lua-module-docs.lua
@@ -48,7 +48,11 @@ local known_types = {
Block = 'type-block',
Blocks = 'type-blocks',
ChunkedDoc = 'type-chunkeddoc',
+ Inline = 'type-inline',
+ Inlines = 'type-inlines',
Pandoc = 'type-pandoc',
+ SimpleTable = 'type-simpletable',
+ Table = 'type-table',
WriterOptions = 'type-writeroptions',
}