Lua: marshal 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`.
This commit is contained in:
Albert Krewinkel
parent
230b133db5
commit
a493c7029c
6 changed files with 582 additions and 352 deletions
205
data/pandoc.lua
205
data/pandoc.lua
|
|
@ -273,22 +273,6 @@ local function ensureInlineList (x)
|
|||
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
|
||||
|
|
@ -364,199 +348,10 @@ 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
|
||||
|
||||
-- ListAttributes
|
||||
M.ListAttributes = AstElement:make_subtype 'ListAttributes'
|
||||
M.ListAttributes.behavior.clone = M.types.clone.ListAttributes
|
||||
|
|
|
|||
|
|
@ -83,12 +83,8 @@ initLuaState = do
|
|||
-- 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
|
||||
|
|
|
|||
|
|
@ -19,21 +19,27 @@ Marshaling/unmarshaling instances for document AST elements.
|
|||
module Text.Pandoc.Lua.Marshaling.AST
|
||||
( peekAttr
|
||||
, peekBlock
|
||||
, peekBlockFuzzy
|
||||
, peekBlocks
|
||||
, peekBlocksFuzzy
|
||||
, peekCaption
|
||||
, peekCitation
|
||||
, peekColSpec
|
||||
, peekDefinitionItem
|
||||
, peekFormat
|
||||
, peekInline
|
||||
, peekInlineFuzzy
|
||||
, peekInlines
|
||||
, peekInlinesFuzzy
|
||||
, peekListAttributes
|
||||
, peekMeta
|
||||
, peekMetaValue
|
||||
, peekPandoc
|
||||
, peekMathType
|
||||
, peekQuoteType
|
||||
|
||||
, peekFuzzyInlines
|
||||
, peekFuzzyBlocks
|
||||
, peekTableBody
|
||||
, peekTableHead
|
||||
, peekTableFoot
|
||||
|
||||
, pushAttr
|
||||
, pushBlock
|
||||
|
|
@ -46,7 +52,7 @@ module Text.Pandoc.Lua.Marshaling.AST
|
|||
|
||||
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)
|
||||
|
|
@ -54,7 +60,7 @@ import HsLua hiding (Operation (Div))
|
|||
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)
|
||||
|
||||
|
|
@ -102,14 +108,6 @@ instance Pushable MetaValue where
|
|||
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"
|
||||
|
|
@ -232,69 +230,188 @@ peekMetaValue = retrieving "MetaValue $ " . \idx -> do
|
|||
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
|
||||
|
||||
|
|
@ -304,6 +421,16 @@ 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
|
||||
|
|
@ -318,37 +445,48 @@ peekCaption = retrieving "Caption" . \idx -> do
|
|||
long <- peekFieldRaw peekBlocks "long" idx
|
||||
return $! Caption short long
|
||||
|
||||
-- | 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
|
||||
|
||||
peekColWidth :: LuaError e => Peeker e ColWidth
|
||||
peekColWidth = retrieving "ColWidth" . \idx -> do
|
||||
maybe ColWidthDefault ColWidth <$!> optional (peekRealFloat idx)
|
||||
|
||||
peekColSpec :: LuaError e => Peeker e ColSpec
|
||||
peekColSpec = peekPair peekRead peekColWidth
|
||||
|
||||
instance Pushable ColWidth where
|
||||
push = \case
|
||||
-- | 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 Pushable Row where
|
||||
push (Row attr cells) = Lua.push (attr, cells)
|
||||
|
||||
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
|
||||
|
|
@ -358,17 +496,25 @@ peekTableBody = fmap (retrieving "TableBody")
|
|||
<*> 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"
|
||||
|
|
@ -380,6 +526,8 @@ instance Pushable Cell where
|
|||
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
|
||||
|
|
@ -416,9 +564,42 @@ setInlineText = \case
|
|||
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
|
||||
|
|
@ -438,13 +619,13 @@ setInlineContent = \case
|
|||
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
|
||||
|
|
@ -496,16 +677,6 @@ showInline = defun "show"
|
|||
<#> 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
|
||||
|
|
@ -591,22 +762,37 @@ pushInline = pushUD typeInline
|
|||
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) =
|
||||
|
|
@ -619,6 +805,26 @@ peekListAttributes = retrieving "ListAttributes" . peekTriple
|
|||
peekRead
|
||||
peekRead
|
||||
|
||||
-- * Orphan Instances
|
||||
|
||||
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
|
||||
|
|
@ -633,6 +839,9 @@ instance Peekable Meta where
|
|||
instance Peekable Pandoc where
|
||||
peek = forcePeek . peekPandoc
|
||||
|
||||
instance Peekable Row where
|
||||
peek = forcePeek . peekRow
|
||||
|
||||
instance Peekable Version where
|
||||
peek = forcePeek . peekVersionFuzzy
|
||||
|
||||
|
|
|
|||
|
|
@ -16,13 +16,14 @@ module Text.Pandoc.Lua.Module.Pandoc
|
|||
) where
|
||||
|
||||
import Prelude hiding (read)
|
||||
import Control.Applicative (optional)
|
||||
import Control.Monad ((>=>), forM_, when)
|
||||
import Control.Applicative ((<|>), optional)
|
||||
import Control.Monad ((>=>), (<$!>), forM_, when)
|
||||
import Control.Monad.Catch (catch, throwM)
|
||||
import Control.Monad.Except (throwError)
|
||||
import Data.Default (Default (..))
|
||||
import Data.Maybe (fromMaybe)
|
||||
import HsLua as Lua hiding (pushModule)
|
||||
import Data.Text (Text)
|
||||
import HsLua as Lua hiding (Div, pushModule)
|
||||
import HsLua.Class.Peekable (PeekError)
|
||||
import System.Exit (ExitCode (..))
|
||||
import Text.Pandoc.Class.PandocIO (runIO)
|
||||
|
|
@ -65,10 +66,12 @@ pushModule = do
|
|||
pushDocumentedFunction fn
|
||||
rawset (nth 3)
|
||||
forM_ otherConstructors addConstr
|
||||
forM_ blockConstructors addConstr
|
||||
forM_ inlineConstructors addConstr
|
||||
let addConstructorTable constructors = do
|
||||
-- add constructors to Inlines.constructor
|
||||
newtable -- constructor
|
||||
forM_ (inlineConstructors @PandocError) $ \fn -> do
|
||||
forM_ constructors $ \fn -> do
|
||||
let name = functionName fn
|
||||
pushName name
|
||||
pushName name
|
||||
|
|
@ -76,9 +79,12 @@ pushModule = do
|
|||
rawset (nth 3)
|
||||
-- set as pandoc.Inline.constructor
|
||||
pushName "Inline"
|
||||
newtable *> pushName "constructor" *> pushvalue (nth 4) *> rawset (nth 3)
|
||||
newtable *> pushName "constructor" *>
|
||||
pushvalue (nth 4) *> rawset (nth 3)
|
||||
rawset (nth 4)
|
||||
pop 1 -- remaining constructor table
|
||||
addConstructorTable (blockConstructors @PandocError)
|
||||
addConstructorTable (inlineConstructors @PandocError)
|
||||
return 1
|
||||
|
||||
inlineConstructors :: LuaError e => [DocumentedFunction e]
|
||||
|
|
@ -86,7 +92,7 @@ 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)
|
||||
|
|
@ -99,7 +105,7 @@ inlineConstructors =
|
|||
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"
|
||||
|
|
@ -112,7 +118,7 @@ inlineConstructors =
|
|||
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"
|
||||
|
|
@ -124,12 +130,12 @@ inlineConstructors =
|
|||
=#> 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
|
||||
|
|
@ -145,11 +151,11 @@ inlineConstructors =
|
|||
=#> 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
|
||||
|
|
@ -159,11 +165,119 @@ inlineConstructors =
|
|||
, 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]
|
||||
|
|
@ -181,8 +295,8 @@ otherConstructors =
|
|||
})
|
||||
<#> parameter peekText "string" "cid" "citation ID (e.g. bibtex key)"
|
||||
<#> parameter peekRead "citation mode" "mode" "citation rendering mode"
|
||||
<#> optionalParameter peekFuzzyInlines "prefix" "Inlines" ""
|
||||
<#> optionalParameter peekFuzzyInlines "suffix" "Inlines" ""
|
||||
<#> 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"
|
||||
|
|
@ -283,7 +397,7 @@ pushPipeError pipeErr = do
|
|||
mkPandoc :: PandocLua NumResults
|
||||
mkPandoc = liftPandocLua $ do
|
||||
doc <- forcePeek $ do
|
||||
blks <- peekBlocks (nthBottom 1)
|
||||
blks <- peekBlocksFuzzy (nthBottom 1)
|
||||
mMeta <- optional $ peekMeta (nthBottom 2)
|
||||
pure $ Pandoc (fromMaybe nullMeta mMeta) blks
|
||||
pushPandoc doc
|
||||
|
|
|
|||
|
|
@ -35,13 +35,9 @@ pushModule = do
|
|||
pushCloneTable :: LuaE PandocError NumResults
|
||||
pushCloneTable = do
|
||||
Lua.newtable
|
||||
addFunction "Attr" $ cloneWith peekAttr pushAttr
|
||||
addFunction "Block" $ cloneWith peekBlock pushBlock
|
||||
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
|
||||
|
||||
cloneWith :: Peeker PandocError a
|
||||
|
|
|
|||
|
|
@ -98,6 +98,126 @@ return {
|
|||
assert.are_equal(count, 3)
|
||||
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 'HTML-like attribute tables' {
|
||||
test('in element constructor', function ()
|
||||
local html_attributes = {
|
||||
|
|
|
|||
Loading…
Reference in a new issue