{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Text.Pandoc.Lua.Marshal.Block
(
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.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.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
( peekCaptionFuzzy, pushCaption
, 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 :: Pusher e Block
pushBlock = UDTypeWithList e (DocumentedFunction e) Block Void
-> Pusher e Block
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD UDTypeWithList e (DocumentedFunction e) Block Void
forall e. LuaError e => DocumentedType e Block
typeBlock
{-# INLINE pushBlock #-}
peekBlock :: LuaError e => Peeker e Block
peekBlock :: Peeker e Block
peekBlock = UDTypeWithList e (DocumentedFunction e) Block Void
-> Peeker e Block
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD UDTypeWithList e (DocumentedFunction e) Block Void
forall e. LuaError e => DocumentedType e Block
typeBlock
{-# INLINE peekBlock #-}
peekBlocks :: LuaError e
=> Peeker e [Block]
peekBlocks :: 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 :: Pusher e [Block]
pushBlocks xs :: [Block]
xs = do
Pusher e Block -> Pusher e [Block]
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 "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 "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] -> Text -> Text -> Text -> Parameter e [Block]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy "Blocks" "self" ""
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 -> Text -> Text -> Text -> Parameter e Filter
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Filter
forall e. LuaError e => Peeker e Filter
peekFilter "Filter" "lua_filter" "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] -> Text -> Text -> FunctionResults e [Block]
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e [Block]
forall e. LuaError e => Pusher e [Block]
pushBlocks "Blocks" "modified list"
StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth 3)
StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth 2)
{-# INLINABLE pushBlocks #-}
peekBlockFuzzy :: LuaError e
=> Peeker e Block
peekBlockFuzzy :: Peeker e Block
peekBlockFuzzy idx :: 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 (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 (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 "Block or list of Inlines" StackIndex
idx)
{-# INLINABLE peekBlockFuzzy #-}
peekBlocksFuzzy :: LuaError e
=> Peeker e [Block]
peekBlocksFuzzy :: Peeker e [Block]
peekBlocksFuzzy idx :: StackIndex
idx =
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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Block -> [Block]
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 (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 "Block, list of Blocks, or compatible element" StackIndex
idx)
{-# INLINABLE peekBlocksFuzzy #-}
typeBlock :: forall e. LuaError e => DocumentedType e Block
typeBlock :: 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 "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)
-> Text -> Text -> Text -> Parameter e (Maybe Block)
forall e a. Peeker e a -> Text -> 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) "Block" "a" ""
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)
-> Text -> Text -> Text -> Parameter e (Maybe Block)
forall e a. Peeker e a -> Text -> 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) "Block" "b" ""
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 "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 "self" ""
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 -> Text -> Text -> FunctionResults e String
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e String
forall e. String -> LuaE e ()
pushString "string" "Haskell 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 "attr" "element attributes"
(Pusher e Attr
forall e. LuaError e => Pusher e Attr
pushAttr, \case
CodeBlock attr :: Attr
attr _ -> Attr -> Possible Attr
forall a. a -> Possible a
Actual Attr
attr
Div attr :: Attr
attr _ -> Attr -> Possible Attr
forall a. a -> Possible a
Actual Attr
attr
Header _ attr :: Attr
attr _ -> Attr -> Possible Attr
forall a. a -> Possible a
Actual Attr
attr
Table attr :: Attr
attr _ _ _ _ _ -> Attr -> Possible Attr
forall a. a -> Possible a
Actual Attr
attr
_ -> Possible Attr
forall a. Possible a
Absent)
(Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr, \case
CodeBlock _ code :: 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 _ blks :: [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
Header lvl :: Int
lvl _ blks :: [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
attr -> Int -> Attr -> [Inline] -> Block
Header Int
lvl Attr
attr [Inline]
blks)
Table _ c :: Caption
c cs :: [ColSpec]
cs h :: TableHead
h bs :: [TableBody]
bs f :: 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 -> Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
c [ColSpec]
cs TableHead
h [TableBody]
bs TableFoot
f)
_ -> 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 "bodies" "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 _ _ _ _ bs :: [TableBody]
bs _ -> [TableBody] -> Possible [TableBody]
forall a. a -> Possible a
Actual [TableBody]
bs
_ -> 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
attr c :: Caption
c cs :: [ColSpec]
cs h :: TableHead
h _ f :: 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
. (\bs :: [TableBody]
bs -> Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
c [ColSpec]
cs TableHead
h [TableBody]
bs TableFoot
f)
_ -> 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 "caption" "element caption"
(Pusher e Caption
forall e. LuaError e => Caption -> LuaE e ()
pushCaption, \case {Table _ capt :: Caption
capt _ _ _ _ -> Caption -> Possible Caption
forall a. a -> Possible a
Actual Caption
capt; _ -> Possible Caption
forall a. Possible a
Absent})
(Peeker e Caption
forall e. LuaError e => Peeker e Caption
peekCaptionFuzzy, \case
Table attr :: Attr
attr _ cs :: [ColSpec]
cs h :: TableHead
h bs :: [TableBody]
bs f :: 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
. (\c :: Caption
c -> Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
c [ColSpec]
cs TableHead
h [TableBody]
bs TableFoot
f)
_ -> 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 "colspecs" "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 _ _ cs :: [ColSpec]
cs _ _ _ -> [ColSpec] -> Possible [ColSpec]
forall a. a -> Possible a
Actual [ColSpec]
cs
_ -> 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
attr c :: Caption
c _ h :: TableHead
h bs :: [TableBody]
bs f :: 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
. (\cs :: [ColSpec]
cs -> Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
c [ColSpec]
cs TableHead
h [TableBody]
bs TableFoot
f)
_ -> 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 "content" "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 (Proxy e
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 "foot" "table foot"
(Pusher e TableFoot
forall e. LuaError e => TableFoot -> LuaE e ()
pushTableFoot, \case {Table _ _ _ _ _ f :: TableFoot
f -> TableFoot -> Possible TableFoot
forall a. a -> Possible a
Actual TableFoot
f; _ -> Possible TableFoot
forall a. Possible a
Absent})
(Peeker e TableFoot
forall e. LuaError e => Peeker e TableFoot
peekTableFoot, \case
Table attr :: Attr
attr c :: Caption
c cs :: [ColSpec]
cs h :: TableHead
h bs :: [TableBody]
bs _ -> 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
_ -> 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 "format" "format of raw content"
(Pusher e Format
forall e. Pusher e Format
pushFormat, \case {RawBlock f :: Format
f _ -> Format -> Possible Format
forall a. a -> Possible a
Actual Format
f; _ -> Possible Format
forall a. Possible a
Absent})
(Peeker e Format
forall e. Peeker e Format
peekFormat, \case
RawBlock _ txt :: 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)
_ -> 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 "head" "table head"
(Pusher e TableHead
forall e. LuaError e => TableHead -> LuaE e ()
pushTableHead, \case {Table _ _ _ h :: TableHead
h _ _ -> TableHead -> Possible TableHead
forall a. a -> Possible a
Actual TableHead
h; _ -> Possible TableHead
forall a. Possible a
Absent})
(Peeker e TableHead
forall e. LuaError e => Peeker e TableHead
peekTableHead, \case
Table attr :: Attr
attr c :: Caption
c cs :: [ColSpec]
cs _ bs :: [TableBody]
bs f :: 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
. (\h :: TableHead
h -> Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
c [ColSpec]
cs TableHead
h [TableBody]
bs TableFoot
f)
_ -> 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 "level" "heading level"
(Pusher e Int
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, \case {Header lvl :: Int
lvl _ _ -> Int -> Possible Int
forall a. a -> Possible a
Actual Int
lvl; _ -> Possible Int
forall a. Possible a
Absent})
(Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \case
Header _ attr :: Attr
attr inlns :: [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
. \lvl :: Int
lvl -> Int -> Attr -> [Inline] -> Block
Header Int
lvl Attr
attr [Inline]
inlns
_ -> 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 "listAttributes" "ordered list attributes"
(Pusher e ListAttributes
forall e. LuaError e => Pusher e ListAttributes
pushListAttributes, \case
OrderedList listAttr :: ListAttributes
listAttr _ -> ListAttributes -> Possible ListAttributes
forall a. a -> Possible a
Actual ListAttributes
listAttr
_ -> Possible ListAttributes
forall a. Possible a
Absent)
(Peeker e ListAttributes
forall e. LuaError e => Peeker e ListAttributes
peekListAttributes, \case
OrderedList _ content :: [[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)
_ -> 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 "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 "tag" "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 "t" "tag" ["tag"]
, AliasIndex
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Block
forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias "c" "content" ["content"]
, AliasIndex
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Block
forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias "identifier" "element identifier" ["attr", "identifier"]
, AliasIndex
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Block
forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias "classes" "element classes" ["attr", "classes"]
, AliasIndex
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Block
forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias "attributes" "other element attributes" ["attr", "attributes"]
, AliasIndex
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Block
forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias "start" "ordered list start number" ["listAttributes", "start"]
, AliasIndex
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Block
forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias "style" "ordered list style" ["listAttributes", "style"]
, AliasIndex
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Block
forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias "delimiter" "numbering delimiter" ["listAttributes", "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 "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)
-> Text -> Text -> Text -> Parameter e Block
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter StackIndex -> Peek e Block
forall e. LuaError e => Peeker e Block
peekBlock "Block" "block" "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 -> Text -> Text -> FunctionResults e Block
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Block
forall e. LuaError e => Pusher e Block
pushBlock "Block" "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 "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)
-> Text -> Text -> Text -> Parameter e Block
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter StackIndex -> Peek e Block
forall e. LuaError e => Peeker e Block
peekBlock "Block" "self" ""
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 -> Text -> Text -> FunctionResults e String
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e String
forall e. String -> LuaE e ()
pushString "string" "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 "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)
-> Text -> Text -> Text -> Parameter e Block
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter StackIndex -> Peek e Block
forall e. LuaError e => Peeker e Block
peekBlock "Block" "self" ""
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 -> Text -> Text -> Text -> Parameter e Filter
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Filter
forall e. LuaError e => Peeker e Filter
peekFilter "Filter" "lua_filter" "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 -> Text -> Text -> FunctionResults e Block
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Block
forall e. LuaError e => Pusher e Block
pushBlock "Block" "modified element"
]
getBlockContent :: Block -> Possible Content
getBlockContent :: Block -> Possible Content
getBlockContent = \case
Para inlns :: [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 inlns :: [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 _ _ inlns :: [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 blks :: [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 _ blks :: [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 lns :: [[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 itms :: [[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 _ itms :: [[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 itms :: [([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
_ -> Possible Content
forall a. Possible a
Absent
setBlockContent :: forall e. LuaError e
=> Proxy e -> Block -> Content -> Possible Block
setBlockContent :: Proxy e -> Block -> Content -> Possible Block
setBlockContent _ = \case
Para _ -> 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 _ -> 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 attr :: Int
attr lvl :: Attr
lvl _ -> 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 -> 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
attr _ -> 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
LineBlock _ -> 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 -> 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 la :: ListAttributes
la _ -> 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 _ -> 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
_ -> 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 inlns :: [Inline]
inlns -> [Inline]
inlns
c :: Content
c -> e -> [Inline]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (e -> [Inline]) -> (String -> e) -> String -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LuaError e => String -> e
forall e. LuaError e => String -> e
luaException @e (String -> [Inline]) -> String -> [Inline]
forall a b. (a -> b) -> a -> b
$
"expected Inlines, got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Content -> String
contentTypeDescription Content
c
blockContent :: Content -> [Block]
blockContent = \case
ContentBlocks blks :: [Block]
blks -> [Block]
blks
ContentInlines inlns :: [Inline]
inlns -> [[Inline] -> Block
Plain [Inline]
inlns]
c :: Content
c -> e -> [Block]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (e -> [Block]) -> (String -> e) -> String -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LuaError e => String -> e
forall e. LuaError e => String -> e
luaException @e (String -> [Block]) -> String -> [Block]
forall a b. (a -> b) -> a -> b
$
"expected Blocks, got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Content -> String
contentTypeDescription Content
c
lineContent :: Content -> [[Inline]]
lineContent = \case
ContentLines lns :: [[Inline]]
lns -> [[Inline]]
lns
c :: Content
c -> e -> [[Inline]]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (e -> [[Inline]]) -> (String -> e) -> String -> [[Inline]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LuaError e => String -> e
forall e. LuaError e => String -> e
luaException @e (String -> [[Inline]]) -> String -> [[Inline]]
forall a b. (a -> b) -> a -> b
$
"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 itms :: [([Inline], [[Block]])]
itms -> [([Inline], [[Block]])]
itms
c :: Content
c -> e -> [([Inline], [[Block]])]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (e -> [([Inline], [[Block]])])
-> (String -> e) -> String -> [([Inline], [[Block]])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LuaError e => String -> e
forall e. LuaError e => String -> e
luaException @e (String -> [([Inline], [[Block]])])
-> String -> [([Inline], [[Block]])]
forall a b. (a -> b) -> a -> b
$
"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 blks :: [Block]
blks -> [[Block]
blks]
ContentLines lns :: [[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 itms :: [[Block]]
itms -> [[Block]]
itms
c :: Content
c -> e -> [[Block]]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (e -> [[Block]]) -> (String -> e) -> String -> [[Block]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LuaError e => String -> e
forall e. LuaError e => String -> e
luaException @e (String -> [[Block]]) -> String -> [[Block]]
forall a b. (a -> b) -> a -> b
$
"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 _ lst :: Text
lst -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
lst
RawBlock _ raw :: Text
raw -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
raw
_ -> Possible Text
forall a. Possible a
Absent
setBlockText :: Block -> Text -> Possible Block
setBlockText :: Block -> Text -> Possible Block
setBlockText = \case
CodeBlock attr :: Attr
attr _ -> 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 f :: Format
f _ -> 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
_ -> 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 :: [DocumentedFunction e]
blockConstructors =
[ Name
-> ([Block] -> LuaE e Block)
-> HsFnPrecursor e ([Block] -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun "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 "BlockQuote element"
, Name
-> ([[Block]] -> LuaE e Block)
-> HsFnPrecursor e ([[Block]] -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun "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 "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 "BulletList element"
, Name
-> (Text -> Maybe Attr -> LuaE e Block)
-> HsFnPrecursor e (Text -> Maybe Attr -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun "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" "code block 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 "CodeBlock element"
, Name
-> ([([Inline], [[Block]])] -> LuaE e Block)
-> HsFnPrecursor e ([([Inline], [[Block]])] -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun "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]])]
-> Text -> Text -> Text -> Parameter e [([Inline], [[Block]])]
forall e a. Peeker e a -> Text -> 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
, \idx :: 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
])
"{{Inlines, {Blocks,...}},...}"
"content" "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 "DefinitionList element"
, Name
-> ([Block] -> Maybe Attr -> LuaE e Block)
-> HsFnPrecursor e ([Block] -> Maybe Attr -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun "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 "Div 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 "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 -> Text -> Text -> Text -> Parameter e Int
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral "integer" "level" "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] -> Text -> Text -> Text -> Parameter e [Inline]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy "Inlines" "content" "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 "Header element"
, Name -> LuaE e Block -> HsFnPrecursor e (LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun "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 "HorizontalRule element"
, Name
-> ([[Inline]] -> LuaE e Block)
-> HsFnPrecursor e ([[Inline]] -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun "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]]
-> Text -> Text -> Text -> Parameter e [[Inline]]
forall e a. Peeker e a -> Text -> 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) "{Inlines,...}" "content" "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 "LineBlock element"
, Name -> LuaE e Block -> HsFnPrecursor e (LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun "Null"
### return Null
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 "Null 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 "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 "ordered 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
-> Text -> Text -> Text -> Parameter e ListAttributes
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e ListAttributes
forall e. LuaError e => Peeker e ListAttributes
peekListAttributes "ListAttributes" "listAttributes"
"specifier for the list's numbering")
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 "OrderedList element"
, Name
-> ([Inline] -> LuaE e Block)
-> HsFnPrecursor e ([Inline] -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun "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] -> Text -> Text -> Text -> Parameter e [Inline]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy "Inlines" "content" "paragraph 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 "Para element"
, Name
-> ([Inline] -> LuaE e Block)
-> HsFnPrecursor e ([Inline] -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun "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] -> Text -> Text -> Text -> Parameter e [Inline]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy "Inlines" "content" "paragraph 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 "Plain element"
, Name
-> (Format -> Text -> LuaE e Block)
-> HsFnPrecursor e (Format -> Text -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun "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 -> Text -> Text -> Text -> Parameter e Format
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Format
forall e. Peeker e Format
peekFormat "Format" "format" "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" "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 "RawBlock element"
, 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 "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 -> Text -> Text -> Text -> Parameter e Caption
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Caption
forall e. LuaError e => Peeker e Caption
peekCaptionFuzzy "Caption" "caption" "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] -> Text -> Text -> Text -> Parameter e [ColSpec]
forall e a. Peeker e a -> Text -> 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) "{ColSpec,...}" "colspecs"
"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 -> Text -> Text -> Text -> Parameter e TableHead
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e TableHead
forall e. LuaError e => Peeker e TableHead
peekTableHead "TableHead" "head" "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]
-> Text -> Text -> Text -> Parameter e [TableBody]
forall e a. Peeker e a -> Text -> 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) "{TableBody,...}" "bodies"
"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 -> Text -> Text -> Text -> Parameter e TableFoot
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e TableFoot
forall e. LuaError e => Peeker e TableFoot
peekTableFoot "TableFoot" "foot" "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 "Table element"
]
where
blockResult :: Text -> FunctionResults e Block
blockResult = Pusher e Block -> Text -> Text -> FunctionResults e Block
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Block
forall e. LuaError e => Pusher e Block
pushBlock "Block"
blocksParam :: Parameter e [Block]
blocksParam = Peeker e [Block] -> Text -> Text -> Text -> Parameter e [Block]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy "Blocks" "content" "block content"
blockItemsParam :: Text -> Parameter e [[Block]]
blockItemsParam = Peeker e [[Block]] -> Text -> Text -> Text -> Parameter e [[Block]]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e [[Block]]
forall e. LuaError e => StackIndex -> Peek e [[Block]]
peekItemsFuzzy "List of Blocks" "content"
peekItemsFuzzy :: StackIndex -> Peek e [[Block]]
peekItemsFuzzy idx :: 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 (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 -> Text -> Text -> Text -> Parameter e Attr
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr "Attr" "attr" "additional attributes")
mkBlocks :: LuaError e => DocumentedFunction e
mkBlocks :: DocumentedFunction e
mkBlocks = Name
-> ([Block] -> LuaE e [Block])
-> HsFnPrecursor e ([Block] -> LuaE e [Block])
forall a e. Name -> a -> HsFnPrecursor e a
defun "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] -> Text -> Text -> Text -> Parameter e [Block]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy "Blocks" "blocks" "block elements"
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] -> Text -> Text -> FunctionResults e [Block]
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e [Block]
forall e. LuaError e => Pusher e [Block]
pushBlocks "Blocks" "list of block elements"
walkBlockSplicing :: (LuaError e, Walkable (SpliceList Block) a)
=> Filter -> a -> LuaE e a
walkBlockSplicing :: 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 :: 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 "Blocks" Pusher e [Block]
forall e. LuaError e => Pusher e [Block]
pushBlocks Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy