{-# 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
    typeBlock
  , 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.Aeson (encode)
import Data.Data (showConstr, toConstr)
import Data.Maybe (fromMaybe)
import Data.Proxy (Proxy (Proxy))
import Data.Text (Text)
import HsLua hiding (Div)
import Text.Pandoc.Lua.Marshal.Attr (peekAttr, pushAttr)
import Text.Pandoc.Lua.Marshal.Caption (peekCaptionFuzzy, pushCaption)
import Text.Pandoc.Lua.Marshal.Content
  ( Content (..), contentTypeDescription, peekContent, pushContent
  , peekDefinitionItem )
import Text.Pandoc.Lua.Marshal.Filter (Filter, peekFilter)
import Text.Pandoc.Lua.Marshal.Format (peekFormat, pushFormat)
import Text.Pandoc.Lua.Marshal.Inline (peekInlinesFuzzy)
import Text.Pandoc.Lua.Marshal.List (newListMetatable, pushPandocList)
import Text.Pandoc.Lua.Marshal.ListAttributes
  ( peekListAttributes, pushListAttributes )
import Text.Pandoc.Lua.Marshal.Shared (walkBlocksAndInlines)
import Text.Pandoc.Lua.Marshal.TableParts
  ( peekColSpec, pushColSpec
  , peekTableBody, pushTableBody
  , peekTableFoot, pushTableFoot
  , peekTableHead, pushTableHead
  )
import Text.Pandoc.Lua.Walk (SpliceList, Walkable, walkStraight, walkSplicing)
import Text.Pandoc.Definition

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

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

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

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

    Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
"clone"
    DocumentedFunction e -> LuaE e ()
forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction (DocumentedFunction e -> LuaE e ())
-> DocumentedFunction e -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ ([Block] -> LuaE e [Block])
-> HsFnPrecursor e ([Block] -> LuaE e [Block])
forall a e. a -> HsFnPrecursor e a
lambda
      ### return
      HsFnPrecursor e ([Block] -> LuaE e [Block])
-> Parameter e [Block] -> HsFnPrecursor e (LuaE e [Block])
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Block] -> TypeSpec -> Text -> Text -> Parameter e [Block]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy TypeSpec
"Blocks" Text
"self" Text
""
      HsFnPrecursor e (LuaE e [Block])
-> FunctionResults e [Block] -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> ([Block] -> LuaE e ())
-> TypeSpec -> Text -> FunctionResults e [Block]
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult [Block] -> LuaE e ()
forall e. LuaError e => Pusher e [Block]
pushBlocks TypeSpec
"Blocks" Text
"deep copy"
    StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)

    Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
"__tostring"
    DocumentedFunction e -> LuaE e ()
forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction (DocumentedFunction e -> LuaE e ())
-> DocumentedFunction e -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ ([Block] -> LuaE e String)
-> HsFnPrecursor e ([Block] -> LuaE e String)
forall a e. a -> HsFnPrecursor e a
lambda
      ### liftPure show
      HsFnPrecursor e ([Block] -> LuaE e String)
-> Parameter e [Block] -> HsFnPrecursor e (LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Block] -> TypeSpec -> Text -> Text -> Parameter e [Block]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy TypeSpec
"Blocks" Text
"self" Text
""
      HsFnPrecursor e (LuaE e String)
-> FunctionResults e String -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e String -> TypeSpec -> Text -> FunctionResults e String
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e String
forall e. String -> LuaE e ()
pushString TypeSpec
"string" Text
"native Haskell representation"
    StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)

    Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
"__tojson"
    DocumentedFunction e -> LuaE e ()
forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction (DocumentedFunction e -> LuaE e ())
-> DocumentedFunction e -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ ([Block] -> LuaE e ByteString)
-> HsFnPrecursor e ([Block] -> LuaE e ByteString)
forall a e. a -> HsFnPrecursor e a
lambda
      ### liftPure encode
      HsFnPrecursor e ([Block] -> LuaE e ByteString)
-> Parameter e [Block] -> HsFnPrecursor e (LuaE e ByteString)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Block] -> TypeSpec -> Text -> Text -> Parameter e [Block]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy TypeSpec
"Blocks" Text
"self" Text
""
      HsFnPrecursor e (LuaE e ByteString)
-> FunctionResults e ByteString -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e ByteString
-> TypeSpec -> Text -> FunctionResults e ByteString
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e ByteString
forall e. Pusher e ByteString
pushLazyByteString TypeSpec
"string" Text
"JSON representation"
    StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
  StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth CInt
2)
{-# INLINABLE pushBlocks #-}

-- | Unmarshal a table as Block value by calling the @__toblock@ metamethod
-- first.
peekBlockMetamethod :: LuaError e
                    => Peeker e Block
peekBlockMetamethod :: forall e. LuaError e => Peeker e Block
peekBlockMetamethod StackIndex
idx = do
  absidx <- LuaE e StackIndex -> Peek e StackIndex
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e StackIndex -> Peek e StackIndex)
-> LuaE e StackIndex -> Peek e StackIndex
forall a b. (a -> b) -> a -> b
$ StackIndex -> LuaE e StackIndex
forall e. StackIndex -> LuaE e StackIndex
absindex StackIndex
idx
  liftLua (getmetafield absidx "__toblock") >>= \case
    Type
TypeNil      -> ByteString -> Peek e Block
forall a e. ByteString -> Peek e a
failPeek ByteString
"object has no __toblock metamethod"
    Type
TypeFunction -> do
      LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
pushvalue StackIndex
absidx)
      LuaE e Status -> Peek e Status
forall e a. LuaE e a -> Peek e a
liftLua (NumArgs -> NumResults -> Maybe StackIndex -> LuaE e Status
forall e.
NumArgs -> NumResults -> Maybe StackIndex -> LuaE e Status
pcall NumArgs
1 NumResults
1 Maybe StackIndex
forall a. Maybe a
Nothing) Peek e Status -> (Status -> Peek e Block) -> Peek e Block
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Status
OK   -> Peeker e Block
forall e. LuaError e => Peeker e Block
peekBlock StackIndex
top Peek e Block -> LuaE e () -> Peek e Block
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1
        Status
_err -> do
          msg <- Peeker e ByteString
forall e. Peeker e ByteString
peekByteString StackIndex
top Peek e ByteString -> LuaE e () -> Peek e ByteString
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1
          failPeek $ "failure in __toblock: " <> msg
    Type
_otherType   -> do
      LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1)   -- drop "__toblock" field
      ByteString -> Peek e Block
forall a e. ByteString -> Peek e a
failPeek ByteString
"__toblock metafield does not contain a function"

-- | Try extra hard to retrieve a 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 =
       Peeker e Block
forall e. LuaError e => Peeker e Block
peekBlock StackIndex
idx
  Peek e Block -> Peek e Block -> Peek e Block
forall a. Peek e a -> Peek e a -> Peek e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Peeker e Block
forall e. LuaError e => Peeker e Block
peekBlockMetamethod StackIndex
idx
  Peek e Block -> Peek e Block -> Peek e Block
forall a. Peek e a -> Peek e a -> Peek e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Inline] -> Block
Plain ([Inline] -> Block) -> Peek e [Inline] -> Peek e Block
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy StackIndex
idx)
  Peek e Block -> Peek e Block -> Peek e Block
forall a. Peek e a -> Peek e a -> Peek e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Peek e Block
forall a e. ByteString -> Peek e a
failPeek (ByteString -> Peek e Block) -> Peek e ByteString -> Peek e Block
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
       Name -> StackIndex -> Peek e ByteString
forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"Block or list of Inlines" StackIndex
idx)
{-# INLINABLE peekBlockFuzzy #-}

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

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

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

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

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

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

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

getBlockContent :: Block -> Possible Content
getBlockContent :: Block -> Possible Content
getBlockContent = \case
  -- inline content
  Para [Inline]
inlns          -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
  Plain [Inline]
inlns         -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
  Header Int
_ Attr
_ [Inline]
inlns    -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Inline] -> Content
ContentInlines [Inline]
inlns
  -- block content
  BlockQuote [Block]
blks     -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Block] -> Content
ContentBlocks [Block]
blks
  Div Attr
_ [Block]
blks          -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Block] -> Content
ContentBlocks [Block]
blks
  Figure Attr
_ Caption
_ [Block]
blks     -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [Block] -> Content
ContentBlocks [Block]
blks
  -- lines content
  LineBlock [[Inline]]
lns       -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Content
ContentLines [[Inline]]
lns
  -- list items content
  BulletList [[Block]]
itms     -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [[Block]] -> Content
ContentListItems [[Block]]
itms
  OrderedList ListAttributes
_ [[Block]]
itms  -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [[Block]] -> Content
ContentListItems [[Block]]
itms
  -- definition items content
  DefinitionList [([Inline], [[Block]])]
itms -> Content -> Possible Content
forall a. a -> Possible a
Actual (Content -> Possible Content) -> Content -> Possible Content
forall a b. (a -> b) -> a -> b
$ [([Inline], [[Block]])] -> Content
ContentDefItems [([Inline], [[Block]])]
itms
  Block
_                   -> Possible Content
forall a. Possible a
Absent

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

getBlockText :: Block -> Possible Text
getBlockText :: Block -> Possible Text
getBlockText = \case
  CodeBlock Attr
_ Text
lst -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
lst
  RawBlock Format
_ Text
raw  -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
raw
  Block
_               -> Possible Text
forall a. Possible a
Absent

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

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

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

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

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

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

  , Name
-> ([Block] -> Maybe Caption -> Maybe Attr -> LuaE e Block)
-> HsFnPrecursor
     e ([Block] -> Maybe Caption -> Maybe Attr -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Figure"
    ### liftPure3 (\content mcapt mattr ->
                     let attr = fromMaybe nullAttr mattr
                         capt = fromMaybe (Caption mempty mempty) mcapt
                     in Figure attr capt content)
    HsFnPrecursor
  e ([Block] -> Maybe Caption -> Maybe Attr -> LuaE e Block)
-> Parameter e [Block]
-> HsFnPrecursor e (Maybe Caption -> Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Block] -> TypeSpec -> Text -> Text -> Parameter e [Block]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy TypeSpec
"Blocks" Text
"content" Text
"figure block content"
    HsFnPrecursor e (Maybe Caption -> Maybe Attr -> LuaE e Block)
-> Parameter e (Maybe Caption)
-> HsFnPrecursor e (Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e Caption -> Parameter e (Maybe Caption)
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Peeker e Caption -> TypeSpec -> Text -> Text -> Parameter e Caption
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e Caption
forall e. LuaError e => Peeker e Caption
peekCaptionFuzzy TypeSpec
"Caption" Text
"caption" Text
"figure caption")
    HsFnPrecursor e (Maybe Attr -> LuaE e Block)
-> Parameter e (Maybe Attr) -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e (Maybe Attr)
optAttrParam
    HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"Figure object"
    #? "Creates a [[Figure]] element."

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

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

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

  , Name
-> ([[Block]] -> Maybe ListAttributes -> LuaE e Block)
-> HsFnPrecursor
     e ([[Block]] -> Maybe ListAttributes -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"OrderedList"
    ### liftPure2 (\items mListAttrib ->
                     let defListAttrib = (1, DefaultStyle, DefaultDelim)
                     in OrderedList (fromMaybe defListAttrib mListAttrib) items)
    HsFnPrecursor e ([[Block]] -> Maybe ListAttributes -> LuaE e Block)
-> Parameter e [[Block]]
-> HsFnPrecursor e (Maybe ListAttributes -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Text -> Parameter e [[Block]]
blockItemsParam Text
"list items"
    HsFnPrecursor e (Maybe ListAttributes -> LuaE e Block)
-> Parameter e (Maybe ListAttributes)
-> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e ListAttributes -> Parameter e (Maybe ListAttributes)
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Peeker e ListAttributes
-> TypeSpec -> Text -> Text -> Parameter e ListAttributes
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e ListAttributes
forall e. LuaError e => Peeker e ListAttributes
peekListAttributes TypeSpec
"ListAttributes" Text
"listAttributes"
                       Text
"list parameters")
    HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"OrderedList element"
    #? "Creates an ordered list."

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

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

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

  , Name
-> (Caption
    -> [ColSpec]
    -> TableHead
    -> [TableBody]
    -> TableFoot
    -> Maybe Attr
    -> LuaE e Block)
-> HsFnPrecursor
     e
     (Caption
      -> [ColSpec]
      -> TableHead
      -> [TableBody]
      -> TableFoot
      -> Maybe Attr
      -> LuaE e Block)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Table"
    ### (\capt colspecs thead tbodies tfoot mattr ->
           let attr = fromMaybe nullAttr mattr
           in return $! attr `seq` capt `seq` colspecs `seq` thead `seq` tbodies
              `seq` tfoot `seq` Table attr capt colspecs thead tbodies tfoot)
    HsFnPrecursor
  e
  (Caption
   -> [ColSpec]
   -> TableHead
   -> [TableBody]
   -> TableFoot
   -> Maybe Attr
   -> LuaE e Block)
-> Parameter e Caption
-> HsFnPrecursor
     e
     ([ColSpec]
      -> TableHead
      -> [TableBody]
      -> TableFoot
      -> Maybe Attr
      -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Caption -> TypeSpec -> Text -> Text -> Parameter e Caption
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e Caption
forall e. LuaError e => Peeker e Caption
peekCaptionFuzzy TypeSpec
"Caption" Text
"caption" Text
"table caption"
    HsFnPrecursor
  e
  ([ColSpec]
   -> TableHead
   -> [TableBody]
   -> TableFoot
   -> Maybe Attr
   -> LuaE e Block)
-> Parameter e [ColSpec]
-> HsFnPrecursor
     e
     (TableHead
      -> [TableBody] -> TableFoot -> Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [ColSpec]
-> TypeSpec -> Text -> Text -> Parameter e [ColSpec]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (Peeker e ColSpec -> Peeker e [ColSpec]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e ColSpec
forall e. LuaError e => Peeker e ColSpec
peekColSpec) TypeSpec
"{ColSpec,...}" Text
"colspecs"
                  Text
"column alignments and widths"
    HsFnPrecursor
  e
  (TableHead
   -> [TableBody] -> TableFoot -> Maybe Attr -> LuaE e Block)
-> Parameter e TableHead
-> HsFnPrecursor
     e ([TableBody] -> TableFoot -> Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e TableHead
-> TypeSpec -> Text -> Text -> Parameter e TableHead
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e TableHead
forall e. LuaError e => Peeker e TableHead
peekTableHead TypeSpec
"TableHead" Text
"head" Text
"table head"
    HsFnPrecursor
  e ([TableBody] -> TableFoot -> Maybe Attr -> LuaE e Block)
-> Parameter e [TableBody]
-> HsFnPrecursor e (TableFoot -> Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [TableBody]
-> TypeSpec -> Text -> Text -> Parameter e [TableBody]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (Peeker e TableBody -> Peeker e [TableBody]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e TableBody
forall e. LuaError e => Peeker e TableBody
peekTableBody) TypeSpec
"{TableBody,...}" Text
"bodies"
                  Text
"table bodies"
    HsFnPrecursor e (TableFoot -> Maybe Attr -> LuaE e Block)
-> Parameter e TableFoot
-> HsFnPrecursor e (Maybe Attr -> LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e TableFoot
-> TypeSpec -> Text -> Text -> Parameter e TableFoot
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e TableFoot
forall e. LuaError e => Peeker e TableFoot
peekTableFoot TypeSpec
"TableFoot" Text
"foot" Text
"table foot"
    HsFnPrecursor e (Maybe Attr -> LuaE e Block)
-> Parameter e (Maybe Attr) -> HsFnPrecursor e (LuaE e Block)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e (Maybe Attr)
optAttrParam
    HsFnPrecursor e (LuaE e Block)
-> FunctionResults e Block -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Block
blockResult Text
"Table element"
    #? "Creates a table element."
  ]
 where
  blockResult :: Text -> FunctionResults e Block
blockResult = Pusher e Block -> TypeSpec -> Text -> FunctionResults e Block
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e Block
forall e. LuaError e => Pusher e Block
pushBlock TypeSpec
"Block"
  blocksParam :: Parameter e [Block]
blocksParam = Peeker e [Block] -> TypeSpec -> Text -> Text -> Parameter e [Block]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy TypeSpec
"Blocks" Text
"content" Text
"block content"
  blockItemsParam :: Text -> Parameter e [[Block]]
blockItemsParam = Peeker e [[Block]]
-> TypeSpec -> Text -> Text -> Parameter e [[Block]]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [[Block]]
forall {e}. LuaError e => StackIndex -> Peek e [[Block]]
peekItemsFuzzy TypeSpec
"{Blocks,...}" Text
"items"
  peekItemsFuzzy :: StackIndex -> Peek e [[Block]]
peekItemsFuzzy StackIndex
idx = Peeker e [Block] -> StackIndex -> Peek e [[Block]]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy StackIndex
idx
    Peek e [[Block]] -> Peek e [[Block]] -> Peek e [[Block]]
forall a. Peek e a -> Peek e a -> Peek e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (([Block] -> [[Block]] -> [[Block]]
forall a. a -> [a] -> [a]
:[]) ([Block] -> [[Block]]) -> Peek e [Block] -> Peek e [[Block]]
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy StackIndex
idx)

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


-- | Constructor for a list of `Block` values.
mkBlocks :: LuaError e => DocumentedFunction e
mkBlocks :: forall e. LuaError e => DocumentedFunction e
mkBlocks = Name
-> ([Block] -> LuaE e [Block])
-> HsFnPrecursor e ([Block] -> LuaE e [Block])
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Blocks"
  ### liftPure id
  HsFnPrecursor e ([Block] -> LuaE e [Block])
-> Parameter e [Block] -> HsFnPrecursor e (LuaE e [Block])
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Block] -> TypeSpec -> Text -> Text -> Parameter e [Block]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy TypeSpec
"Blocks" Text
"block_like_elements"
      (Text
"List where each element can be treated as a [[Block]] value, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
       Text
"or a single such value.")
  HsFnPrecursor e (LuaE e [Block])
-> FunctionResults e [Block] -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e [Block] -> TypeSpec -> Text -> FunctionResults e [Block]
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e [Block]
forall e. LuaError e => Pusher e [Block]
pushBlocks TypeSpec
"Blocks" Text
"list of block elements"
  #? "Creates a [[Blocks]] list."

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

walkBlocksStraight :: (LuaError e, Walkable [Block] a)
                   => Filter -> a -> LuaE e a
walkBlocksStraight :: forall e a.
(LuaError e, Walkable [Block] a) =>
Filter -> a -> LuaE e a
walkBlocksStraight = Name
-> Pusher e [Block] -> Peeker e [Block] -> Filter -> a -> LuaE e a
forall e a b.
(LuaError e, Walkable a b) =>
Name -> Pusher e a -> Peeker e a -> Filter -> b -> LuaE e b
walkStraight Name
"Blocks" Pusher e [Block]
forall e. LuaError e => Pusher e [Block]
pushBlocks Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy