{-# LANGUAGE AllowAmbiguousTypes  #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeApplications     #-}
{- |

Marshal values of types that make up 'Block' elements.
-}
module Text.Pandoc.Lua.Marshal.Block
  ( -- * Single Block elements
    peekBlock
  , peekBlockFuzzy
  , pushBlock
    -- * List of Blocks
  , peekBlocks
  , peekBlocksFuzzy
  , pushBlocks
    -- * Constructors
  , blockConstructors
  , mkBlocks
    -- * Walk
  , 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

-- | Pushes an Block value as userdata object.
pushBlock :: LuaError e => Pusher e Block
pushBlock :: forall e. LuaError e => Pusher e Block
pushBlock = forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD forall e. LuaError e => DocumentedType e Block
typeBlock
{-# INLINE pushBlock #-}

-- | Retrieves an Block value.
peekBlock :: LuaError e => Peeker e Block
peekBlock :: forall e. LuaError e => Peeker e Block
peekBlock = forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD forall e. LuaError e => DocumentedType e Block
typeBlock
{-# INLINE peekBlock #-}

-- | Retrieves a list of Block values.
peekBlocks :: LuaError e
           => Peeker e [Block]
peekBlocks :: forall e. LuaError e => Peeker e [Block]
peekBlocks = forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e Block
peekBlock
{-# INLINABLE peekBlocks #-}

-- | Pushes a list of Block values.
pushBlocks :: LuaError e
           => Pusher e [Block]
pushBlocks :: forall e. LuaError e => Pusher e [Block]
pushBlocks [Block]
xs = do
  forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList forall e. LuaError e => Pusher e Block
pushBlock [Block]
xs
  forall e. Name -> LuaE e () -> LuaE e ()
newListMetatable Name
"Blocks" forall a b. (a -> b) -> a -> b
$ do
    forall e. Name -> LuaE e ()
pushName Name
"walk"
    forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
      ### flip walkBlocksAndInlines
      forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy Text
"Blocks" Text
"self" Text
""
      forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Filter
peekFilter Text
"Filter" Text
"lua_filter" Text
"table of filter functions"
      forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e [Block]
pushBlocks Text
"Blocks" Text
"modified list"
    forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
  forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth CInt
2)
{-# INLINABLE pushBlocks #-}

-- | Try extra hard to retrieve an Block value from the stack. Treats
-- bare strings as @Str@ values.
peekBlockFuzzy :: LuaError e
               => Peeker e Block
peekBlockFuzzy :: forall e. LuaError e => Peeker e Block
peekBlockFuzzy StackIndex
idx =
       forall e. LuaError e => Peeker e Block
peekBlock StackIndex
idx
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Inline] -> Block
Plain forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy StackIndex
idx)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a e. ByteString -> Peek e a
failPeek forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
       forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"Block or list of Inlines" StackIndex
idx)
{-# INLINABLE peekBlockFuzzy #-}

-- | Try extra-hard to return the value at the given index as a list of
-- inlines.
peekBlocksFuzzy :: LuaError e
                => Peeker e [Block]
peekBlocksFuzzy :: forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy StackIndex
idx =
      forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e Block
peekBlockFuzzy StackIndex
idx
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. LuaError e => Peeker e Block
peekBlockFuzzy StackIndex
idx)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a e. ByteString -> Peek e a
failPeek forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
       forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"Block, list of Blocks, or compatible element" StackIndex
idx)
{-# INLINABLE peekBlocksFuzzy #-}

-- | Block object type.
typeBlock :: forall e. LuaError e => DocumentedType e Block
typeBlock :: forall e. LuaError e => DocumentedType e Block
typeBlock = forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"Block"
  [ forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Eq forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b))
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => Peeker e Block
peekBlockFuzzy) Text
"Block" Text
"a" Text
""
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => Peeker e Block
peekBlockFuzzy) Text
"Block" Text
"b" Text
""
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e. Text -> FunctionResults e Bool
boolResult Text
"whether the two values are equal"
  , forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Tostring forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure show
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam forall e. LuaError e => DocumentedType e Block
typeBlock Text
"self" Text
""
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. String -> LuaE e ()
pushString Text
"string" Text
"Haskell representation"
  ]
  [ 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"
      (forall e. LuaError e => Pusher e Attr
pushAttr, \case
          CodeBlock Attr
attr Text
_     -> forall a. a -> Possible a
Actual Attr
attr
          Div Attr
attr [Block]
_           -> forall a. a -> Possible a
Actual Attr
attr
          Figure Attr
attr Caption
_ [Block]
_      -> forall a. a -> Possible a
Actual Attr
attr
          Header Int
_ Attr
attr [Inline]
_      -> forall a. a -> Possible a
Actual Attr
attr
          Table Attr
attr Caption
_ [ColSpec]
_ TableHead
_ [TableBody]
_ TableFoot
_ -> forall a. a -> Possible a
Actual Attr
attr
          Block
_                    -> forall a. Possible a
Absent)
      (forall e. LuaError e => Peeker e Attr
peekAttr, \case
          CodeBlock Attr
_ Text
code     -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip Attr -> Text -> Block
CodeBlock Text
code
          Div Attr
_ [Block]
blks           -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip Attr -> [Block] -> Block
Div [Block]
blks
          Figure Attr
_ Caption
capt [Block]
blks   -> forall a. a -> Possible a
Actual 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    -> forall a. a -> Possible a
Actual 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  -> forall a. a -> Possible a
Actual 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
_                    -> forall a b. a -> b -> a
const forall a. Possible a
Absent)
  , 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"
      (forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushPandocList forall e. LuaError e => Pusher e TableBody
pushTableBody, \case
          Table Attr
_ Caption
_ [ColSpec]
_ TableHead
_ [TableBody]
bs TableFoot
_ -> forall a. a -> Possible a
Actual [TableBody]
bs
          Block
_                  -> forall a. Possible a
Absent)
      (forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e TableBody
peekTableBody, \case
          Table Attr
attr Caption
c [ColSpec]
cs TableHead
h [TableBody]
_ TableFoot
f -> forall a. a -> Possible a
Actual 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
_                     -> forall a b. a -> b -> a
const forall a. Possible a
Absent)
  , 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"
      (forall e. LuaError e => Caption -> LuaE e ()
pushCaption, \case
          Figure Attr
_ Caption
capt [Block]
_      -> forall a. a -> Possible a
Actual Caption
capt
          Table Attr
_ Caption
capt [ColSpec]
_ TableHead
_ [TableBody]
_ TableFoot
_ -> forall a. a -> Possible a
Actual Caption
capt
          Block
_ -> forall a. Possible a
Absent)
      (forall e. LuaError e => Peeker e Caption
peekCaptionFuzzy, \case
          Figure Attr
attr Caption
_ [Block]
blks     -> forall a. a -> Possible a
Actual 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 -> forall a. a -> Possible a
Actual 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
_                      -> forall a b. a -> b -> a
const forall a. Possible a
Absent)
  , 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"
      (forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushPandocList forall e. LuaError e => Pusher e ColSpec
pushColSpec, \case
          Table Attr
_ Caption
_ [ColSpec]
cs TableHead
_ [TableBody]
_ TableFoot
_     -> forall a. a -> Possible a
Actual [ColSpec]
cs
          Block
_                      -> forall a. Possible a
Absent)
      (forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e ColSpec
peekColSpec, \case
          Table Attr
attr Caption
c [ColSpec]
_ TableHead
h [TableBody]
bs TableFoot
f  -> forall a. a -> Possible a
Actual 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
_                      -> forall a b. a -> b -> a
const forall a. Possible a
Absent)
  , 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"
      (forall e. LuaError e => Pusher e Content
pushContent, Block -> Possible Content
getBlockContent)
      (forall e. LuaError e => Peeker e Content
peekContent, forall e.
LuaError e =>
Proxy e -> Block -> Content -> Possible Block
setBlockContent (forall {k} (t :: k). Proxy t
Proxy @e))
  , 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"
      (forall e. LuaError e => TableFoot -> LuaE e ()
pushTableFoot, \case {Table Attr
_ Caption
_ [ColSpec]
_ TableHead
_ [TableBody]
_ TableFoot
f -> forall a. a -> Possible a
Actual TableFoot
f; Block
_ -> forall a. Possible a
Absent})
      (forall e. LuaError e => Peeker e TableFoot
peekTableFoot, \case
          Table Attr
attr Caption
c [ColSpec]
cs TableHead
h [TableBody]
bs TableFoot
_ -> forall a. a -> Possible a
Actual 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
_                      -> forall a b. a -> b -> a
const forall a. Possible a
Absent)
  , 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"
      (forall e. Pusher e Format
pushFormat, \case {RawBlock Format
f Text
_ -> forall a. a -> Possible a
Actual Format
f; Block
_ -> forall a. Possible a
Absent})
      (forall e. Peeker e Format
peekFormat, \case
          RawBlock Format
_ Text
txt -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Format -> Text -> Block
`RawBlock` Text
txt)
          Block
_              -> forall a b. a -> b -> a
const forall a. Possible a
Absent)
  , 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"
      (forall e. LuaError e => TableHead -> LuaE e ()
pushTableHead, \case {Table Attr
_ Caption
_ [ColSpec]
_ TableHead
h [TableBody]
_ TableFoot
_ -> forall a. a -> Possible a
Actual TableHead
h; Block
_ -> forall a. Possible a
Absent})
      (forall e. LuaError e => Peeker e TableHead
peekTableHead, \case
          Table Attr
attr Caption
c [ColSpec]
cs TableHead
_ [TableBody]
bs TableFoot
f  -> forall a. a -> Possible a
Actual 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
_                       -> forall a b. a -> b -> a
const forall a. Possible a
Absent)
  , 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"
      (forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, \case {Header Int
lvl Attr
_ [Inline]
_ -> forall a. a -> Possible a
Actual Int
lvl; Block
_ -> forall a. Possible a
Absent})
      (forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \case
          Header Int
_ Attr
attr [Inline]
inlns -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Int
lvl -> Int -> Attr -> [Inline] -> Block
Header Int
lvl Attr
attr [Inline]
inlns
          Block
_                   -> forall a b. a -> b -> a
const forall a. Possible a
Absent)
  , 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"
      (forall e. LuaError e => Pusher e ListAttributes
pushListAttributes, \case
          OrderedList ListAttributes
listAttr [[Block]]
_ -> forall a. a -> Possible a
Actual ListAttributes
listAttr
          Block
_                      -> forall a. Possible a
Absent)
      (forall e. LuaError e => Peeker e ListAttributes
peekListAttributes, \case
          OrderedList ListAttributes
_ [[Block]]
content -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ListAttributes -> [[Block]] -> Block
`OrderedList` [[Block]]
content)
          Block
_                     -> forall a b. a -> b -> a
const forall a. Possible a
Absent)
  , 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"
      (forall e. Pusher e Text
pushText, Block -> Possible Text
getBlockText)
      (forall e. Peeker e Text
peekText, Block -> Text -> Possible Block
setBlockText)

  , forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"tag" Text
"type of Block"
      (forall e. String -> LuaE e ()
pushString, Constr -> String
showConstr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => a -> Constr
toConstr )

  , forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias AliasIndex
"t" Text
"tag" [AliasIndex
"tag"]
  , forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias AliasIndex
"c" Text
"content" [AliasIndex
"content"]
  , forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias AliasIndex
"identifier" Text
"element identifier"       [AliasIndex
"attr", AliasIndex
"identifier"]
  , forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias AliasIndex
"classes"    Text
"element classes"          [AliasIndex
"attr", AliasIndex
"classes"]
  , forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias AliasIndex
"attributes" Text
"other element attributes" [AliasIndex
"attr", AliasIndex
"attributes"]
  , forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias AliasIndex
"start"      Text
"ordered list start number" [AliasIndex
"listAttributes", AliasIndex
"start"]
  , forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias AliasIndex
"style"      Text
"ordered list style"       [AliasIndex
"listAttributes", AliasIndex
"style"]
  , forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias AliasIndex
"delimiter"  Text
"numbering delimiter"      [AliasIndex
"listAttributes", AliasIndex
"delimiter"]

  , forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method forall a b. (a -> b) -> a -> b
$ forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"clone"
    ### return
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Block
peekBlock Text
"Block" Text
"block" Text
"self"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Block
pushBlock Text
"Block" Text
"cloned Block"

  , forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method forall a b. (a -> b) -> a -> b
$ forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"show"
    ### liftPure show
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Block
peekBlock Text
"Block" Text
"self" Text
""
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. String -> LuaE e ()
pushString Text
"string" Text
"Haskell string representation"

  , forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method forall a b. (a -> b) -> a -> b
$ forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"walk"
    ### flip walkBlocksAndInlines
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Block
peekBlock Text
"Block" Text
"self" Text
""
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Filter
peekFilter Text
"Filter" Text
"lua_filter" Text
"table of filter functions"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Block
pushBlock Text
"Block" Text
"modified element"
  ]

getBlockContent :: Block -> Possible Content
getBlockContent :: Block -> Possible Content
getBlockContent = \case
  -- inline content
  Para [Inline]
inlns          -> forall a. a -> Possible a
Actual forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
  Plain [Inline]
inlns         -> forall a. a -> Possible a
Actual forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
  Header Int
_ Attr
_ [Inline]
inlns    -> forall a. a -> Possible a
Actual forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
  -- block content
  BlockQuote [Block]
blks     -> forall a. a -> Possible a
Actual forall a b. (a -> b) -> a -> b
$ [Block] -> Content
ContentBlocks [Block]
blks
  Div Attr
_ [Block]
blks          -> forall a. a -> Possible a
Actual forall a b. (a -> b) -> a -> b
$ [Block] -> Content
ContentBlocks [Block]
blks
  Figure Attr
_ Caption
_ [Block]
blks     -> forall a. a -> Possible a
Actual forall a b. (a -> b) -> a -> b
$ [Block] -> Content
ContentBlocks [Block]
blks
  -- lines content
  LineBlock [[Inline]]
lns       -> forall a. a -> Possible a
Actual forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Content
ContentLines [[Inline]]
lns
  -- list items content
  BulletList [[Block]]
itms     -> forall a. a -> Possible a
Actual forall a b. (a -> b) -> a -> b
$ [[Block]] -> Content
ContentListItems [[Block]]
itms
  OrderedList ListAttributes
_ [[Block]]
itms  -> forall a. a -> Possible a
Actual forall a b. (a -> b) -> a -> b
$ [[Block]] -> Content
ContentListItems [[Block]]
itms
  -- definition items content
  DefinitionList [([Inline], [[Block]])]
itms -> forall a. a -> Possible a
Actual forall a b. (a -> b) -> a -> b
$ [([Inline], [[Block]])] -> Content
ContentDefItems [([Inline], [[Block]])]
itms
  Block
_                   -> 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
  -- inline content
  Para [Inline]
_           -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Block
Para forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
  Plain [Inline]
_          -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Block
Plain forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
  Header Int
attr Attr
lvl [Inline]
_ -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Attr -> [Inline] -> Block
Header Int
attr Attr
lvl forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
  -- block content
  BlockQuote [Block]
_     -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Block
BlockQuote forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Block]
blockContent
  Div Attr
attr [Block]
_       -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> [Block] -> Block
Div Attr
attr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Block]
blockContent
  Figure Attr
attr Caption
c [Block]
_  -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Caption -> [Block] -> Block
Figure Attr
attr Caption
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Block]
blockContent
  -- lines content
  LineBlock [[Inline]]
_      -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Inline]] -> Block
LineBlock forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [[Inline]]
lineContent
  -- list items content
  BulletList [[Block]]
_     -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Block]] -> Block
BulletList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [[Block]]
listItemContent
  OrderedList ListAttributes
la [[Block]]
_ -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListAttributes -> [[Block]] -> Block
OrderedList ListAttributes
la forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [[Block]]
listItemContent
  -- definition items content
  DefinitionList [([Inline], [[Block]])]
_ -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Inline], [[Block]])] -> Block
DefinitionList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [([Inline], [[Block]])]
defItemContent
  Block
_                -> forall a b. a -> b -> a
const forall a. Possible a
Absent
 where
    inlineContent :: Content -> [Inline]
inlineContent = \case
      ContentInlines [Inline]
inlns -> [Inline]
inlns
      Content
c -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => String -> e
luaException @e forall a b. (a -> b) -> a -> b
$
           String
"expected Inlines, got " forall a. Semigroup a => a -> a -> a
<> Content -> String
contentTypeDescription Content
c
    blockContent :: Content -> [Block]
blockContent = \case
      ContentBlocks [Block]
blks   -> [Block]
blks
      ContentInlines [Inline]
inlns -> [[Inline] -> Block
Plain [Inline]
inlns]
      Content
c -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => String -> e
luaException @e forall a b. (a -> b) -> a -> b
$
           String
"expected Blocks, got " forall a. Semigroup a => a -> a -> a
<> Content -> String
contentTypeDescription Content
c
    lineContent :: Content -> [[Inline]]
lineContent = \case
      ContentLines [[Inline]]
lns     -> [[Inline]]
lns
      Content
c -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => String -> e
luaException @e forall a b. (a -> b) -> a -> b
$
           String
"expected list of lines (Inlines), got " 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 -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => String -> e
luaException @e forall a b. (a -> b) -> a -> b
$
           String
"expected definition items, got " forall a. Semigroup a => a -> a -> a
<> Content -> String
contentTypeDescription Content
c
    listItemContent :: Content -> [[Block]]
listItemContent = \case
      ContentBlocks [Block]
blks    -> [[Block]
blks]
      ContentLines [[Inline]]
lns      -> forall a b. (a -> b) -> [a] -> [b]
map ((forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Block
Plain) [[Inline]]
lns
      ContentListItems [[Block]]
itms -> [[Block]]
itms
      Content
c -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => String -> e
luaException @e forall a b. (a -> b) -> a -> b
$
           String
"expected list of items, got " 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 -> forall a. a -> Possible a
Actual Text
lst
  RawBlock Format
_ Text
raw  -> forall a. a -> Possible a
Actual Text
raw
  Block
_               -> forall a. Possible a
Absent

setBlockText :: Block -> Text -> Possible Block
setBlockText :: Block -> Text -> Possible Block
setBlockText = \case
  CodeBlock Attr
attr Text
_ -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Text -> Block
CodeBlock Attr
attr
  RawBlock Format
f Text
_     -> forall a. a -> Possible a
Actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Text -> Block
RawBlock Format
f
  Block
_                -> forall a b. a -> b -> a
const forall a. Possible a
Absent

-- | Constructor functions for 'Block' elements.
blockConstructors :: LuaError e => [DocumentedFunction e]
blockConstructors :: forall e. LuaError e => [DocumentedFunction e]
blockConstructors =
  [ forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"BlockQuote"
    ### liftPure BlockQuote
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e [Block]
blocksParam
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"BlockQuote element"

  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"BulletList"
    ### liftPure BulletList
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e [[Block]]
blockItemsParam Text
"list items"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"BulletList element"

  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"CodeBlock"
    ### liftPure2 (\code mattr -> CodeBlock (fromMaybe nullAttr mattr) code)
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e Text
textParam Text
"text" Text
"code block content"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e (Maybe Attr)
optAttrParam
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"CodeBlock element"

  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"DefinitionList"
    ### liftPure DefinitionList
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (forall e a. LuaError e => [Peeker e a] -> Peeker e a
choice
                   [ forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e ([Inline], [[Block]])
peekDefinitionItem
                   , \StackIndex
idx -> (forall a. a -> [a] -> [a]
:[]) forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. LuaError e => Peeker e ([Inline], [[Block]])
peekDefinitionItem StackIndex
idx
                   ])
                  Text
"{{Inlines, {Blocks,...}},...}"
                  Text
"content" Text
"definition items"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"DefinitionList element"

  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Div"
    ### liftPure2 (\content mattr -> Div (fromMaybe nullAttr mattr) content)
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e [Block]
blocksParam
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e (Maybe Attr)
optAttrParam
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"Div element"

  , 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)
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy Text
"Blocks" Text
"content" Text
"figure content"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Caption
peekCaptionFuzzy Text
"Caption" Text
"caption" Text
"figure caption")
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e (Maybe Attr)
optAttrParam
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"Figure element"

  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Header"
    ### liftPure3 (\lvl content mattr ->
                     Header lvl (fromMaybe nullAttr mattr) content)
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall a e. (Integral a, Read a) => Peeker e a
peekIntegral Text
"integer" Text
"level" Text
"heading level"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy Text
"Inlines" Text
"content" Text
"inline content"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e (Maybe Attr)
optAttrParam
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"Header element"

  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"HorizontalRule"
    ### return HorizontalRule
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"HorizontalRule element"

  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"LineBlock"
    ### liftPure LineBlock
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy) Text
"{Inlines,...}" Text
"content" Text
"lines"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"LineBlock element"

  , 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)
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e [[Block]]
blockItemsParam Text
"ordered list items"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e ListAttributes
peekListAttributes Text
"ListAttributes" Text
"listAttributes"
                       Text
"specifier for the list's numbering")
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"OrderedList element"

  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Para"
    ### liftPure Para
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy Text
"Inlines" Text
"content" Text
"paragraph content"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"Para element"

  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Plain"
    ### liftPure Plain
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy Text
"Inlines" Text
"content" Text
"paragraph content"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"Plain element"

  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"RawBlock"
    ### liftPure2 RawBlock
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. Peeker e Format
peekFormat Text
"Format" Text
"format" Text
"format of content"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e Text
textParam Text
"text" Text
"raw content"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"RawBlock element"

  , 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)
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Caption
peekCaptionFuzzy Text
"Caption" Text
"caption" Text
"table caption"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e ColSpec
peekColSpec) Text
"{ColSpec,...}" Text
"colspecs"
                  Text
"column alignments and widths"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e TableHead
peekTableHead Text
"TableHead" Text
"head" Text
"table head"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e TableBody
peekTableBody) Text
"{TableBody,...}" Text
"bodies"
                  Text
"table bodies"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e TableFoot
peekTableFoot Text
"TableFoot" Text
"foot" Text
"table foot"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e (Maybe Attr)
optAttrParam
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"Table element"
  ]
 where
  blockResult :: Text -> FunctionResults e Block
blockResult = forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Block
pushBlock Text
"Block"
  blocksParam :: Parameter e [Block]
blocksParam = forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy Text
"Blocks" Text
"content" Text
"block content"
  blockItemsParam :: Text -> Parameter e [[Block]]
blockItemsParam = forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall {e}. LuaError e => StackIndex -> Peek e [[Block]]
peekItemsFuzzy Text
"List of Blocks" Text
"content"
  peekItemsFuzzy :: StackIndex -> Peek e [[Block]]
peekItemsFuzzy StackIndex
idx = forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy StackIndex
idx
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((forall a. a -> [a] -> [a]
:[]) forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy StackIndex
idx)

  optAttrParam :: Parameter e (Maybe Attr)
optAttrParam = forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Attr
peekAttr Text
"Attr" Text
"attr" Text
"additional attributes")


-- | Constructor for a list of `Block` values.
mkBlocks :: LuaError e => DocumentedFunction e
mkBlocks :: forall e. LuaError e => DocumentedFunction e
mkBlocks = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Blocks"
  ### liftPure id
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy Text
"Blocks" Text
"blocks" Text
"block elements"
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e [Block]
pushBlocks Text
"Blocks" Text
"list of block elements"

--
-- walk
--

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 = forall e a b.
(LuaError e, Data a, Walkable (SpliceList a) b) =>
Pusher e a -> Peeker e [a] -> Filter -> b -> LuaE e b
walkSplicing forall e. LuaError e => Pusher e Block
pushBlock 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 = forall e a b.
(LuaError e, Walkable a b) =>
Name -> Pusher e a -> Peeker e a -> Filter -> b -> LuaE e b
walkStraight Name
"Blocks" forall e. LuaError e => Pusher e [Block]
pushBlocks forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy