{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Text.Pandoc.Lua.Marshal.Block
(
typeBlock
, peekBlock
, peekBlockFuzzy
, pushBlock
, peekBlocks
, peekBlocksFuzzy
, pushBlocks
, blockConstructors
, mkBlocks
, walkBlockSplicing
, walkBlocksStraight
) where
import Control.Applicative ((<|>), optional)
import Control.Monad.Catch (throwM)
import Control.Monad ((<$!>))
import Data.Aeson (encode)
import Data.Data (showConstr, toConstr)
import Data.Maybe (fromMaybe)
import Data.Proxy (Proxy (Proxy))
import Data.Text (Text)
import HsLua hiding (Div)
import Text.Pandoc.Lua.Marshal.Attr (peekAttr, pushAttr)
import Text.Pandoc.Lua.Marshal.Caption (peekCaptionFuzzy, pushCaption)
import Text.Pandoc.Lua.Marshal.Content
( Content (..), contentTypeDescription, peekContent, pushContent
, peekDefinitionItem )
import Text.Pandoc.Lua.Marshal.Filter (Filter, peekFilter)
import Text.Pandoc.Lua.Marshal.Format (peekFormat, pushFormat)
import Text.Pandoc.Lua.Marshal.Inline (peekInlinesFuzzy)
import Text.Pandoc.Lua.Marshal.List (newListMetatable, pushPandocList)
import Text.Pandoc.Lua.Marshal.ListAttributes
( peekListAttributes, pushListAttributes )
import Text.Pandoc.Lua.Marshal.Shared (walkBlocksAndInlines)
import Text.Pandoc.Lua.Marshal.TableParts
( peekColSpec, pushColSpec
, peekTableBody, pushTableBody
, peekTableFoot, pushTableFoot
, peekTableHead, pushTableHead
)
import Text.Pandoc.Lua.Walk (SpliceList, Walkable, walkStraight, walkSplicing)
import Text.Pandoc.Definition
pushBlock :: LuaError e => Pusher e Block
pushBlock :: forall e. LuaError e => Pusher e Block
pushBlock = DocumentedTypeWithList e Block Void -> Block -> LuaE e ()
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> a -> LuaE e ()
pushUD DocumentedTypeWithList e Block Void
forall e. LuaError e => DocumentedType e Block
typeBlock
{-# INLINE pushBlock #-}
peekBlock :: LuaError e => Peeker e Block
peekBlock :: forall e. LuaError e => Peeker e Block
peekBlock = DocumentedTypeWithList e Block Void -> Peeker e Block
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Peeker e a
peekUD DocumentedTypeWithList e Block Void
forall e. LuaError e => DocumentedType e Block
typeBlock
{-# INLINE peekBlock #-}
peekBlocks :: LuaError e
=> Peeker e [Block]
peekBlocks :: forall e. LuaError e => Peeker e [Block]
peekBlocks = Peeker e Block -> Peeker e [Block]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Block
forall e. LuaError e => Peeker e Block
peekBlock
{-# INLINABLE peekBlocks #-}
pushBlocks :: LuaError e
=> Pusher e [Block]
pushBlocks :: forall e. LuaError e => Pusher e [Block]
pushBlocks [Block]
xs = do
Pusher e Block -> [Block] -> LuaE e ()
forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList Pusher e Block
forall e. LuaError e => Pusher e Block
pushBlock [Block]
xs
Name -> LuaE e () -> LuaE e ()
forall e. Name -> LuaE e () -> LuaE e ()
newListMetatable Name
"Blocks" (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ do
Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
"walk"
DocumentedFunction e -> LuaE e ()
forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction (DocumentedFunction e -> LuaE e ())
-> DocumentedFunction e -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ ([Block] -> Filter -> LuaE e [Block])
-> HsFnPrecursor e ([Block] -> Filter -> LuaE e [Block])
forall a e. a -> HsFnPrecursor e a
lambda
### flip walkBlocksAndInlines
HsFnPrecursor e ([Block] -> Filter -> LuaE e [Block])
-> Parameter e [Block]
-> HsFnPrecursor e (Filter -> LuaE e [Block])
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Block] -> TypeSpec -> Text -> Text -> Parameter e [Block]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy TypeSpec
"Blocks" Text
"self" Text
""
HsFnPrecursor e (Filter -> LuaE e [Block])
-> Parameter e Filter -> HsFnPrecursor e (LuaE e [Block])
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Filter -> TypeSpec -> Text -> Text -> Parameter e Filter
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e Filter
forall e. LuaError e => Peeker e Filter
peekFilter TypeSpec
"Filter" Text
"lua_filter" Text
"table of filter functions"
HsFnPrecursor e (LuaE e [Block])
-> FunctionResults e [Block] -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> ([Block] -> LuaE e ())
-> TypeSpec -> Text -> FunctionResults e [Block]
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult [Block] -> LuaE e ()
forall e. LuaError e => Pusher e [Block]
pushBlocks TypeSpec
"Blocks" Text
"modified list"
StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
"clone"
DocumentedFunction e -> LuaE e ()
forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction (DocumentedFunction e -> LuaE e ())
-> DocumentedFunction e -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ ([Block] -> LuaE e [Block])
-> HsFnPrecursor e ([Block] -> LuaE e [Block])
forall a e. a -> HsFnPrecursor e a
lambda
### return
HsFnPrecursor e ([Block] -> LuaE e [Block])
-> Parameter e [Block] -> HsFnPrecursor e (LuaE e [Block])
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Block] -> TypeSpec -> Text -> Text -> Parameter e [Block]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy TypeSpec
"Blocks" Text
"self" Text
""
HsFnPrecursor e (LuaE e [Block])
-> FunctionResults e [Block] -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> ([Block] -> LuaE e ())
-> TypeSpec -> Text -> FunctionResults e [Block]
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult [Block] -> LuaE e ()
forall e. LuaError e => Pusher e [Block]
pushBlocks TypeSpec
"Blocks" Text
"deep copy"
StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
"__tostring"
DocumentedFunction e -> LuaE e ()
forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction (DocumentedFunction e -> LuaE e ())
-> DocumentedFunction e -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ ([Block] -> LuaE e String)
-> HsFnPrecursor e ([Block] -> LuaE e String)
forall a e. a -> HsFnPrecursor e a
lambda
### liftPure show
HsFnPrecursor e ([Block] -> LuaE e String)
-> Parameter e [Block] -> HsFnPrecursor e (LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Block] -> TypeSpec -> Text -> Text -> Parameter e [Block]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy TypeSpec
"Blocks" Text
"self" Text
""
HsFnPrecursor e (LuaE e String)
-> FunctionResults e String -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e String -> TypeSpec -> Text -> FunctionResults e String
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e String
forall e. String -> LuaE e ()
pushString TypeSpec
"string" Text
"native Haskell representation"
StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
"__tojson"
DocumentedFunction e -> LuaE e ()
forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction (DocumentedFunction e -> LuaE e ())
-> DocumentedFunction e -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ ([Block] -> LuaE e ByteString)
-> HsFnPrecursor e ([Block] -> LuaE e ByteString)
forall a e. a -> HsFnPrecursor e a
lambda
### liftPure encode
HsFnPrecursor e ([Block] -> LuaE e ByteString)
-> Parameter e [Block] -> HsFnPrecursor e (LuaE e ByteString)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Block] -> TypeSpec -> Text -> Text -> Parameter e [Block]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy TypeSpec
"Blocks" Text
"self" Text
""
HsFnPrecursor e (LuaE e ByteString)
-> FunctionResults e ByteString -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e ByteString
-> TypeSpec -> Text -> FunctionResults e ByteString
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e ByteString
forall e. Pusher e ByteString
pushLazyByteString TypeSpec
"string" Text
"JSON representation"
StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth CInt
2)
{-# INLINABLE pushBlocks #-}
peekBlockMetamethod :: LuaError e
=> Peeker e Block
peekBlockMetamethod :: forall e. LuaError e => Peeker e Block
peekBlockMetamethod StackIndex
idx = do
absidx <- LuaE e StackIndex -> Peek e StackIndex
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e StackIndex -> Peek e StackIndex)
-> LuaE e StackIndex -> Peek e StackIndex
forall a b. (a -> b) -> a -> b
$ StackIndex -> LuaE e StackIndex
forall e. StackIndex -> LuaE e StackIndex
absindex StackIndex
idx
liftLua (getmetafield absidx "__toblock") >>= \case
Type
TypeNil -> ByteString -> Peek e Block
forall a e. ByteString -> Peek e a
failPeek ByteString
"object has no __toblock metamethod"
Type
TypeFunction -> do
LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
pushvalue StackIndex
absidx)
LuaE e Status -> Peek e Status
forall e a. LuaE e a -> Peek e a
liftLua (NumArgs -> NumResults -> Maybe StackIndex -> LuaE e Status
forall e.
NumArgs -> NumResults -> Maybe StackIndex -> LuaE e Status
pcall NumArgs
1 NumResults
1 Maybe StackIndex
forall a. Maybe a
Nothing) Peek e Status -> (Status -> Peek e Block) -> Peek e Block
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Status
OK -> Peeker e Block
forall e. LuaError e => Peeker e Block
peekBlock StackIndex
top Peek e Block -> LuaE e () -> Peek e Block
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1
Status
_err -> do
msg <- Peeker e ByteString
forall e. Peeker e ByteString
peekByteString StackIndex
top Peek e ByteString -> LuaE e () -> Peek e ByteString
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1
failPeek $ "failure in __toblock: " <> msg
Type
_otherType -> do
LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1)
ByteString -> Peek e Block
forall a e. ByteString -> Peek e a
failPeek ByteString
"__toblock metafield does not contain a function"
peekBlockFuzzy :: LuaError e
=> Peeker e Block
peekBlockFuzzy :: forall e. LuaError e => Peeker e Block
peekBlockFuzzy StackIndex
idx =
Peeker e Block
forall e. LuaError e => Peeker e Block
peekBlock StackIndex
idx
Peek e Block -> Peek e Block -> Peek e Block
forall a. Peek e a -> Peek e a -> Peek e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Peeker e Block
forall e. LuaError e => Peeker e Block
peekBlockMetamethod StackIndex
idx
Peek e Block -> Peek e Block -> Peek e Block
forall a. Peek e a -> Peek e a -> Peek e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Inline] -> Block
Plain ([Inline] -> Block) -> Peek e [Inline] -> Peek e Block
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy StackIndex
idx)
Peek e Block -> Peek e Block -> Peek e Block
forall a. Peek e a -> Peek e a -> Peek e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Peek e Block
forall a e. ByteString -> Peek e a
failPeek (ByteString -> Peek e Block) -> Peek e ByteString -> Peek e Block
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
Name -> StackIndex -> Peek e ByteString
forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"Block or list of Inlines" StackIndex
idx)
{-# INLINABLE peekBlockFuzzy #-}
peekBlocksFuzzy :: LuaError e
=> Peeker e [Block]
peekBlocksFuzzy :: forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy StackIndex
idx =
((Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[]) (Block -> [Block]) -> Peek e Block -> Peek e [Block]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peeker e Block
forall e. LuaError e => Peeker e Block
peekBlockMetamethod StackIndex
idx)
Peek e [Block] -> Peek e [Block] -> Peek e [Block]
forall a. Peek e a -> Peek e a -> Peek e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Peeker e Block -> Peeker e [Block]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Block
forall e. LuaError e => Peeker e Block
peekBlockFuzzy StackIndex
idx
Peek e [Block] -> Peek e [Block] -> Peek e [Block]
forall a. Peek e a -> Peek e a -> Peek e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Block -> [Block]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> [Block]) -> Peek e Block -> Peek e [Block]
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Block
forall e. LuaError e => Peeker e Block
peekBlockFuzzy StackIndex
idx)
Peek e [Block] -> Peek e [Block] -> Peek e [Block]
forall a. Peek e a -> Peek e a -> Peek e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Peek e [Block]
forall a e. ByteString -> Peek e a
failPeek (ByteString -> Peek e [Block])
-> Peek e ByteString -> Peek e [Block]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
Name -> StackIndex -> Peek e ByteString
forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"Block, list of Blocks, or compatible element" StackIndex
idx)
{-# INLINABLE peekBlocksFuzzy #-}
typeBlock :: forall e. LuaError e => DocumentedType e Block
typeBlock :: forall e. LuaError e => DocumentedType e Block
typeBlock = Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) Block]
-> DocumentedType e Block
forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"Block"
[ Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Eq (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (Maybe Block -> Maybe Block -> LuaE e Bool)
-> HsFnPrecursor e (Maybe Block -> Maybe Block -> LuaE e Bool)
forall a e. a -> HsFnPrecursor e a
lambda
### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b))
HsFnPrecursor e (Maybe Block -> Maybe Block -> LuaE e Bool)
-> Parameter e (Maybe Block)
-> HsFnPrecursor e (Maybe Block -> LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e (Maybe Block)
-> TypeSpec -> Text -> Text -> Parameter e (Maybe Block)
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (Peek e Block -> Peek e (Maybe Block)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e Block -> Peek e (Maybe Block))
-> (StackIndex -> Peek e Block) -> Peeker e (Maybe Block)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Block
forall e. LuaError e => Peeker e Block
peekBlockFuzzy) TypeSpec
"Block" Text
"a" Text
""
HsFnPrecursor e (Maybe Block -> LuaE e Bool)
-> Parameter e (Maybe Block) -> HsFnPrecursor e (LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e (Maybe Block)
-> TypeSpec -> Text -> Text -> Parameter e (Maybe Block)
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (Peek e Block -> Peek e (Maybe Block)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e Block -> Peek e (Maybe Block))
-> (StackIndex -> Peek e Block) -> Peeker e (Maybe Block)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Block
forall e. LuaError e => Peeker e Block
peekBlockFuzzy) TypeSpec
"Block" Text
"b" Text
""
HsFnPrecursor e (LuaE e Bool)
-> FunctionResults e Bool -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Bool
forall e. Text -> FunctionResults e Bool
boolResult Text
"whether the two values are equal"
, Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Tostring (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (Block -> LuaE e String)
-> HsFnPrecursor e (Block -> LuaE e String)
forall a e. a -> HsFnPrecursor e a
lambda
### liftPure show
HsFnPrecursor e (Block -> LuaE e String)
-> Parameter e Block -> HsFnPrecursor e (LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> DocumentedType e Block -> Text -> Text -> Parameter e Block
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam DocumentedType e Block
forall e. LuaError e => DocumentedType e Block
typeBlock Text
"self" Text
""
HsFnPrecursor e (LuaE e String)
-> FunctionResults e String -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e String -> TypeSpec -> Text -> FunctionResults e String
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e String
forall e. String -> LuaE e ()
pushString TypeSpec
"string" Text
"Haskell representation"
, Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation (Name -> Operation
CustomOperation Name
"__tojson") (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (Block -> LuaE e ByteString)
-> HsFnPrecursor e (Block -> LuaE e ByteString)
forall a e. a -> HsFnPrecursor e a
lambda
### liftPure encode
HsFnPrecursor e (Block -> LuaE e ByteString)
-> Parameter e Block -> HsFnPrecursor e (LuaE e ByteString)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> DocumentedType e Block -> Text -> Text -> Parameter e Block
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam DocumentedType e Block
forall e. LuaError e => DocumentedType e Block
typeBlock Text
"self" Text
""
HsFnPrecursor e (LuaE e ByteString)
-> FunctionResults e ByteString -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e ByteString
-> TypeSpec -> Text -> FunctionResults e ByteString
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e ByteString
forall e. Pusher e ByteString
pushLazyByteString TypeSpec
"string" Text
"JSON representation"
]
[ Name
-> Text
-> (Pusher e Attr, Block -> Possible Attr)
-> (Peeker e Attr, Block -> Attr -> Possible Block)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"attr" Text
"element attributes"
(Pusher e Attr
forall e. LuaError e => Pusher e Attr
pushAttr, \case
CodeBlock Attr
attr Text
_ -> Attr -> Possible Attr
forall a. a -> Possible a
Actual Attr
attr
Div Attr
attr [Block]
_ -> Attr -> Possible Attr
forall a. a -> Possible a
Actual Attr
attr
Figure Attr
attr Caption
_ [Block]
_ -> Attr -> Possible Attr
forall a. a -> Possible a
Actual Attr
attr
Header Int
_ Attr
attr [Inline]
_ -> Attr -> Possible Attr
forall a. a -> Possible a
Actual Attr
attr
Table Attr
attr Caption
_ [ColSpec]
_ TableHead
_ [TableBody]
_ TableFoot
_ -> Attr -> Possible Attr
forall a. a -> Possible a
Actual Attr
attr
Block
_ -> Possible Attr
forall a. Possible a
Absent)
(Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr, \case
CodeBlock Attr
_ Text
code -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Attr -> Block) -> Attr -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attr -> Text -> Block) -> Text -> Attr -> Block
forall a b c. (a -> b -> c) -> b -> a -> c
flip Attr -> Text -> Block
CodeBlock Text
code
Div Attr
_ [Block]
blks -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Attr -> Block) -> Attr -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attr -> [Block] -> Block) -> [Block] -> Attr -> Block
forall a b c. (a -> b -> c) -> b -> a -> c
flip Attr -> [Block] -> Block
Div [Block]
blks
Figure Attr
_ Caption
capt [Block]
blks -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Attr -> Block) -> Attr -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Attr
attr -> Attr -> Caption -> [Block] -> Block
Figure Attr
attr Caption
capt [Block]
blks)
Header Int
lvl Attr
_ [Inline]
blks -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Attr -> Block) -> Attr -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Attr
attr -> Int -> Attr -> [Inline] -> Block
Header Int
lvl Attr
attr [Inline]
blks)
Table Attr
_ Caption
c [ColSpec]
cs TableHead
h [TableBody]
bs TableFoot
f -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Attr -> Block) -> Attr -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Attr
attr -> Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
c [ColSpec]
cs TableHead
h [TableBody]
bs TableFoot
f)
Block
_ -> Possible Block -> Attr -> Possible Block
forall a b. a -> b -> a
const Possible Block
forall a. Possible a
Absent)
, Name
-> Text
-> (Pusher e [TableBody], Block -> Possible [TableBody])
-> (Peeker e [TableBody], Block -> [TableBody] -> Possible Block)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"bodies" Text
"table bodies"
(Pusher e TableBody -> Pusher e [TableBody]
forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushPandocList Pusher e TableBody
forall e. LuaError e => Pusher e TableBody
pushTableBody, \case
Table Attr
_ Caption
_ [ColSpec]
_ TableHead
_ [TableBody]
bs TableFoot
_ -> [TableBody] -> Possible [TableBody]
forall a. a -> Possible a
Actual [TableBody]
bs
Block
_ -> Possible [TableBody]
forall a. Possible a
Absent)
(Peeker e TableBody -> Peeker e [TableBody]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e TableBody
forall e. LuaError e => Peeker e TableBody
peekTableBody, \case
Table Attr
attr Caption
c [ColSpec]
cs TableHead
h [TableBody]
_ TableFoot
f -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> ([TableBody] -> Block) -> [TableBody] -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[TableBody]
bs -> Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
c [ColSpec]
cs TableHead
h [TableBody]
bs TableFoot
f)
Block
_ -> Possible Block -> [TableBody] -> Possible Block
forall a b. a -> b -> a
const Possible Block
forall a. Possible a
Absent)
, Name
-> Text
-> (Pusher e Caption, Block -> Possible Caption)
-> (Peeker e Caption, Block -> Caption -> Possible Block)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"caption" Text
"element caption"
(Pusher e Caption
forall e. LuaError e => Pusher e Caption
pushCaption, \case
Figure Attr
_ Caption
capt [Block]
_ -> Caption -> Possible Caption
forall a. a -> Possible a
Actual Caption
capt
Table Attr
_ Caption
capt [ColSpec]
_ TableHead
_ [TableBody]
_ TableFoot
_ -> Caption -> Possible Caption
forall a. a -> Possible a
Actual Caption
capt
Block
_ -> Possible Caption
forall a. Possible a
Absent)
(Peeker e Caption
forall e. LuaError e => Peeker e Caption
peekCaptionFuzzy, \case
Figure Attr
attr Caption
_ [Block]
blks -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Caption -> Block) -> Caption -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Caption
c -> Attr -> Caption -> [Block] -> Block
Figure Attr
attr Caption
c [Block]
blks)
Table Attr
attr Caption
_ [ColSpec]
cs TableHead
h [TableBody]
bs TableFoot
f -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Caption -> Block) -> Caption -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Caption
c -> Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
c [ColSpec]
cs TableHead
h [TableBody]
bs TableFoot
f)
Block
_ -> Possible Block -> Caption -> Possible Block
forall a b. a -> b -> a
const Possible Block
forall a. Possible a
Absent)
, Name
-> Text
-> (Pusher e [ColSpec], Block -> Possible [ColSpec])
-> (Peeker e [ColSpec], Block -> [ColSpec] -> Possible Block)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"colspecs" Text
"column alignments and widths"
(Pusher e ColSpec -> Pusher e [ColSpec]
forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushPandocList Pusher e ColSpec
forall e. LuaError e => Pusher e ColSpec
pushColSpec, \case
Table Attr
_ Caption
_ [ColSpec]
cs TableHead
_ [TableBody]
_ TableFoot
_ -> [ColSpec] -> Possible [ColSpec]
forall a. a -> Possible a
Actual [ColSpec]
cs
Block
_ -> Possible [ColSpec]
forall a. Possible a
Absent)
(Peeker e ColSpec -> Peeker e [ColSpec]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e ColSpec
forall e. LuaError e => Peeker e ColSpec
peekColSpec, \case
Table Attr
attr Caption
c [ColSpec]
_ TableHead
h [TableBody]
bs TableFoot
f -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> ([ColSpec] -> Block) -> [ColSpec] -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[ColSpec]
cs -> Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
c [ColSpec]
cs TableHead
h [TableBody]
bs TableFoot
f)
Block
_ -> Possible Block -> [ColSpec] -> Possible Block
forall a b. a -> b -> a
const Possible Block
forall a. Possible a
Absent)
, Name
-> Text
-> (Pusher e Content, Block -> Possible Content)
-> (Peeker e Content, Block -> Content -> Possible Block)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"content" Text
"element content"
(Pusher e Content
forall e. LuaError e => Pusher e Content
pushContent, Block -> Possible Content
getBlockContent)
(Peeker e Content
forall e. LuaError e => Peeker e Content
peekContent, Proxy e -> Block -> Content -> Possible Block
forall e.
LuaError e =>
Proxy e -> Block -> Content -> Possible Block
setBlockContent (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @e))
, Name
-> Text
-> (Pusher e TableFoot, Block -> Possible TableFoot)
-> (Peeker e TableFoot, Block -> TableFoot -> Possible Block)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"foot" Text
"table foot"
(Pusher e TableFoot
forall e. LuaError e => TableFoot -> LuaE e ()
pushTableFoot, \case {Table Attr
_ Caption
_ [ColSpec]
_ TableHead
_ [TableBody]
_ TableFoot
f -> TableFoot -> Possible TableFoot
forall a. a -> Possible a
Actual TableFoot
f; Block
_ -> Possible TableFoot
forall a. Possible a
Absent})
(Peeker e TableFoot
forall e. LuaError e => Peeker e TableFoot
peekTableFoot, \case
Table Attr
attr Caption
c [ColSpec]
cs TableHead
h [TableBody]
bs TableFoot
_ -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (TableFoot -> Block) -> TableFoot -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
c [ColSpec]
cs TableHead
h [TableBody]
bs
Block
_ -> Possible Block -> TableFoot -> Possible Block
forall a b. a -> b -> a
const Possible Block
forall a. Possible a
Absent)
, Name
-> Text
-> (Pusher e Format, Block -> Possible Format)
-> (Peeker e Format, Block -> Format -> Possible Block)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"format" Text
"format of raw content"
(Pusher e Format
forall e. Pusher e Format
pushFormat, \case {RawBlock Format
f Text
_ -> Format -> Possible Format
forall a. a -> Possible a
Actual Format
f; Block
_ -> Possible Format
forall a. Possible a
Absent})
(Peeker e Format
forall e. Peeker e Format
peekFormat, \case
RawBlock Format
_ Text
txt -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Format -> Block) -> Format -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Format -> Text -> Block
`RawBlock` Text
txt)
Block
_ -> Possible Block -> Format -> Possible Block
forall a b. a -> b -> a
const Possible Block
forall a. Possible a
Absent)
, Name
-> Text
-> (Pusher e TableHead, Block -> Possible TableHead)
-> (Peeker e TableHead, Block -> TableHead -> Possible Block)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"head" Text
"table head"
(Pusher e TableHead
forall e. LuaError e => TableHead -> LuaE e ()
pushTableHead, \case {Table Attr
_ Caption
_ [ColSpec]
_ TableHead
h [TableBody]
_ TableFoot
_ -> TableHead -> Possible TableHead
forall a. a -> Possible a
Actual TableHead
h; Block
_ -> Possible TableHead
forall a. Possible a
Absent})
(Peeker e TableHead
forall e. LuaError e => Peeker e TableHead
peekTableHead, \case
Table Attr
attr Caption
c [ColSpec]
cs TableHead
_ [TableBody]
bs TableFoot
f -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (TableHead -> Block) -> TableHead -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\TableHead
h -> Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
c [ColSpec]
cs TableHead
h [TableBody]
bs TableFoot
f)
Block
_ -> Possible Block -> TableHead -> Possible Block
forall a b. a -> b -> a
const Possible Block
forall a. Possible a
Absent)
, Name
-> Text
-> (Pusher e Int, Block -> Possible Int)
-> (Peeker e Int, Block -> Int -> Possible Block)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"level" Text
"heading level"
(Pusher e Int
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, \case {Header Int
lvl Attr
_ [Inline]
_ -> Int -> Possible Int
forall a. a -> Possible a
Actual Int
lvl; Block
_ -> Possible Int
forall a. Possible a
Absent})
(Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \case
Header Int
_ Attr
attr [Inline]
inlns -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Int -> Block) -> Int -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Int
lvl -> Int -> Attr -> [Inline] -> Block
Header Int
lvl Attr
attr [Inline]
inlns
Block
_ -> Possible Block -> Int -> Possible Block
forall a b. a -> b -> a
const Possible Block
forall a. Possible a
Absent)
, Name
-> Text
-> (Pusher e ListAttributes, Block -> Possible ListAttributes)
-> (Peeker e ListAttributes,
Block -> ListAttributes -> Possible Block)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"listAttributes" Text
"ordered list attributes"
(Pusher e ListAttributes
forall e. LuaError e => Pusher e ListAttributes
pushListAttributes, \case
OrderedList ListAttributes
listAttr [[Block]]
_ -> ListAttributes -> Possible ListAttributes
forall a. a -> Possible a
Actual ListAttributes
listAttr
Block
_ -> Possible ListAttributes
forall a. Possible a
Absent)
(Peeker e ListAttributes
forall e. LuaError e => Peeker e ListAttributes
peekListAttributes, \case
OrderedList ListAttributes
_ [[Block]]
content -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (ListAttributes -> Block) -> ListAttributes -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ListAttributes -> [[Block]] -> Block
`OrderedList` [[Block]]
content)
Block
_ -> Possible Block -> ListAttributes -> Possible Block
forall a b. a -> b -> a
const Possible Block
forall a. Possible a
Absent)
, Name
-> Text
-> (Pusher e Text, Block -> Possible Text)
-> (Peeker e Text, Block -> Text -> Possible Block)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> Possible b)
-> (Peeker e b, a -> b -> Possible a)
-> Member e fn a
possibleProperty Name
"text" Text
"text contents"
(Pusher e Text
forall e. Pusher e Text
pushText, Block -> Possible Text
getBlockText)
(Peeker e Text
forall e. Peeker e Text
peekText, Block -> Text -> Possible Block
setBlockText)
, Name
-> Text
-> (Pusher e String, Block -> String)
-> Member e (DocumentedFunction e) Block
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"tag" Text
"type of Block"
(Pusher e String
forall e. String -> LuaE e ()
pushString, Constr -> String
showConstr (Constr -> String) -> (Block -> Constr) -> Block -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Constr
forall a. Data a => a -> Constr
toConstr )
, AliasIndex
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Block
forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias AliasIndex
"t" Text
"tag" [AliasIndex
"tag"]
, AliasIndex
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Block
forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias AliasIndex
"c" Text
"content" [AliasIndex
"content"]
, AliasIndex
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Block
forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias AliasIndex
"identifier" Text
"element identifier" [AliasIndex
"attr", AliasIndex
"identifier"]
, AliasIndex
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Block
forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias AliasIndex
"classes" Text
"element classes" [AliasIndex
"attr", AliasIndex
"classes"]
, AliasIndex
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Block
forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias AliasIndex
"attributes" Text
"other element attributes" [AliasIndex
"attr", AliasIndex
"attributes"]
, AliasIndex
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Block
forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias AliasIndex
"start" Text
"ordered list start number" [AliasIndex
"listAttributes", AliasIndex
"start"]
, AliasIndex
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Block
forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias AliasIndex
"style" Text
"ordered list style" [AliasIndex
"listAttributes", AliasIndex
"style"]
, AliasIndex
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Block
forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias AliasIndex
"delimiter" Text
"numbering delimiter" [AliasIndex
"listAttributes", AliasIndex
"delimiter"]
, DocumentedFunction e -> Member e (DocumentedFunction e) Block
forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method (DocumentedFunction e -> Member e (DocumentedFunction e) Block)
-> DocumentedFunction e -> Member e (DocumentedFunction e) Block
forall a b. (a -> b) -> a -> b
$ Name
-> (Block -> LuaE e Block)
-> HsFnPrecursor e (Block -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"clone"
### return
HsFnPrecursor e (Block -> LuaE e Block)
-> Parameter e Block -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> (StackIndex -> Peek e Block)
-> TypeSpec -> Text -> Text -> Parameter e Block
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter StackIndex -> Peek e Block
forall e. LuaError e => Peeker e Block
peekBlock TypeSpec
"Block" Text
"block" Text
"self"
HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Block -> TypeSpec -> Text -> FunctionResults e Block
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e Block
forall e. LuaError e => Pusher e Block
pushBlock TypeSpec
"Block" Text
"cloned Block"
, DocumentedFunction e -> Member e (DocumentedFunction e) Block
forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method (DocumentedFunction e -> Member e (DocumentedFunction e) Block)
-> DocumentedFunction e -> Member e (DocumentedFunction e) Block
forall a b. (a -> b) -> a -> b
$ Name
-> (Block -> LuaE e String)
-> HsFnPrecursor e (Block -> LuaE e String)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"show"
### liftPure show
HsFnPrecursor e (Block -> LuaE e String)
-> Parameter e Block -> HsFnPrecursor e (LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> (StackIndex -> Peek e Block)
-> TypeSpec -> Text -> Text -> Parameter e Block
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter StackIndex -> Peek e Block
forall e. LuaError e => Peeker e Block
peekBlock TypeSpec
"Block" Text
"self" Text
""
HsFnPrecursor e (LuaE e String)
-> FunctionResults e String -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e String -> TypeSpec -> Text -> FunctionResults e String
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e String
forall e. String -> LuaE e ()
pushString TypeSpec
"string" Text
"Haskell string representation"
, DocumentedFunction e -> Member e (DocumentedFunction e) Block
forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method (DocumentedFunction e -> Member e (DocumentedFunction e) Block)
-> DocumentedFunction e -> Member e (DocumentedFunction e) Block
forall a b. (a -> b) -> a -> b
$ Name
-> (Block -> Filter -> LuaE e Block)
-> HsFnPrecursor e (Block -> Filter -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"walk"
### flip walkBlocksAndInlines
HsFnPrecursor e (Block -> Filter -> LuaE e Block)
-> Parameter e Block -> HsFnPrecursor e (Filter -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> (StackIndex -> Peek e Block)
-> TypeSpec -> Text -> Text -> Parameter e Block
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter StackIndex -> Peek e Block
forall e. LuaError e => Peeker e Block
peekBlock TypeSpec
"Block" Text
"self" Text
""
HsFnPrecursor e (Filter -> LuaE e Block)
-> Parameter e Filter -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Filter -> TypeSpec -> Text -> Text -> Parameter e Filter
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e Filter
forall e. LuaError e => Peeker e Filter
peekFilter TypeSpec
"Filter" Text
"lua_filter" Text
"table of filter functions"
HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Block -> TypeSpec -> Text -> FunctionResults e Block
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e Block
forall e. LuaError e => Pusher e Block
pushBlock TypeSpec
"Block" Text
"modified element"
]
getBlockContent :: Block -> Possible Content
getBlockContent :: Block -> Possible Content
getBlockContent = \case
Para [Inline]
inlns -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
Plain [Inline]
inlns -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
Header Int
_ Attr
_ [Inline]
inlns -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
BlockQuote [Block]
blks -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Block] -> Content
ContentBlocks [Block]
blks
Div Attr
_ [Block]
blks -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Block] -> Content
ContentBlocks [Block]
blks
Figure Attr
_ Caption
_ [Block]
blks -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Block] -> Content
ContentBlocks [Block]
blks
LineBlock [[Inline]]
lns -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Content
ContentLines [[Inline]]
lns
BulletList [[Block]]
itms -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [[Block]] -> Content
ContentListItems [[Block]]
itms
OrderedList ListAttributes
_ [[Block]]
itms -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [[Block]] -> Content
ContentListItems [[Block]]
itms
DefinitionList [([Inline], [[Block]])]
itms -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [([Inline], [[Block]])] -> Content
ContentDefItems [([Inline], [[Block]])]
itms
Block
_ -> Possible Content
forall a. Possible a
Absent
setBlockContent :: forall e. LuaError e
=> Proxy e -> Block -> Content -> Possible Block
setBlockContent :: forall e.
LuaError e =>
Proxy e -> Block -> Content -> Possible Block
setBlockContent Proxy e
_ = \case
Para [Inline]
_ -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Content -> Block) -> Content -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Block
Para ([Inline] -> Block) -> (Content -> [Inline]) -> Content -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
Plain [Inline]
_ -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Content -> Block) -> Content -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Block
Plain ([Inline] -> Block) -> (Content -> [Inline]) -> Content -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
Header Int
attr Attr
lvl [Inline]
_ -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Content -> Block) -> Content -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Attr -> [Inline] -> Block
Header Int
attr Attr
lvl ([Inline] -> Block) -> (Content -> [Inline]) -> Content -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
BlockQuote [Block]
_ -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Content -> Block) -> Content -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Block
BlockQuote ([Block] -> Block) -> (Content -> [Block]) -> Content -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Block]
blockContent
Div Attr
attr [Block]
_ -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Content -> Block) -> Content -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> [Block] -> Block
Div Attr
attr ([Block] -> Block) -> (Content -> [Block]) -> Content -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Block]
blockContent
Figure Attr
attr Caption
c [Block]
_ -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Content -> Block) -> Content -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Caption -> [Block] -> Block
Figure Attr
attr Caption
c ([Block] -> Block) -> (Content -> [Block]) -> Content -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Block]
blockContent
LineBlock [[Inline]]
_ -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Content -> Block) -> Content -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Inline]] -> Block
LineBlock ([[Inline]] -> Block)
-> (Content -> [[Inline]]) -> Content -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [[Inline]]
lineContent
BulletList [[Block]]
_ -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Content -> Block) -> Content -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Block]] -> Block
BulletList ([[Block]] -> Block) -> (Content -> [[Block]]) -> Content -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [[Block]]
listItemContent
OrderedList ListAttributes
la [[Block]]
_ -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Content -> Block) -> Content -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListAttributes -> [[Block]] -> Block
OrderedList ListAttributes
la ([[Block]] -> Block) -> (Content -> [[Block]]) -> Content -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [[Block]]
listItemContent
DefinitionList [([Inline], [[Block]])]
_ -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Content -> Block) -> Content -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Inline], [[Block]])] -> Block
DefinitionList ([([Inline], [[Block]])] -> Block)
-> (Content -> [([Inline], [[Block]])]) -> Content -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [([Inline], [[Block]])]
defItemContent
Block
_ -> Possible Block -> Content -> Possible Block
forall a b. a -> b -> a
const Possible Block
forall a. Possible a
Absent
where
inlineContent :: Content -> [Inline]
inlineContent = \case
ContentInlines [Inline]
inlns -> [Inline]
inlns
Content
c -> e -> [Inline]
forall e a. (HasCallStack, Exception e) => e -> [a]
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (e -> [Inline]) -> (String -> e) -> String -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => String -> e
luaException @e (String -> [Inline]) -> String -> [Inline]
forall a b. (a -> b) -> a -> b
$
String
"expected Inlines, got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Content -> String
contentTypeDescription Content
c
blockContent :: Content -> [Block]
blockContent = \case
ContentBlocks [Block]
blks -> [Block]
blks
ContentInlines [] -> []
ContentInlines [Inline]
inlns -> [[Inline] -> Block
Plain [Inline]
inlns]
Content
c -> e -> [Block]
forall e a. (HasCallStack, Exception e) => e -> [a]
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (e -> [Block]) -> (String -> e) -> String -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => String -> e
luaException @e (String -> [Block]) -> String -> [Block]
forall a b. (a -> b) -> a -> b
$
String
"expected Blocks, got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Content -> String
contentTypeDescription Content
c
lineContent :: Content -> [[Inline]]
lineContent = \case
ContentLines [[Inline]]
lns -> [[Inline]]
lns
Content
c -> e -> [[Inline]]
forall e a. (HasCallStack, Exception e) => e -> [a]
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (e -> [[Inline]]) -> (String -> e) -> String -> [[Inline]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => String -> e
luaException @e (String -> [[Inline]]) -> String -> [[Inline]]
forall a b. (a -> b) -> a -> b
$
String
"expected list of lines (Inlines), got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Content -> String
contentTypeDescription Content
c
defItemContent :: Content -> [([Inline], [[Block]])]
defItemContent = \case
ContentDefItems [([Inline], [[Block]])]
itms -> [([Inline], [[Block]])]
itms
Content
c -> e -> [([Inline], [[Block]])]
forall e a. (HasCallStack, Exception e) => e -> [a]
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (e -> [([Inline], [[Block]])])
-> (String -> e) -> String -> [([Inline], [[Block]])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => String -> e
luaException @e (String -> [([Inline], [[Block]])])
-> String -> [([Inline], [[Block]])]
forall a b. (a -> b) -> a -> b
$
String
"expected definition items, got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Content -> String
contentTypeDescription Content
c
listItemContent :: Content -> [[Block]]
listItemContent = \case
ContentBlocks [Block]
blks -> (Block -> [Block]) -> [Block] -> [[Block]]
forall a b. (a -> b) -> [a] -> [b]
map (Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[]) [Block]
blks
ContentLines [[Inline]]
lns -> ([Inline] -> [Block]) -> [[Inline]] -> [[Block]]
forall a b. (a -> b) -> [a] -> [b]
map ((Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[]) (Block -> [Block]) -> ([Inline] -> Block) -> [Inline] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Block
Plain) [[Inline]]
lns
ContentListItems [[Block]]
itms -> [[Block]]
itms
Content
c -> e -> [[Block]]
forall e a. (HasCallStack, Exception e) => e -> [a]
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (e -> [[Block]]) -> (String -> e) -> String -> [[Block]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => String -> e
luaException @e (String -> [[Block]]) -> String -> [[Block]]
forall a b. (a -> b) -> a -> b
$
String
"expected list of items, got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Content -> String
contentTypeDescription Content
c
getBlockText :: Block -> Possible Text
getBlockText :: Block -> Possible Text
getBlockText = \case
CodeBlock Attr
_ Text
lst -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
lst
RawBlock Format
_ Text
raw -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
raw
Block
_ -> Possible Text
forall a. Possible a
Absent
setBlockText :: Block -> Text -> Possible Block
setBlockText :: Block -> Text -> Possible Block
setBlockText = \case
CodeBlock Attr
attr Text
_ -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Text -> Block) -> Text -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Text -> Block
CodeBlock Attr
attr
RawBlock Format
f Text
_ -> Block -> Possible Block
forall a. a -> Possible a
Actual (Block -> Possible Block)
-> (Text -> Block) -> Text -> Possible Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Text -> Block
RawBlock Format
f
Block
_ -> Possible Block -> Text -> Possible Block
forall a b. a -> b -> a
const Possible Block
forall a. Possible a
Absent
blockConstructors :: LuaError e => [DocumentedFunction e]
blockConstructors :: forall e. LuaError e => [DocumentedFunction e]
blockConstructors =
[ Name
-> ([Block] -> LuaE e Block)
-> HsFnPrecursor e ([Block] -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"BlockQuote"
### liftPure BlockQuote
HsFnPrecursor e ([Block] -> LuaE e Block)
-> Parameter e [Block] -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e [Block]
blocksParam
HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"BlockQuote element"
#? "Creates a block quote element"
, Name
-> ([[Block]] -> LuaE e Block)
-> HsFnPrecursor e ([[Block]] -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"BulletList"
### liftPure BulletList
HsFnPrecursor e ([[Block]] -> LuaE e Block)
-> Parameter e [[Block]] -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e [[Block]]
blockItemsParam Text
"list items"
HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"BulletList element"
#? "Creates a bullet list."
, Name
-> (Text -> Maybe Attr -> LuaE e Block)
-> HsFnPrecursor e (Text -> Maybe Attr -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"CodeBlock"
### liftPure2 (\code mattr -> CodeBlock (fromMaybe nullAttr mattr) code)
HsFnPrecursor e (Text -> Maybe Attr -> LuaE e Block)
-> Parameter e Text -> HsFnPrecursor e (Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Text -> Parameter e Text
forall e. Text -> Text -> Parameter e Text
textParam Text
"text" Text
"code string"
HsFnPrecursor e (Maybe Attr -> LuaE e Block)
-> Parameter e (Maybe Attr) -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e (Maybe Attr)
optAttrParam
HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"CodeBlock element"
#? "Creates a code block element."
, Name
-> ([([Inline], [[Block]])] -> LuaE e Block)
-> HsFnPrecursor e ([([Inline], [[Block]])] -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"DefinitionList"
### liftPure DefinitionList
HsFnPrecursor e ([([Inline], [[Block]])] -> LuaE e Block)
-> Parameter e [([Inline], [[Block]])]
-> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [([Inline], [[Block]])]
-> TypeSpec -> Text -> Text -> Parameter e [([Inline], [[Block]])]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter ([Peeker e [([Inline], [[Block]])]]
-> Peeker e [([Inline], [[Block]])]
forall e a. LuaError e => [Peeker e a] -> Peeker e a
choice
[ Peeker e ([Inline], [[Block]]) -> Peeker e [([Inline], [[Block]])]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e ([Inline], [[Block]])
forall e. LuaError e => Peeker e ([Inline], [[Block]])
peekDefinitionItem
, \StackIndex
idx -> (([Inline], [[Block]])
-> [([Inline], [[Block]])] -> [([Inline], [[Block]])]
forall a. a -> [a] -> [a]
:[]) (([Inline], [[Block]]) -> [([Inline], [[Block]])])
-> Peek e ([Inline], [[Block]]) -> Peek e [([Inline], [[Block]])]
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e ([Inline], [[Block]])
forall e. LuaError e => Peeker e ([Inline], [[Block]])
peekDefinitionItem StackIndex
idx
])
TypeSpec
"{{Inlines, {Blocks,...}},...}"
Text
"content" Text
"definition items"
HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"DefinitionList element"
#? "Creates a definition list, containing terms and their explanation."
, Name
-> ([Block] -> Maybe Attr -> LuaE e Block)
-> HsFnPrecursor e ([Block] -> Maybe Attr -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Div"
### liftPure2 (\content mattr -> Div (fromMaybe nullAttr mattr) content)
HsFnPrecursor e ([Block] -> Maybe Attr -> LuaE e Block)
-> Parameter e [Block]
-> HsFnPrecursor e (Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e [Block]
blocksParam
HsFnPrecursor e (Maybe Attr -> LuaE e Block)
-> Parameter e (Maybe Attr) -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e (Maybe Attr)
optAttrParam
HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"Div element"
#? "Creates a div element"
, Name
-> ([Block] -> Maybe Caption -> Maybe Attr -> LuaE e Block)
-> HsFnPrecursor
e ([Block] -> Maybe Caption -> Maybe Attr -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Figure"
### liftPure3 (\content mcapt mattr ->
let attr = fromMaybe nullAttr mattr
capt = fromMaybe (Caption mempty mempty) mcapt
in Figure attr capt content)
HsFnPrecursor
e ([Block] -> Maybe Caption -> Maybe Attr -> LuaE e Block)
-> Parameter e [Block]
-> HsFnPrecursor e (Maybe Caption -> Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Block] -> TypeSpec -> Text -> Text -> Parameter e [Block]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy TypeSpec
"Blocks" Text
"content" Text
"figure block content"
HsFnPrecursor e (Maybe Caption -> Maybe Attr -> LuaE e Block)
-> Parameter e (Maybe Caption)
-> HsFnPrecursor e (Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e Caption -> Parameter e (Maybe Caption)
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Peeker e Caption -> TypeSpec -> Text -> Text -> Parameter e Caption
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e Caption
forall e. LuaError e => Peeker e Caption
peekCaptionFuzzy TypeSpec
"Caption" Text
"caption" Text
"figure caption")
HsFnPrecursor e (Maybe Attr -> LuaE e Block)
-> Parameter e (Maybe Attr) -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e (Maybe Attr)
optAttrParam
HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"Figure object"
#? "Creates a [[Figure]] element."
, Name
-> (Int -> [Inline] -> Maybe Attr -> LuaE e Block)
-> HsFnPrecursor e (Int -> [Inline] -> Maybe Attr -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Header"
### liftPure3 (\lvl content mattr ->
Header lvl (fromMaybe nullAttr mattr) content)
HsFnPrecursor e (Int -> [Inline] -> Maybe Attr -> LuaE e Block)
-> Parameter e Int
-> HsFnPrecursor e ([Inline] -> Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Int -> TypeSpec -> Text -> Text -> Parameter e Int
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral TypeSpec
"integer" Text
"level" Text
"heading level"
HsFnPrecursor e ([Inline] -> Maybe Attr -> LuaE e Block)
-> Parameter e [Inline]
-> HsFnPrecursor e (Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Inline]
-> TypeSpec -> Text -> Text -> Parameter e [Inline]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy TypeSpec
"Inlines" Text
"content" Text
"inline content"
HsFnPrecursor e (Maybe Attr -> LuaE e Block)
-> Parameter e (Maybe Attr) -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e (Maybe Attr)
optAttrParam
HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"Header element"
#? "Creates a header element."
, Name -> LuaE e Block -> HsFnPrecursor e (LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"HorizontalRule"
### return HorizontalRule
HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"HorizontalRule element"
#? "Creates a horizontal rule."
, Name
-> ([[Inline]] -> LuaE e Block)
-> HsFnPrecursor e ([[Inline]] -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"LineBlock"
### liftPure LineBlock
HsFnPrecursor e ([[Inline]] -> LuaE e Block)
-> Parameter e [[Inline]] -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [[Inline]]
-> TypeSpec -> Text -> Text -> Parameter e [[Inline]]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (Peeker e [Inline] -> Peeker e [[Inline]]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy) TypeSpec
"{Inlines,...}" Text
"content" Text
"lines"
HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"LineBlock element"
#? "Creates a line block element."
, Name
-> ([[Block]] -> Maybe ListAttributes -> LuaE e Block)
-> HsFnPrecursor
e ([[Block]] -> Maybe ListAttributes -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"OrderedList"
### liftPure2 (\items mListAttrib ->
let defListAttrib = (1, DefaultStyle, DefaultDelim)
in OrderedList (fromMaybe defListAttrib mListAttrib) items)
HsFnPrecursor e ([[Block]] -> Maybe ListAttributes -> LuaE e Block)
-> Parameter e [[Block]]
-> HsFnPrecursor e (Maybe ListAttributes -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e [[Block]]
blockItemsParam Text
"list items"
HsFnPrecursor e (Maybe ListAttributes -> LuaE e Block)
-> Parameter e (Maybe ListAttributes)
-> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e ListAttributes -> Parameter e (Maybe ListAttributes)
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Peeker e ListAttributes
-> TypeSpec -> Text -> Text -> Parameter e ListAttributes
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e ListAttributes
forall e. LuaError e => Peeker e ListAttributes
peekListAttributes TypeSpec
"ListAttributes" Text
"listAttributes"
Text
"list parameters")
HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"OrderedList element"
#? "Creates an ordered list."
, Name
-> ([Inline] -> LuaE e Block)
-> HsFnPrecursor e ([Inline] -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Para"
### liftPure Para
HsFnPrecursor e ([Inline] -> LuaE e Block)
-> Parameter e [Inline] -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Inline]
-> TypeSpec -> Text -> Text -> Parameter e [Inline]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy TypeSpec
"Inlines" Text
"content" Text
"inline content"
HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"Para element"
#? "Creates a para element."
, Name
-> ([Inline] -> LuaE e Block)
-> HsFnPrecursor e ([Inline] -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Plain"
### liftPure Plain
HsFnPrecursor e ([Inline] -> LuaE e Block)
-> Parameter e [Inline] -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Inline]
-> TypeSpec -> Text -> Text -> Parameter e [Inline]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy TypeSpec
"Inlines" Text
"content" Text
"inline content"
HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"Plain element"
#? "Creates a plain element."
, Name
-> (Format -> Text -> LuaE e Block)
-> HsFnPrecursor e (Format -> Text -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"RawBlock"
### liftPure2 RawBlock
HsFnPrecursor e (Format -> Text -> LuaE e Block)
-> Parameter e Format -> HsFnPrecursor e (Text -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Format -> TypeSpec -> Text -> Text -> Parameter e Format
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e Format
forall e. Peeker e Format
peekFormat TypeSpec
"string" Text
"format" Text
"format of content"
HsFnPrecursor e (Text -> LuaE e Block)
-> Parameter e Text -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Text -> Parameter e Text
forall e. Text -> Text -> Parameter e Text
textParam Text
"text" Text
"raw content"
HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"RawBlock element"
#? "Creates a raw content block of the specified format."
, Name
-> (Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Maybe Attr
-> LuaE e Block)
-> HsFnPrecursor
e
(Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Maybe Attr
-> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"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)
HsFnPrecursor
e
(Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Maybe Attr
-> LuaE e Block)
-> Parameter e Caption
-> HsFnPrecursor
e
([ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Maybe Attr
-> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Caption -> TypeSpec -> Text -> Text -> Parameter e Caption
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e Caption
forall e. LuaError e => Peeker e Caption
peekCaptionFuzzy TypeSpec
"Caption" Text
"caption" Text
"table caption"
HsFnPrecursor
e
([ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Maybe Attr
-> LuaE e Block)
-> Parameter e [ColSpec]
-> HsFnPrecursor
e
(TableHead
-> [TableBody] -> TableFoot -> Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [ColSpec]
-> TypeSpec -> Text -> Text -> Parameter e [ColSpec]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (Peeker e ColSpec -> Peeker e [ColSpec]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e ColSpec
forall e. LuaError e => Peeker e ColSpec
peekColSpec) TypeSpec
"{ColSpec,...}" Text
"colspecs"
Text
"column alignments and widths"
HsFnPrecursor
e
(TableHead
-> [TableBody] -> TableFoot -> Maybe Attr -> LuaE e Block)
-> Parameter e TableHead
-> HsFnPrecursor
e ([TableBody] -> TableFoot -> Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e TableHead
-> TypeSpec -> Text -> Text -> Parameter e TableHead
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e TableHead
forall e. LuaError e => Peeker e TableHead
peekTableHead TypeSpec
"TableHead" Text
"head" Text
"table head"
HsFnPrecursor
e ([TableBody] -> TableFoot -> Maybe Attr -> LuaE e Block)
-> Parameter e [TableBody]
-> HsFnPrecursor e (TableFoot -> Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [TableBody]
-> TypeSpec -> Text -> Text -> Parameter e [TableBody]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (Peeker e TableBody -> Peeker e [TableBody]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e TableBody
forall e. LuaError e => Peeker e TableBody
peekTableBody) TypeSpec
"{TableBody,...}" Text
"bodies"
Text
"table bodies"
HsFnPrecursor e (TableFoot -> Maybe Attr -> LuaE e Block)
-> Parameter e TableFoot
-> HsFnPrecursor e (Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e TableFoot
-> TypeSpec -> Text -> Text -> Parameter e TableFoot
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e TableFoot
forall e. LuaError e => Peeker e TableFoot
peekTableFoot TypeSpec
"TableFoot" Text
"foot" Text
"table foot"
HsFnPrecursor e (Maybe Attr -> LuaE e Block)
-> Parameter e (Maybe Attr) -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e (Maybe Attr)
optAttrParam
HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"Table element"
#? "Creates a table element."
]
where
blockResult :: Text -> FunctionResults e Block
blockResult = Pusher e Block -> TypeSpec -> Text -> FunctionResults e Block
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e Block
forall e. LuaError e => Pusher e Block
pushBlock TypeSpec
"Block"
blocksParam :: Parameter e [Block]
blocksParam = Peeker e [Block] -> TypeSpec -> Text -> Text -> Parameter e [Block]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy TypeSpec
"Blocks" Text
"content" Text
"block content"
blockItemsParam :: Text -> Parameter e [[Block]]
blockItemsParam = Peeker e [[Block]]
-> TypeSpec -> Text -> Text -> Parameter e [[Block]]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [[Block]]
forall {e}. LuaError e => StackIndex -> Peek e [[Block]]
peekItemsFuzzy TypeSpec
"{Blocks,...}" Text
"items"
peekItemsFuzzy :: StackIndex -> Peek e [[Block]]
peekItemsFuzzy StackIndex
idx = Peeker e [Block] -> StackIndex -> Peek e [[Block]]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy StackIndex
idx
Peek e [[Block]] -> Peek e [[Block]] -> Peek e [[Block]]
forall a. Peek e a -> Peek e a -> Peek e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (([Block] -> [[Block]] -> [[Block]]
forall a. a -> [a] -> [a]
:[]) ([Block] -> [[Block]]) -> Peek e [Block] -> Peek e [[Block]]
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy StackIndex
idx)
optAttrParam :: Parameter e (Maybe Attr)
optAttrParam = Parameter e Attr -> Parameter e (Maybe Attr)
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Peeker e Attr -> TypeSpec -> Text -> Text -> Parameter e Attr
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr TypeSpec
"Attr" Text
"attr" Text
"element attributes")
mkBlocks :: LuaError e => DocumentedFunction e
mkBlocks :: forall e. LuaError e => DocumentedFunction e
mkBlocks = Name
-> ([Block] -> LuaE e [Block])
-> HsFnPrecursor e ([Block] -> LuaE e [Block])
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Blocks"
### liftPure id
HsFnPrecursor e ([Block] -> LuaE e [Block])
-> Parameter e [Block] -> HsFnPrecursor e (LuaE e [Block])
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Block] -> TypeSpec -> Text -> Text -> Parameter e [Block]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy TypeSpec
"Blocks" Text
"block_like_elements"
(Text
"List where each element can be treated as a [[Block]] value, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"or a single such value.")
HsFnPrecursor e (LuaE e [Block])
-> FunctionResults e [Block] -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e [Block] -> TypeSpec -> Text -> FunctionResults e [Block]
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e [Block]
forall e. LuaError e => Pusher e [Block]
pushBlocks TypeSpec
"Blocks" Text
"list of block elements"
#? "Creates a [[Blocks]] list."
walkBlockSplicing :: (LuaError e, Walkable (SpliceList Block) a)
=> Filter -> a -> LuaE e a
walkBlockSplicing :: forall e a.
(LuaError e, Walkable (SpliceList Block) a) =>
Filter -> a -> LuaE e a
walkBlockSplicing = Pusher e Block -> Peeker e [Block] -> Filter -> a -> LuaE e a
forall e a b.
(LuaError e, Data a, Walkable (SpliceList a) b) =>
Pusher e a -> Peeker e [a] -> Filter -> b -> LuaE e b
walkSplicing Pusher e Block
forall e. LuaError e => Pusher e Block
pushBlock Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy
walkBlocksStraight :: (LuaError e, Walkable [Block] a)
=> Filter -> a -> LuaE e a
walkBlocksStraight :: forall e a.
(LuaError e, Walkable [Block] a) =>
Filter -> a -> LuaE e a
walkBlocksStraight = Name
-> Pusher e [Block] -> Peeker e [Block] -> Filter -> a -> LuaE e a
forall e a b.
(LuaError e, Walkable a b) =>
Name -> Pusher e a -> Peeker e a -> Filter -> b -> LuaE e b
walkStraight Name
"Blocks" Pusher e [Block]
forall e. LuaError e => Pusher e [Block]
pushBlocks Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy