aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Lua/Marshaling/AST.hs
diff options
context:
space:
mode:
authorAlbert Krewinkel <albert@zeitkraut.de>2021-10-26 14:40:10 +0200
committerAlbert Krewinkel <albert@zeitkraut.de>2021-10-26 14:40:10 +0200
commita493c7029cf2bc8490d96fff04b0a0c624987601 (patch)
treeed1decfe0b3bde6c93a1a16dbb6307e1c881c7c4 /src/Text/Pandoc/Lua/Marshaling/AST.hs
parent230b133db53e8ef2677fe13304e1e03276ca6448 (diff)
downloadpandoc-a493c7029cf2bc8490d96fff04b0a0c624987601.tar.gz
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`.
Diffstat (limited to 'src/Text/Pandoc/Lua/Marshaling/AST.hs')
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/AST.hs431
1 files changed, 320 insertions, 111 deletions
diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs
index e436ffffc..22c78bff9 100644
--- a/src/Text/Pandoc/Lua/Marshaling/AST.hs
+++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs
@@ -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
-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
@@ -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