{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
module Text.Pandoc.Lua.Marshaling.AST
( peekAttr
, peekBlock
, peekBlocks
, peekCaption
, peekCitation
, peekFormat
, peekInline
, peekInlines
, peekListAttributes
, peekMeta
, peekMetaValue
, peekPandoc
, peekMathType
, peekQuoteType
, peekFuzzyInlines
, peekFuzzyBlocks
, pushAttr
, pushBlock
, pushInline
, pushListAttributes
, pushMetaValue
, pushPandoc
) where
import Control.Applicative ((<|>), optional)
import Control.Monad.Catch (throwM)
import Control.Monad ((<$!>), (>=>))
import Data.Data (showConstr, toConstr)
import Data.Text (Text)
import Data.Version (Version)
import HsLua hiding (Operation (Div))
import HsLua.Module.Version (peekVersionFuzzy)
import Text.Pandoc.Definition
import Text.Pandoc.Error (PandocError (PandocLuaError))
import Text.Pandoc.Lua.Util (pushViaConstr', pushViaConstructor)
import Text.Pandoc.Lua.Marshaling.Attr (peekAttr, pushAttr)
import Text.Pandoc.Lua.Marshaling.List (pushPandocList)
import qualified HsLua as Lua
import qualified Text.Pandoc.Lua.Util as LuaUtil
instance Pushable Pandoc where
push :: Pandoc -> LuaE e ()
push = Pandoc -> LuaE e ()
forall e. LuaError e => Pandoc -> LuaE e ()
pushPandoc
pushPandoc :: LuaError e => Pusher e Pandoc
pushPandoc :: Pusher e Pandoc
pushPandoc = UDTypeWithList e (DocumentedFunction e) Pandoc Void
-> Pusher e Pandoc
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD UDTypeWithList e (DocumentedFunction e) Pandoc Void
forall e. LuaError e => DocumentedType e Pandoc
typePandoc
peekPandoc :: LuaError e => Peeker e Pandoc
peekPandoc :: Peeker e Pandoc
peekPandoc = Name -> Peek e Pandoc -> Peek e Pandoc
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Pandoc value" (Peek e Pandoc -> Peek e Pandoc)
-> Peeker e Pandoc -> Peeker e Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UDTypeWithList e (DocumentedFunction e) Pandoc Void
-> Peeker e Pandoc
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD UDTypeWithList e (DocumentedFunction e) Pandoc Void
forall e. LuaError e => DocumentedType e Pandoc
typePandoc
typePandoc :: LuaError e => DocumentedType e Pandoc
typePandoc :: DocumentedType e Pandoc
typePandoc = Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) Pandoc]
-> DocumentedType e Pandoc
forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"Pandoc"
[ 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
$ Name
-> (Maybe Pandoc -> Maybe Pandoc -> LuaE e Bool)
-> HsFnPrecursor e (Maybe Pandoc -> Maybe Pandoc -> LuaE e Bool)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"__eq"
### liftPure2 (==)
HsFnPrecursor e (Maybe Pandoc -> Maybe Pandoc -> LuaE e Bool)
-> Parameter e (Maybe Pandoc)
-> HsFnPrecursor e (Maybe Pandoc -> LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e (Maybe Pandoc)
-> Text -> Text -> Text -> Parameter e (Maybe Pandoc)
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (Peek e Pandoc -> Peek e (Maybe Pandoc)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e Pandoc -> Peek e (Maybe Pandoc))
-> (StackIndex -> Peek e Pandoc) -> Peeker e (Maybe Pandoc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Pandoc
forall e. LuaError e => Peeker e Pandoc
peekPandoc) Text
"doc1" Text
"pandoc" Text
""
HsFnPrecursor e (Maybe Pandoc -> LuaE e Bool)
-> Parameter e (Maybe Pandoc) -> HsFnPrecursor e (LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e (Maybe Pandoc)
-> Text -> Text -> Text -> Parameter e (Maybe Pandoc)
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (Peek e Pandoc -> Peek e (Maybe Pandoc)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e Pandoc -> Peek e (Maybe Pandoc))
-> (StackIndex -> Peek e Pandoc) -> Peeker e (Maybe Pandoc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Pandoc
forall e. LuaError e => Peeker e Pandoc
peekPandoc) Text
"doc2" Text
"pandoc" Text
""
HsFnPrecursor e (LuaE e Bool)
-> FunctionResults e Bool -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Bool -> Text -> Text -> FunctionResults e Bool
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Bool
forall e. Pusher e Bool
pushBool Text
"boolean" Text
"true iff the two values are equal"
]
[ Name
-> Text
-> (Pusher e [Block], Pandoc -> [Block])
-> (Peeker e [Block], Pandoc -> [Block] -> Pandoc)
-> Member e (DocumentedFunction e) Pandoc
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"blocks" Text
"list of blocks"
(Pusher e Block -> Pusher e [Block]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Block
forall e. LuaError e => Block -> LuaE e ()
pushBlock, \(Pandoc Meta
_ [Block]
blks) -> [Block]
blks)
(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, \(Pandoc Meta
m [Block]
_) [Block]
blks -> Meta -> [Block] -> Pandoc
Pandoc Meta
m [Block]
blks)
, Name
-> Text
-> (Pusher e Meta, Pandoc -> Meta)
-> (Peeker e Meta, Pandoc -> Meta -> Pandoc)
-> Member e (DocumentedFunction e) Pandoc
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"meta" Text
"document metadata"
(Pusher e Meta
forall e. LuaError e => Pusher e Meta
pushMeta, \(Pandoc Meta
meta [Block]
_) -> Meta
meta)
(Peeker e Meta
forall e. LuaError e => Peeker e Meta
peekMeta, \(Pandoc Meta
_ [Block]
blks) Meta
meta -> Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
blks)
]
instance Pushable Meta where
push :: Meta -> LuaE e ()
push = Meta -> LuaE e ()
forall e. LuaError e => Pusher e Meta
pushMeta
pushMeta :: LuaError e => Pusher e Meta
pushMeta :: Pusher e Meta
pushMeta (Meta Map Text MetaValue
mmap) = Name -> [LuaE e ()] -> LuaE e ()
forall e. LuaError e => Name -> [LuaE e ()] -> LuaE e ()
pushViaConstr' Name
"Meta" [Map Text MetaValue -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push Map Text MetaValue
mmap]
peekMeta :: LuaError e => Peeker e Meta
peekMeta :: Peeker e Meta
peekMeta StackIndex
idx = Name -> Peek e Meta -> Peek e Meta
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Meta" (Peek e Meta -> Peek e Meta) -> Peek e Meta -> Peek e Meta
forall a b. (a -> b) -> a -> b
$
Map Text MetaValue -> Meta
Meta (Map Text MetaValue -> Meta)
-> Peek e (Map Text MetaValue) -> Peek e Meta
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Text
-> Peeker e MetaValue -> Peeker e (Map Text MetaValue)
forall a e b.
Ord a =>
Peeker e a -> Peeker e b -> Peeker e (Map a b)
peekMap Peeker e Text
forall e. Peeker e Text
peekText Peeker e MetaValue
forall e. LuaError e => Peeker e MetaValue
peekMetaValue StackIndex
idx
instance Pushable MetaValue where
push :: MetaValue -> LuaE e ()
push = MetaValue -> LuaE e ()
forall e. LuaError e => MetaValue -> LuaE e ()
pushMetaValue
instance Pushable Block where
push :: Block -> LuaE e ()
push = Block -> LuaE e ()
forall e. LuaError e => Block -> LuaE e ()
pushBlock
instance Pushable Inline where
push :: Inline -> LuaE e ()
push = Inline -> LuaE e ()
forall e. LuaError e => Inline -> LuaE e ()
pushInline
instance Pushable Citation where
push :: Citation -> LuaE e ()
push = Citation -> LuaE e ()
forall e. LuaError e => Citation -> LuaE e ()
pushCitation
pushCitation :: LuaError e => Pusher e Citation
pushCitation :: Pusher e Citation
pushCitation (Citation Text
cid [Inline]
prefix [Inline]
suffix CitationMode
mode Int
noteNum Int
hash) =
Name -> [LuaE e ()] -> LuaE e ()
forall e. LuaError e => Name -> [LuaE e ()] -> LuaE e ()
pushViaConstr' Name
"Citation"
[ Text -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push Text
cid, CitationMode -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push CitationMode
mode, [Inline] -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push [Inline]
prefix, [Inline] -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push [Inline]
suffix, Int -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push Int
noteNum, Int -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push Int
hash
]
peekCitation :: LuaError e => Peeker e Citation
peekCitation :: Peeker e Citation
peekCitation = (Peek e Citation -> Peek e Citation)
-> Peeker e Citation -> Peeker e Citation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name -> Peek e Citation -> Peek e Citation
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Citation")
(Peeker e Citation -> Peeker e Citation)
-> (Peeker e Citation -> Peeker e Citation)
-> Peeker e Citation
-> Peeker e Citation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name
-> (StackIndex -> LuaE e Bool)
-> Peeker e Citation
-> Peeker e Citation
forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"table" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
Lua.istable (Peeker e Citation -> Peeker e Citation)
-> Peeker e Citation -> Peeker e Citation
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx -> do
StackIndex
idx' <- 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
Text
-> [Inline] -> [Inline] -> CitationMode -> Int -> Int -> Citation
Citation
(Text
-> [Inline] -> [Inline] -> CitationMode -> Int -> Int -> Citation)
-> Peek e Text
-> Peek
e ([Inline] -> [Inline] -> CitationMode -> Int -> Int -> Citation)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Text -> Name -> Peeker e Text
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e Text
forall e. Peeker e Text
peekText Name
"id" StackIndex
idx'
Peek
e ([Inline] -> [Inline] -> CitationMode -> Int -> Int -> Citation)
-> Peek e [Inline]
-> Peek e ([Inline] -> CitationMode -> Int -> Int -> Citation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Peeker e [Inline] -> Name -> Peeker e [Inline]
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (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
peekInline) Name
"prefix" StackIndex
idx'
Peek e ([Inline] -> CitationMode -> Int -> Int -> Citation)
-> Peek e [Inline]
-> Peek e (CitationMode -> Int -> Int -> Citation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Peeker e [Inline] -> Name -> Peeker e [Inline]
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (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
peekInline) Name
"suffix" StackIndex
idx'
Peek e (CitationMode -> Int -> Int -> Citation)
-> Peek e CitationMode -> Peek e (Int -> Int -> Citation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Peeker e CitationMode -> Name -> Peeker e CitationMode
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e CitationMode
forall a e. Read a => Peeker e a
peekRead Name
"mode" StackIndex
idx'
Peek e (Int -> Int -> Citation)
-> Peek e Int -> Peek e (Int -> Citation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Peeker e Int -> Name -> Peeker e Int
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral Name
"note_num" StackIndex
idx'
Peek e (Int -> Citation) -> Peek e Int -> Peek e Citation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Peeker e Int -> Name -> Peeker e Int
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral Name
"hash" StackIndex
idx'
instance Pushable Alignment where
push :: Alignment -> LuaE e ()
push = String -> LuaE e ()
forall e. String -> LuaE e ()
Lua.pushString (String -> LuaE e ())
-> (Alignment -> String) -> Alignment -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> String
forall a. Show a => a -> String
show
instance Pushable CitationMode where
push :: CitationMode -> LuaE e ()
push = String -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (String -> LuaE e ())
-> (CitationMode -> String) -> CitationMode -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CitationMode -> String
forall a. Show a => a -> String
show
instance Pushable Format where
push :: Format -> LuaE e ()
push = Format -> LuaE e ()
forall e. LuaError e => Format -> LuaE e ()
pushFormat
pushFormat :: LuaError e => Pusher e Format
pushFormat :: Pusher e Format
pushFormat (Format Text
f) = Pusher e Text
forall e. Pusher e Text
pushText Text
f
peekFormat :: LuaError e => Peeker e Format
peekFormat :: Peeker e Format
peekFormat StackIndex
idx = Text -> Format
Format (Text -> Format) -> Peek e Text -> Peek e Format
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Text
forall e. Peeker e Text
peekText StackIndex
idx
instance Pushable ListNumberDelim where
push :: ListNumberDelim -> LuaE e ()
push = String -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (String -> LuaE e ())
-> (ListNumberDelim -> String) -> ListNumberDelim -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListNumberDelim -> String
forall a. Show a => a -> String
show
instance Pushable ListNumberStyle where
push :: ListNumberStyle -> LuaE e ()
push = String -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (String -> LuaE e ())
-> (ListNumberStyle -> String) -> ListNumberStyle -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListNumberStyle -> String
forall a. Show a => a -> String
show
instance Pushable MathType where
push :: MathType -> LuaE e ()
push = String -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (String -> LuaE e ())
-> (MathType -> String) -> MathType -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MathType -> String
forall a. Show a => a -> String
show
instance Pushable QuoteType where
push :: QuoteType -> LuaE e ()
push = QuoteType -> LuaE e ()
forall e. LuaError e => QuoteType -> LuaE e ()
pushQuoteType
pushMathType :: LuaError e => Pusher e MathType
pushMathType :: Pusher e MathType
pushMathType = String -> LuaE e ()
forall e. String -> LuaE e ()
pushString (String -> LuaE e ()) -> (MathType -> String) -> Pusher e MathType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MathType -> String
forall a. Show a => a -> String
show
peekMathType :: LuaError e => Peeker e MathType
peekMathType :: Peeker e MathType
peekMathType = Peeker e MathType
forall a e. Read a => Peeker e a
peekRead
pushQuoteType :: LuaError e => Pusher e QuoteType
pushQuoteType :: Pusher e QuoteType
pushQuoteType = String -> LuaE e ()
forall e. String -> LuaE e ()
pushString (String -> LuaE e ())
-> (QuoteType -> String) -> Pusher e QuoteType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuoteType -> String
forall a. Show a => a -> String
show
peekQuoteType :: LuaError e => Peeker e QuoteType
peekQuoteType :: Peeker e QuoteType
peekQuoteType = Peeker e QuoteType
forall a e. Read a => Peeker e a
peekRead
pushMetaValue :: LuaError e => MetaValue -> LuaE e ()
pushMetaValue :: MetaValue -> LuaE e ()
pushMetaValue = \case
MetaBlocks [Block]
blcks -> Name -> [LuaE e ()] -> LuaE e ()
forall e. LuaError e => Name -> [LuaE e ()] -> LuaE e ()
pushViaConstr' Name
"MetaBlocks" [Pusher e Block -> [Block] -> LuaE e ()
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushList Pusher e Block
forall e. LuaError e => Block -> LuaE e ()
pushBlock [Block]
blcks]
MetaBool Bool
bool -> Bool -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push Bool
bool
MetaInlines [Inline]
inlns -> Name -> [LuaE e ()] -> LuaE e ()
forall e. LuaError e => Name -> [LuaE e ()] -> LuaE e ()
pushViaConstr' Name
"MetaInlines"
[Pusher e Inline -> [Inline] -> LuaE e ()
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushList Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline [Inline]
inlns]
MetaList [MetaValue]
metalist -> Name -> [LuaE e ()] -> LuaE e ()
forall e. LuaError e => Name -> [LuaE e ()] -> LuaE e ()
pushViaConstr' Name
"MetaList"
[(MetaValue -> LuaE e ()) -> [MetaValue] -> LuaE e ()
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushList MetaValue -> LuaE e ()
forall e. LuaError e => MetaValue -> LuaE e ()
pushMetaValue [MetaValue]
metalist]
MetaMap Map Text MetaValue
metamap -> Name -> [LuaE e ()] -> LuaE e ()
forall e. LuaError e => Name -> [LuaE e ()] -> LuaE e ()
pushViaConstr' Name
"MetaMap"
[Pusher e Text
-> (MetaValue -> LuaE e ()) -> Pusher e (Map Text MetaValue)
forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> Pusher e (Map a b)
pushMap Pusher e Text
forall e. Pusher e Text
pushText MetaValue -> LuaE e ()
forall e. LuaError e => MetaValue -> LuaE e ()
pushMetaValue Map Text MetaValue
metamap]
MetaString Text
str -> Pusher e Text
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push Text
str
peekMetaValue :: forall e. LuaError e => Peeker e MetaValue
peekMetaValue :: Peeker e MetaValue
peekMetaValue = Name -> Peek e MetaValue -> Peek e MetaValue
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"MetaValue $ " (Peek e MetaValue -> Peek e MetaValue)
-> Peeker e MetaValue -> Peeker e MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \StackIndex
idx -> do
let mkMV :: (a -> MetaValue) -> Peeker e a -> Peek e MetaValue
mkMV :: (a -> MetaValue) -> Peeker e a -> Peek e MetaValue
mkMV a -> MetaValue
f Peeker e a
p = a -> MetaValue
f (a -> MetaValue) -> Peek e a -> Peek e MetaValue
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e a
p StackIndex
idx
peekTagged :: Name -> Peek e MetaValue
peekTagged = \case
Name
"MetaBlocks" -> ([Block] -> MetaValue) -> Peeker e [Block] -> Peek e MetaValue
forall a. (a -> MetaValue) -> Peeker e a -> Peek e MetaValue
mkMV [Block] -> MetaValue
MetaBlocks (Peeker e [Block] -> Peek e MetaValue)
-> Peeker e [Block] -> Peek e MetaValue
forall a b. (a -> b) -> a -> b
$
Name -> Peek e [Block] -> Peek e [Block]
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"MetaBlocks" (Peek e [Block] -> Peek e [Block])
-> Peeker e [Block] -> Peeker e [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocks
Name
"MetaBool" -> (Bool -> MetaValue) -> Peeker e Bool -> Peek e MetaValue
forall a. (a -> MetaValue) -> Peeker e a -> Peek e MetaValue
mkMV Bool -> MetaValue
MetaBool (Peeker e Bool -> Peek e MetaValue)
-> Peeker e Bool -> Peek e MetaValue
forall a b. (a -> b) -> a -> b
$
Name -> Peek e Bool -> Peek e Bool
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"MetaBool" (Peek e Bool -> Peek e Bool) -> Peeker e Bool -> Peeker e Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e Bool
forall e. Peeker e Bool
peekBool
Name
"MetaMap" -> (Map Text MetaValue -> MetaValue)
-> Peeker e (Map Text MetaValue) -> Peek e MetaValue
forall a. (a -> MetaValue) -> Peeker e a -> Peek e MetaValue
mkMV Map Text MetaValue -> MetaValue
MetaMap (Peeker e (Map Text MetaValue) -> Peek e MetaValue)
-> Peeker e (Map Text MetaValue) -> Peek e MetaValue
forall a b. (a -> b) -> a -> b
$
Name -> Peek e (Map Text MetaValue) -> Peek e (Map Text MetaValue)
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"MetaMap" (Peek e (Map Text MetaValue) -> Peek e (Map Text MetaValue))
-> Peeker e (Map Text MetaValue) -> Peeker e (Map Text MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e Text
-> Peeker e MetaValue -> Peeker e (Map Text MetaValue)
forall a e b.
Ord a =>
Peeker e a -> Peeker e b -> Peeker e (Map a b)
peekMap Peeker e Text
forall e. Peeker e Text
peekText Peeker e MetaValue
forall e. LuaError e => Peeker e MetaValue
peekMetaValue
Name
"MetaInlines" -> ([Inline] -> MetaValue) -> Peeker e [Inline] -> Peek e MetaValue
forall a. (a -> MetaValue) -> Peeker e a -> Peek e MetaValue
mkMV [Inline] -> MetaValue
MetaInlines (Peeker e [Inline] -> Peek e MetaValue)
-> Peeker e [Inline] -> Peek e MetaValue
forall a b. (a -> b) -> a -> b
$
Name -> Peek e [Inline] -> Peek e [Inline]
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"MetaInlines" (Peek e [Inline] -> Peek e [Inline])
-> Peeker e [Inline] -> Peeker e [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlines
Name
"MetaList" -> ([MetaValue] -> MetaValue)
-> Peeker e [MetaValue] -> Peek e MetaValue
forall a. (a -> MetaValue) -> Peeker e a -> Peek e MetaValue
mkMV [MetaValue] -> MetaValue
MetaList (Peeker e [MetaValue] -> Peek e MetaValue)
-> Peeker e [MetaValue] -> Peek e MetaValue
forall a b. (a -> b) -> a -> b
$
Name -> Peek e [MetaValue] -> Peek e [MetaValue]
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"MetaList" (Peek e [MetaValue] -> Peek e [MetaValue])
-> Peeker e [MetaValue] -> Peeker e [MetaValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e MetaValue -> Peeker e [MetaValue]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e MetaValue
forall e. LuaError e => Peeker e MetaValue
peekMetaValue
Name
"MetaString" -> (Text -> MetaValue) -> Peeker e Text -> Peek e MetaValue
forall a. (a -> MetaValue) -> Peeker e a -> Peek e MetaValue
mkMV Text -> MetaValue
MetaString (Peeker e Text -> Peek e MetaValue)
-> Peeker e Text -> Peek e MetaValue
forall a b. (a -> b) -> a -> b
$
Name -> Peek e Text -> Peek e Text
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"MetaString" (Peek e Text -> Peek e Text) -> Peeker e Text -> Peeker e Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e Text
forall e. Peeker e Text
peekText
(Name ByteString
t) -> ByteString -> Peek e MetaValue
forall a e. ByteString -> Peek e a
failPeek (ByteString
"Unknown meta tag: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
t)
peekUntagged :: Peek e MetaValue
peekUntagged = do
Int
len <- LuaE e Int -> Peek e Int
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e Int -> Peek e Int) -> LuaE e Int -> Peek e Int
forall a b. (a -> b) -> a -> b
$ StackIndex -> LuaE e Int
forall e. StackIndex -> LuaE e Int
Lua.rawlen StackIndex
idx
if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then Map Text MetaValue -> MetaValue
MetaMap (Map Text MetaValue -> MetaValue)
-> Peek e (Map Text MetaValue) -> Peek e MetaValue
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Text
-> Peeker e MetaValue -> Peeker e (Map Text MetaValue)
forall a e b.
Ord a =>
Peeker e a -> Peeker e b -> Peeker e (Map a b)
peekMap Peeker e Text
forall e. Peeker e Text
peekText Peeker e MetaValue
forall e. LuaError e => Peeker e MetaValue
peekMetaValue StackIndex
idx
else ([Inline] -> MetaValue
MetaInlines ([Inline] -> MetaValue) -> Peek e [Inline] -> Peek e MetaValue
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlines StackIndex
idx)
Peek e MetaValue -> Peek e MetaValue -> Peek e MetaValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Block] -> MetaValue
MetaBlocks ([Block] -> MetaValue) -> Peek e [Block] -> Peek e MetaValue
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocks StackIndex
idx)
Peek e MetaValue -> Peek e MetaValue -> Peek e MetaValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([MetaValue] -> MetaValue
MetaList ([MetaValue] -> MetaValue)
-> Peek e [MetaValue] -> Peek e MetaValue
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e MetaValue -> Peeker e [MetaValue]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e MetaValue
forall e. LuaError e => Peeker e MetaValue
peekMetaValue StackIndex
idx)
Type
luatype <- LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e Type -> Peek e Type) -> LuaE e Type -> Peek e Type
forall a b. (a -> b) -> a -> b
$ StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
Lua.ltype StackIndex
idx
case Type
luatype of
Type
Lua.TypeBoolean -> Bool -> MetaValue
MetaBool (Bool -> MetaValue) -> Peek e Bool -> Peek e MetaValue
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Bool
forall e. Peeker e Bool
peekBool StackIndex
idx
Type
Lua.TypeString -> Text -> MetaValue
MetaString (Text -> MetaValue) -> Peek e Text -> Peek e MetaValue
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Text
forall e. Peeker e Text
peekText StackIndex
idx
Type
Lua.TypeTable -> do
Peek e Name -> Peek e (Maybe Name)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peeker e Name
forall e. LuaError e => Peeker e Name
LuaUtil.getTag StackIndex
idx) Peek e (Maybe Name)
-> (Maybe Name -> Peek e MetaValue) -> Peek e MetaValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just Name
tag -> Name -> Peek e MetaValue
peekTagged Name
tag
Maybe Name
Nothing -> Peek e MetaValue
peekUntagged
Type
_ -> ByteString -> Peek e MetaValue
forall a e. ByteString -> Peek e a
failPeek ByteString
"could not get meta value"
pushBlock :: forall e. LuaError e => Block -> LuaE e ()
pushBlock :: Block -> LuaE e ()
pushBlock = \case
BlockQuote [Block]
blcks -> Name -> [Block] -> LuaE e ()
forall e a. (LuaError e, PushViaCall e a) => Name -> a
pushViaConstructor @e Name
"BlockQuote" [Block]
blcks
BulletList [[Block]]
items -> Name -> [[Block]] -> LuaE e ()
forall e a. (LuaError e, PushViaCall e a) => Name -> a
pushViaConstructor @e Name
"BulletList" [[Block]]
items
CodeBlock Attr
attr Text
code -> Name -> [LuaE e ()] -> LuaE e ()
forall e. LuaError e => Name -> [LuaE e ()] -> LuaE e ()
pushViaConstr' @e Name
"CodeBlock"
[ Text -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push Text
code, Pusher e Attr
forall e. LuaError e => Pusher e Attr
pushAttr Attr
attr ]
DefinitionList [([Inline], [[Block]])]
items -> Name -> [([Inline], [[Block]])] -> LuaE e ()
forall e a. (LuaError e, PushViaCall e a) => Name -> a
pushViaConstructor @e Name
"DefinitionList" [([Inline], [[Block]])]
items
Div Attr
attr [Block]
blcks -> Name -> [LuaE e ()] -> LuaE e ()
forall e. LuaError e => Name -> [LuaE e ()] -> LuaE e ()
pushViaConstr' @e Name
"Div"
[[Block] -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push [Block]
blcks, Pusher e Attr
forall e. LuaError e => Pusher e Attr
pushAttr Attr
attr]
Header Int
lvl Attr
attr [Inline]
inlns -> Name -> [LuaE e ()] -> LuaE e ()
forall e. LuaError e => Name -> [LuaE e ()] -> LuaE e ()
pushViaConstr' @e Name
"Header"
[Int -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push Int
lvl, [Inline] -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push [Inline]
inlns, Pusher e Attr
forall e. LuaError e => Pusher e Attr
pushAttr Attr
attr]
Block
HorizontalRule -> Name -> LuaE e ()
forall e a. (LuaError e, PushViaCall e a) => Name -> a
pushViaConstructor @e Name
"HorizontalRule"
LineBlock [[Inline]]
blcks -> Name -> [[Inline]] -> LuaE e ()
forall e a. (LuaError e, PushViaCall e a) => Name -> a
pushViaConstructor @e Name
"LineBlock" [[Inline]]
blcks
OrderedList ListAttributes
lstAttr [[Block]]
list -> Name -> [LuaE e ()] -> LuaE e ()
forall e. LuaError e => Name -> [LuaE e ()] -> LuaE e ()
pushViaConstr' @e Name
"OrderedList"
[ [[Block]] -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push [[Block]]
list, ListAttributes -> LuaE e ()
forall e. LuaError e => ListAttributes -> LuaE e ()
pushListAttributes @e ListAttributes
lstAttr ]
Block
Null -> Name -> LuaE e ()
forall e a. (LuaError e, PushViaCall e a) => Name -> a
pushViaConstructor @e Name
"Null"
Para [Inline]
blcks -> Name -> [Inline] -> LuaE e ()
forall e a. (LuaError e, PushViaCall e a) => Name -> a
pushViaConstructor @e Name
"Para" [Inline]
blcks
Plain [Inline]
blcks -> Name -> [Inline] -> LuaE e ()
forall e a. (LuaError e, PushViaCall e a) => Name -> a
pushViaConstructor @e Name
"Plain" [Inline]
blcks
RawBlock Format
f Text
cs -> Name -> Format -> Text -> LuaE e ()
forall e a. (LuaError e, PushViaCall e a) => Name -> a
pushViaConstructor @e Name
"RawBlock" Format
f Text
cs
Table Attr
attr Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot ->
Name -> [LuaE e ()] -> LuaE e ()
forall e. LuaError e => Name -> [LuaE e ()] -> LuaE e ()
pushViaConstr' @e Name
"Table"
[ Caption -> LuaE e ()
forall e. LuaError e => Caption -> LuaE e ()
pushCaption Caption
blkCapt, [ColSpec] -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push [ColSpec]
specs, TableHead -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push TableHead
thead, [TableBody] -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push [TableBody]
tbody
, TableFoot -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push TableFoot
tfoot, Pusher e Attr
forall e. LuaError e => Pusher e Attr
pushAttr Attr
attr]
peekBlock :: forall e. LuaError e => Peeker e Block
peekBlock :: Peeker e Block
peekBlock = (Peek e Block -> Peek e Block) -> Peeker e Block -> Peeker e Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name -> Peek e Block -> Peek e Block
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Block")
(Peeker e Block -> Peeker e Block)
-> (Peeker e Block -> Peeker e Block)
-> Peeker e Block
-> Peeker e Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name
-> (StackIndex -> LuaE e Bool) -> Peeker e Block -> Peeker e Block
forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"table" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
Lua.istable
(Peeker e Block -> Peeker e Block)
-> Peeker e Block -> Peeker e Block
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx -> do
let mkBlock :: (a -> Block) -> Peeker e a -> Peek e Block
mkBlock :: (a -> Block) -> Peeker e a -> Peek e Block
mkBlock a -> Block
f Peeker e a
p = a -> Block
f (a -> Block) -> Peek e a -> Peek e Block
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e a -> Name -> Peeker e a
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e a
p Name
"c" StackIndex
idx
Peeker e Name
forall e. LuaError e => Peeker e Name
LuaUtil.getTag StackIndex
idx Peek e Name -> (Name -> Peek e Block) -> Peek e Block
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Name
"BlockQuote" -> ([Block] -> Block) -> Peeker e [Block] -> Peek e Block
forall a. (a -> Block) -> Peeker e a -> Peek e Block
mkBlock [Block] -> Block
BlockQuote Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocks
Name
"BulletList" -> ([[Block]] -> Block) -> Peeker e [[Block]] -> Peek e Block
forall a. (a -> Block) -> Peeker e a -> Peek e Block
mkBlock [[Block]] -> Block
BulletList (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]
peekBlocks)
Name
"CodeBlock" -> ((Attr, Text) -> Block) -> Peeker e (Attr, Text) -> Peek e Block
forall a. (a -> Block) -> Peeker e a -> Peek e Block
mkBlock ((Attr -> Text -> Block) -> (Attr, Text) -> Block
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Attr -> Text -> Block
CodeBlock)
(Peeker e Attr -> Peeker e Text -> Peeker e (Attr, Text)
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e (a, b)
peekPair Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr Peeker e Text
forall e. Peeker e Text
peekText)
Name
"DefinitionList" -> ([([Inline], [[Block]])] -> Block)
-> Peeker e [([Inline], [[Block]])] -> Peek e Block
forall a. (a -> Block) -> Peeker e a -> Peek e Block
mkBlock [([Inline], [[Block]])] -> Block
DefinitionList
(Peeker e ([Inline], [[Block]]) -> Peeker e [([Inline], [[Block]])]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList (Peeker e [Inline]
-> Peeker e [[Block]] -> Peeker e ([Inline], [[Block]])
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e (a, b)
peekPair Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlines (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]
peekBlocks)))
Name
"Div" -> ((Attr, [Block]) -> Block)
-> Peeker e (Attr, [Block]) -> Peek e Block
forall a. (a -> Block) -> Peeker e a -> Peek e Block
mkBlock ((Attr -> [Block] -> Block) -> (Attr, [Block]) -> Block
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Attr -> [Block] -> Block
Div) (Peeker e Attr -> Peeker e [Block] -> Peeker e (Attr, [Block])
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e (a, b)
peekPair Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocks)
Name
"Header" -> ((Int, Attr, [Inline]) -> Block)
-> Peeker e (Int, Attr, [Inline]) -> Peek e Block
forall a. (a -> Block) -> Peeker e a -> Peek e Block
mkBlock (\(Int
lvl, Attr
attr, [Inline]
lst) -> Int -> Attr -> [Inline] -> Block
Header Int
lvl Attr
attr [Inline]
lst)
(Peeker e Int
-> Peeker e Attr
-> Peeker e [Inline]
-> Peeker e (Int, Attr, [Inline])
forall e a b c.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e c -> Peeker e (a, b, c)
peekTriple Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlines)
Name
"HorizontalRule" -> Block -> Peek e Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block
HorizontalRule
Name
"LineBlock" -> ([[Inline]] -> Block) -> Peeker e [[Inline]] -> Peek e Block
forall a. (a -> Block) -> Peeker e a -> Peek e Block
mkBlock [[Inline]] -> Block
LineBlock (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]
peekInlines)
Name
"OrderedList" -> ((ListAttributes, [[Block]]) -> Block)
-> Peeker e (ListAttributes, [[Block]]) -> Peek e Block
forall a. (a -> Block) -> Peeker e a -> Peek e Block
mkBlock ((ListAttributes -> [[Block]] -> Block)
-> (ListAttributes, [[Block]]) -> Block
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ListAttributes -> [[Block]] -> Block
OrderedList)
(Peeker e ListAttributes
-> Peeker e [[Block]] -> Peeker e (ListAttributes, [[Block]])
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e (a, b)
peekPair Peeker e ListAttributes
forall e. LuaError e => Peeker e ListAttributes
peekListAttributes (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]
peekBlocks))
Name
"Null" -> Block -> Peek e Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block
Null
Name
"Para" -> ([Inline] -> Block) -> Peeker e [Inline] -> Peek e Block
forall a. (a -> Block) -> Peeker e a -> Peek e Block
mkBlock [Inline] -> Block
Para Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlines
Name
"Plain" -> ([Inline] -> Block) -> Peeker e [Inline] -> Peek e Block
forall a. (a -> Block) -> Peeker e a -> Peek e Block
mkBlock [Inline] -> Block
Plain Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlines
Name
"RawBlock" -> ((Format, Text) -> Block)
-> Peeker e (Format, Text) -> Peek e Block
forall a. (a -> Block) -> Peeker e a -> Peek e Block
mkBlock ((Format -> Text -> Block) -> (Format, Text) -> Block
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Format -> Text -> Block
RawBlock)
(Peeker e Format -> Peeker e Text -> Peeker e (Format, Text)
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e (a, b)
peekPair Peeker e Format
forall e. LuaError e => Peeker e Format
peekFormat Peeker e Text
forall e. Peeker e Text
peekText)
Name
"Table" -> (Block -> Block) -> Peeker e Block -> Peek e Block
forall a. (a -> Block) -> Peeker e a -> Peek e Block
mkBlock Block -> Block
forall a. a -> a
id
(Name -> Peek e Block -> Peek e Block
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Table" (Peek e Block -> Peek e Block) -> Peeker e Block -> Peeker e Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LuaE e StackIndex -> Peek e StackIndex
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e StackIndex -> Peek e StackIndex)
-> (StackIndex -> LuaE e StackIndex)
-> StackIndex
-> Peek e StackIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> LuaE e StackIndex
forall e. StackIndex -> LuaE e StackIndex
absindex (StackIndex -> Peek e StackIndex)
-> Peeker e Block -> Peeker e Block
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (\StackIndex
idx' -> Peek e Block -> Peek e Block
forall e a. Peek e a -> Peek e a
cleanup (Peek e Block -> Peek e Block) -> Peek e Block -> Peek e Block
forall a b. (a -> b) -> a -> b
$ do
Attr
attr <- LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Integer -> LuaE e ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawgeti StackIndex
idx' Integer
1) Peek e () -> Peek e Attr -> Peek e Attr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr StackIndex
top
Caption
capt <- LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Integer -> LuaE e ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawgeti StackIndex
idx' Integer
2) Peek e () -> Peek e Caption -> Peek e Caption
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Peeker e Caption
forall e. LuaError e => Peeker e Caption
peekCaption StackIndex
top
[ColSpec]
cs <- LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Integer -> LuaE e ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawgeti StackIndex
idx' Integer
3) Peek e () -> Peek e [ColSpec] -> Peek e [ColSpec]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> 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 StackIndex
top
TableHead
thead <- LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Integer -> LuaE e ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawgeti StackIndex
idx' Integer
4) Peek e () -> Peek e TableHead -> Peek e TableHead
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Peeker e TableHead
forall e. LuaError e => Peeker e TableHead
peekTableHead StackIndex
top
[TableBody]
tbods <- LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Integer -> LuaE e ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawgeti StackIndex
idx' Integer
5) Peek e () -> Peek e [TableBody] -> Peek e [TableBody]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> 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 StackIndex
top
TableFoot
tfoot <- LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Integer -> LuaE e ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawgeti StackIndex
idx' Integer
6) Peek e () -> Peek e TableFoot -> Peek e TableFoot
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Peeker e TableFoot
forall e. LuaError e => Peeker e TableFoot
peekTableFoot StackIndex
top
Block -> Peek e Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> Peek e Block) -> Block -> Peek e Block
forall a b. (a -> b) -> a -> b
$! Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
capt [ColSpec]
cs TableHead
thead [TableBody]
tbods TableFoot
tfoot)))
Name ByteString
tag -> ByteString -> Peek e Block
forall a e. ByteString -> Peek e a
failPeek (ByteString
"Unknown block type: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
tag)
peekBlocks :: LuaError e => Peeker e [Block]
peekBlocks :: Peeker e [Block]
peekBlocks = Peeker e Block -> Peeker e [Block]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Block
forall e. LuaError e => Peeker e Block
peekBlock
peekInlines :: LuaError e => Peeker e [Inline]
peekInlines :: Peeker e [Inline]
peekInlines = 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
peekInline
pushCaption :: LuaError e => Caption -> LuaE e ()
pushCaption :: Caption -> LuaE e ()
pushCaption (Caption Maybe [Inline]
shortCaption [Block]
longCaption) = do
LuaE e ()
forall e. LuaE e ()
Lua.newtable
String -> Optional [Inline] -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"short" (Maybe [Inline] -> Optional [Inline]
forall a. Maybe a -> Optional a
Lua.Optional Maybe [Inline]
shortCaption)
String -> [Block] -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"long" [Block]
longCaption
peekCaption :: LuaError e => Peeker e Caption
peekCaption :: Peeker e Caption
peekCaption = Name -> Peek e Caption -> Peek e Caption
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Caption" (Peek e Caption -> Peek e Caption)
-> Peeker e Caption -> Peeker e Caption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \StackIndex
idx -> do
Maybe [Inline]
short <- Peek e [Inline] -> Peek e (Maybe [Inline])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e [Inline] -> Peek e (Maybe [Inline]))
-> Peek e [Inline] -> Peek e (Maybe [Inline])
forall a b. (a -> b) -> a -> b
$ Peeker e [Inline] -> Name -> Peeker e [Inline]
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlines Name
"short" StackIndex
idx
[Block]
long <- Peeker e [Block] -> Name -> Peeker e [Block]
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocks Name
"long" StackIndex
idx
Caption -> Peek e Caption
forall (m :: * -> *) a. Monad m => a -> m a
return (Caption -> Peek e Caption) -> Caption -> Peek e Caption
forall a b. (a -> b) -> a -> b
$! Maybe [Inline] -> [Block] -> Caption
Caption Maybe [Inline]
short [Block]
long
peekColWidth :: LuaError e => Peeker e ColWidth
peekColWidth :: Peeker e ColWidth
peekColWidth = Name -> Peek e ColWidth -> Peek e ColWidth
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"ColWidth" (Peek e ColWidth -> Peek e ColWidth)
-> Peeker e ColWidth -> Peeker e ColWidth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \StackIndex
idx -> do
ColWidth -> (Double -> ColWidth) -> Maybe Double -> ColWidth
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ColWidth
ColWidthDefault Double -> ColWidth
ColWidth (Maybe Double -> ColWidth)
-> Peek e (Maybe Double) -> Peek e ColWidth
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peek e Double -> Peek e (Maybe Double)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peeker e Double
forall a e. (RealFloat a, Read a) => Peeker e a
peekRealFloat StackIndex
idx)
peekColSpec :: LuaError e => Peeker e ColSpec
peekColSpec :: Peeker e ColSpec
peekColSpec = Peeker e Alignment -> Peeker e ColWidth -> Peeker e ColSpec
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e (a, b)
peekPair Peeker e Alignment
forall a e. Read a => Peeker e a
peekRead Peeker e ColWidth
forall e. LuaError e => Peeker e ColWidth
peekColWidth
instance Pushable ColWidth where
push :: ColWidth -> LuaE e ()
push = \case
(ColWidth Double
w) -> Double -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push Double
w
ColWidth
ColWidthDefault -> LuaE e ()
forall e. LuaE e ()
Lua.pushnil
instance Pushable Row where
push :: Row -> LuaE e ()
push (Row Attr
attr [Cell]
cells) = (Attr, [Cell]) -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (Attr
attr, [Cell]
cells)
instance Peekable Row where
peek :: StackIndex -> LuaE e Row
peek = Peek e Row -> LuaE e Row
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e Row -> LuaE e Row)
-> (StackIndex -> Peek e Row) -> StackIndex -> LuaE e Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Row
forall e. LuaError e => Peeker e Row
peekRow
peekRow :: LuaError e => Peeker e Row
peekRow :: Peeker e Row
peekRow = (((Attr -> [Cell] -> Row) -> (Attr, [Cell]) -> Row
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Attr -> [Cell] -> Row
Row) ((Attr, [Cell]) -> Row) -> Peek e (Attr, [Cell]) -> Peek e Row
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>)
(Peek e (Attr, [Cell]) -> Peek e Row)
-> (StackIndex -> Peek e (Attr, [Cell])) -> Peeker e Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Peek e (Attr, [Cell]) -> Peek e (Attr, [Cell])
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Row"
(Peek e (Attr, [Cell]) -> Peek e (Attr, [Cell]))
-> (StackIndex -> Peek e (Attr, [Cell]))
-> StackIndex
-> Peek e (Attr, [Cell])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e Attr
-> Peeker e [Cell] -> StackIndex -> Peek e (Attr, [Cell])
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e (a, b)
peekPair Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr (Peeker e Cell -> Peeker e [Cell]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Cell
forall e. LuaError e => Peeker e Cell
peekCell)
instance Pushable TableBody where
push :: TableBody -> LuaE e ()
push (TableBody Attr
attr (RowHeadColumns Int
rowHeadColumns) [Row]
head' [Row]
body) = do
LuaE e ()
forall e. LuaE e ()
Lua.newtable
String -> Attr -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"attr" Attr
attr
String -> Int -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"row_head_columns" Int
rowHeadColumns
String -> [Row] -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"head" [Row]
head'
String -> [Row] -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"body" [Row]
body
peekTableBody :: LuaError e => Peeker e TableBody
peekTableBody :: Peeker e TableBody
peekTableBody = (Peek e TableBody -> Peek e TableBody)
-> Peeker e TableBody -> Peeker e TableBody
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name -> Peek e TableBody -> Peek e TableBody
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"TableBody")
(Peeker e TableBody -> Peeker e TableBody)
-> (Peeker e TableBody -> Peeker e TableBody)
-> Peeker e TableBody
-> Peeker e TableBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name
-> (StackIndex -> LuaE e Bool)
-> Peeker e TableBody
-> Peeker e TableBody
forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"table" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
Lua.istable
(Peeker e TableBody -> Peeker e TableBody)
-> Peeker e TableBody -> Peeker e TableBody
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx -> Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody
(Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody)
-> Peek e Attr
-> Peek e (RowHeadColumns -> [Row] -> [Row] -> TableBody)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Attr -> Name -> Peeker e Attr
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr Name
"attr" StackIndex
idx
Peek e (RowHeadColumns -> [Row] -> [Row] -> TableBody)
-> Peek e RowHeadColumns -> Peek e ([Row] -> [Row] -> TableBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Peeker e RowHeadColumns -> Name -> Peeker e RowHeadColumns
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (((Int -> RowHeadColumns) -> Peek e Int -> Peek e RowHeadColumns
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> RowHeadColumns
RowHeadColumns) (Peek e Int -> Peek e RowHeadColumns)
-> (StackIndex -> Peek e Int) -> Peeker e RowHeadColumns
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral) Name
"row_head_columns" StackIndex
idx
Peek e ([Row] -> [Row] -> TableBody)
-> Peek e [Row] -> Peek e ([Row] -> TableBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Peeker e [Row] -> Name -> Peeker e [Row]
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (Peeker e Row -> Peeker e [Row]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Row
forall e. LuaError e => Peeker e Row
peekRow) Name
"head" StackIndex
idx
Peek e ([Row] -> TableBody) -> Peek e [Row] -> Peek e TableBody
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Peeker e [Row] -> Name -> Peeker e [Row]
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (Peeker e Row -> Peeker e [Row]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Row
forall e. LuaError e => Peeker e Row
peekRow) Name
"body" StackIndex
idx
instance Pushable TableHead where
push :: TableHead -> LuaE e ()
push (TableHead Attr
attr [Row]
rows) = (Attr, [Row]) -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (Attr
attr, [Row]
rows)
peekTableHead :: LuaError e => Peeker e TableHead
peekTableHead :: Peeker e TableHead
peekTableHead = (((Attr -> [Row] -> TableHead) -> (Attr, [Row]) -> TableHead
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Attr -> [Row] -> TableHead
TableHead) ((Attr, [Row]) -> TableHead)
-> Peek e (Attr, [Row]) -> Peek e TableHead
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>)
(Peek e (Attr, [Row]) -> Peek e TableHead)
-> (StackIndex -> Peek e (Attr, [Row])) -> Peeker e TableHead
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Peek e (Attr, [Row]) -> Peek e (Attr, [Row])
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"TableHead"
(Peek e (Attr, [Row]) -> Peek e (Attr, [Row]))
-> (StackIndex -> Peek e (Attr, [Row]))
-> StackIndex
-> Peek e (Attr, [Row])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e Attr
-> Peeker e [Row] -> StackIndex -> Peek e (Attr, [Row])
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e (a, b)
peekPair Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr (Peeker e Row -> Peeker e [Row]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Row
forall e. LuaError e => Peeker e Row
peekRow)
instance Pushable TableFoot where
push :: TableFoot -> LuaE e ()
push (TableFoot Attr
attr [Row]
cells) = (Attr, [Row]) -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (Attr
attr, [Row]
cells)
peekTableFoot :: LuaError e => Peeker e TableFoot
= (((Attr -> [Row] -> TableFoot) -> (Attr, [Row]) -> TableFoot
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Attr -> [Row] -> TableFoot
TableFoot) ((Attr, [Row]) -> TableFoot)
-> Peek e (Attr, [Row]) -> Peek e TableFoot
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>)
(Peek e (Attr, [Row]) -> Peek e TableFoot)
-> (StackIndex -> Peek e (Attr, [Row])) -> Peeker e TableFoot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Peek e (Attr, [Row]) -> Peek e (Attr, [Row])
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"TableFoot"
(Peek e (Attr, [Row]) -> Peek e (Attr, [Row]))
-> (StackIndex -> Peek e (Attr, [Row]))
-> StackIndex
-> Peek e (Attr, [Row])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e Attr
-> Peeker e [Row] -> StackIndex -> Peek e (Attr, [Row])
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e (a, b)
peekPair Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr (Peeker e Row -> Peeker e [Row]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Row
forall e. LuaError e => Peeker e Row
peekRow)
instance Pushable Cell where
push :: Cell -> LuaE e ()
push = Cell -> LuaE e ()
forall e. LuaError e => Cell -> LuaE e ()
pushCell
instance Peekable Cell where
peek :: StackIndex -> LuaE e Cell
peek = Peek e Cell -> LuaE e Cell
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e Cell -> LuaE e Cell)
-> (StackIndex -> Peek e Cell) -> StackIndex -> LuaE e Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Cell
forall e. LuaError e => Peeker e Cell
peekCell
pushCell :: LuaError e => Cell -> LuaE e ()
pushCell :: Cell -> LuaE e ()
pushCell (Cell Attr
attr Alignment
align (RowSpan Int
rowSpan) (ColSpan Int
colSpan) [Block]
contents) = do
LuaE e ()
forall e. LuaE e ()
Lua.newtable
String -> Attr -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"attr" Attr
attr
String -> Alignment -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"alignment" Alignment
align
String -> Int -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"row_span" Int
rowSpan
String -> Int -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"col_span" Int
colSpan
String -> [Block] -> LuaE e ()
forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
LuaUtil.addField String
"contents" [Block]
contents
peekCell :: LuaError e => Peeker e Cell
peekCell :: Peeker e Cell
peekCell = (Peek e Cell -> Peek e Cell) -> Peeker e Cell -> Peeker e Cell
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name -> Peek e Cell -> Peek e Cell
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Cell")
(Peeker e Cell -> Peeker e Cell)
-> (Peeker e Cell -> Peeker e Cell)
-> Peeker e Cell
-> Peeker e Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name
-> (StackIndex -> LuaE e Bool) -> Peeker e Cell -> Peeker e Cell
forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"table" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
Lua.istable
(Peeker e Cell -> Peeker e Cell) -> Peeker e Cell -> Peeker e Cell
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx -> do
Attr
attr <- Peeker e Attr -> Name -> Peeker e Attr
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr Name
"attr" StackIndex
idx
Alignment
algn <- Peeker e Alignment -> Name -> Peeker e Alignment
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e Alignment
forall a e. Read a => Peeker e a
peekRead Name
"alignment" StackIndex
idx
RowSpan
rs <- Int -> RowSpan
RowSpan (Int -> RowSpan) -> Peek e Int -> Peek e RowSpan
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Int -> Name -> Peeker e Int
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral Name
"row_span" StackIndex
idx
ColSpan
cs <- Int -> ColSpan
ColSpan (Int -> ColSpan) -> Peek e Int -> Peek e ColSpan
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Int -> Name -> Peeker e Int
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral Name
"col_span" StackIndex
idx
[Block]
blks <- Peeker e [Block] -> Name -> Peeker e [Block]
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocks Name
"contents" StackIndex
idx
Cell -> Peek e Cell
forall (m :: * -> *) a. Monad m => a -> m a
return (Cell -> Peek e Cell) -> Cell -> Peek e Cell
forall a b. (a -> b) -> a -> b
$! Attr -> Alignment -> RowSpan -> ColSpan -> [Block] -> Cell
Cell Attr
attr Alignment
algn RowSpan
rs ColSpan
cs [Block]
blks
getInlineText :: Inline -> Possible Text
getInlineText :: Inline -> Possible Text
getInlineText = \case
Code Attr
_ Text
lst -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
lst
Math MathType
_ Text
str -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
str
RawInline Format
_ Text
raw -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
raw
Str Text
s -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
s
Inline
_ -> Possible Text
forall a. Possible a
Absent
setInlineText :: Inline -> Text -> Possible Inline
setInlineText :: Inline -> Text -> Possible Inline
setInlineText = \case
Code Attr
attr Text
_ -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Text -> Inline) -> Text -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Text -> Inline
Code Attr
attr
Math MathType
mt Text
_ -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Text -> Inline) -> Text -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MathType -> Text -> Inline
Math MathType
mt
RawInline Format
f Text
_ -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Text -> Inline) -> Text -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Text -> Inline
RawInline Format
f
Str Text
_ -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Text -> Inline) -> Text -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inline
Str
Inline
_ -> Possible Inline -> Text -> Possible Inline
forall a b. a -> b -> a
const Possible Inline
forall a. Possible a
Absent
data Content
= ContentBlocks [Block]
| ContentInlines [Inline]
setInlineContent :: Inline -> Content -> Possible Inline
setInlineContent :: Inline -> Content -> Possible Inline
setInlineContent = \case
Cite [Citation]
cs [Inline]
_ -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Content -> Inline) -> Content -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Citation] -> [Inline] -> Inline
Cite [Citation]
cs ([Inline] -> Inline) -> (Content -> [Inline]) -> Content -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
Emph [Inline]
_ -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Content -> Inline) -> Content -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Inline
Emph ([Inline] -> Inline) -> (Content -> [Inline]) -> Content -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
Quoted QuoteType
qt [Inline]
_ -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Content -> Inline) -> Content -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuoteType -> [Inline] -> Inline
Quoted QuoteType
qt ([Inline] -> Inline) -> (Content -> [Inline]) -> Content -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
SmallCaps [Inline]
_ -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Content -> Inline) -> Content -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Inline
SmallCaps ([Inline] -> Inline) -> (Content -> [Inline]) -> Content -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
Span Attr
attr [Inline]
_ -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Content -> Inline) -> Content -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> [Inline] -> Inline
Span Attr
attr ([Inline] -> Inline) -> (Content -> [Inline]) -> Content -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
Strong [Inline]
_ -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Content -> Inline) -> Content -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Inline
Strong ([Inline] -> Inline) -> (Content -> [Inline]) -> Content -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
Subscript [Inline]
_ -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Content -> Inline) -> Content -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Inline
Subscript ([Inline] -> Inline) -> (Content -> [Inline]) -> Content -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
Superscript [Inline]
_ -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Content -> Inline) -> Content -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Inline
Superscript ([Inline] -> Inline) -> (Content -> [Inline]) -> Content -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
Underline [Inline]
_ -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Content -> Inline) -> Content -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Inline
Underline ([Inline] -> Inline) -> (Content -> [Inline]) -> Content -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Inline]
inlineContent
Note [Block]
_ -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Content -> Inline) -> Content -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Inline
Note ([Block] -> Inline) -> (Content -> [Block]) -> Content -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Block]
blockContent
Inline
_ -> Possible Inline -> Content -> Possible Inline
forall a b. a -> b -> a
const Possible Inline
forall a. Possible a
Absent
where
inlineContent :: Content -> [Inline]
inlineContent = \case
ContentInlines [Inline]
inlns -> [Inline]
inlns
ContentBlocks [Block]
_ -> PandocError -> [Inline]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PandocError -> [Inline]) -> PandocError -> [Inline]
forall a b. (a -> b) -> a -> b
$
Text -> PandocError
PandocLuaError Text
"expected Inlines, got Blocks"
blockContent :: Content -> [Block]
blockContent = \case
ContentBlocks [Block]
blks -> [Block]
blks
ContentInlines [] -> []
ContentInlines [Inline]
_ -> PandocError -> [Block]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PandocError -> [Block]) -> PandocError -> [Block]
forall a b. (a -> b) -> a -> b
$
Text -> PandocError
PandocLuaError Text
"expected Blocks, got Inlines"
getInlineContent :: Inline -> Possible Content
getInlineContent :: Inline -> Possible Content
getInlineContent = \case
Cite [Citation]
_ [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
Emph [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
Quoted QuoteType
_ [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
SmallCaps [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
Span 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
Strong [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
Subscript [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
Superscript [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
Underline [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
Note [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
Inline
_ -> Possible Content
forall a. Possible a
Absent
getInlineTitle :: Inline -> Possible Text
getInlineTitle :: Inline -> Possible Text
getInlineTitle = \case
Image Attr
_ [Inline]
_ (Text
_, Text
tit) -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
tit
Link Attr
_ [Inline]
_ (Text
_, Text
tit) -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
tit
Inline
_ -> Possible Text
forall a. Possible a
Absent
setInlineTitle :: Inline -> Text -> Possible Inline
setInlineTitle :: Inline -> Text -> Possible Inline
setInlineTitle = \case
Image Attr
attr [Inline]
capt (Text
src, Text
_) -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Text -> Inline) -> Text -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
capt ((Text, Text) -> Inline)
-> (Text -> (Text, Text)) -> Text -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
src,)
Link Attr
attr [Inline]
capt (Text
src, Text
_) -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Text -> Inline) -> Text -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
attr [Inline]
capt ((Text, Text) -> Inline)
-> (Text -> (Text, Text)) -> Text -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
src,)
Inline
_ -> Possible Inline -> Text -> Possible Inline
forall a b. a -> b -> a
const Possible Inline
forall a. Possible a
Absent
getInlineAttr :: Inline -> Possible Attr
getInlineAttr :: Inline -> Possible Attr
getInlineAttr = \case
Code Attr
attr Text
_ -> Attr -> Possible Attr
forall a. a -> Possible a
Actual Attr
attr
Image Attr
attr [Inline]
_ (Text, Text)
_ -> Attr -> Possible Attr
forall a. a -> Possible a
Actual Attr
attr
Link Attr
attr [Inline]
_ (Text, Text)
_ -> Attr -> Possible Attr
forall a. a -> Possible a
Actual Attr
attr
Span Attr
attr [Inline]
_ -> Attr -> Possible Attr
forall a. a -> Possible a
Actual Attr
attr
Inline
_ -> Possible Attr
forall a. Possible a
Absent
setInlineAttr :: Inline -> Attr -> Possible Inline
setInlineAttr :: Inline -> Attr -> Possible Inline
setInlineAttr = \case
Code Attr
_ Text
cs -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Attr -> Inline) -> Attr -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attr -> Text -> Inline
`Code` Text
cs)
Image Attr
_ [Inline]
cpt (Text, Text)
tgt -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Attr -> Inline) -> Attr -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Attr
attr -> Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
cpt (Text, Text)
tgt
Link Attr
_ [Inline]
cpt (Text, Text)
tgt -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Attr -> Inline) -> Attr -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Attr
attr -> Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
attr [Inline]
cpt (Text, Text)
tgt
Span Attr
_ [Inline]
inlns -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Attr -> Inline) -> Attr -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attr -> [Inline] -> Inline
`Span` [Inline]
inlns)
Inline
_ -> Possible Inline -> Attr -> Possible Inline
forall a b. a -> b -> a
const Possible Inline
forall a. Possible a
Absent
showInline :: LuaError e => DocumentedFunction e
showInline :: DocumentedFunction e
showInline = Name
-> (Inline -> LuaE e String)
-> HsFnPrecursor e (Inline -> LuaE e String)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"show"
### liftPure (show @Inline)
HsFnPrecursor e (Inline -> LuaE e String)
-> Parameter e Inline -> HsFnPrecursor e (LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Inline -> Text -> Text -> Text -> Parameter e Inline
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Inline
forall e. LuaError e => Peeker e Inline
peekInline Text
"inline" Text
"Inline" Text
"Object"
HsFnPrecursor e (LuaE e String)
-> FunctionResults e String -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e String -> Text -> Text -> FunctionResults e String
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e String
forall e. String -> LuaE e ()
pushString Text
"string" Text
"stringified Inline"
pushContent :: LuaError e => Pusher e Content
pushContent :: Pusher e Content
pushContent = \case
ContentBlocks [Block]
blks -> Pusher e Block -> Pusher e [Block]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Block
forall e. LuaError e => Block -> LuaE e ()
pushBlock [Block]
blks
ContentInlines [Inline]
inlns -> Pusher e Inline -> Pusher e [Inline]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline [Inline]
inlns
peekContent :: LuaError e => Peeker e Content
peekContent :: Peeker e Content
peekContent StackIndex
idx =
([Inline] -> Content
ContentInlines ([Inline] -> Content) -> Peek e [Inline] -> Peek e Content
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> 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
peekInline StackIndex
idx) Peek e Content -> Peek e Content -> Peek e Content
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
([Block] -> Content
ContentBlocks ([Block] -> Content) -> Peek e [Block] -> Peek e Content
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> 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 StackIndex
idx)
typeInline :: LuaError e => DocumentedType e Inline
typeInline :: DocumentedType e Inline
typeInline = Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) Inline]
-> DocumentedType e Inline
forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"Inline"
[ Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Tostring DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
showInline
, 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
$ Name
-> (Inline -> Inline -> LuaE e Bool)
-> HsFnPrecursor e (Inline -> Inline -> LuaE e Bool)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"__eq"
### liftPure2 (==)
HsFnPrecursor e (Inline -> Inline -> LuaE e Bool)
-> Parameter e Inline -> HsFnPrecursor e (Inline -> LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Inline -> Text -> Text -> Text -> Parameter e Inline
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Inline
forall e. LuaError e => Peeker e Inline
peekInline Text
"a" Text
"Inline" Text
""
HsFnPrecursor e (Inline -> LuaE e Bool)
-> Parameter e Inline -> HsFnPrecursor e (LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Inline -> Text -> Text -> Text -> Parameter e Inline
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Inline
forall e. LuaError e => Peeker e Inline
peekInline Text
"b" Text
"Inline" Text
""
HsFnPrecursor e (LuaE e Bool)
-> FunctionResults e Bool -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Bool -> Text -> Text -> FunctionResults e Bool
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Bool
forall e. Pusher e Bool
pushBool Text
"boolean" Text
"whether the two are equal"
]
[ Name
-> Text
-> (Pusher e Attr, Inline -> Possible Attr)
-> (Peeker e Attr, Inline -> Attr -> Possible Inline)
-> Member e (DocumentedFunction e) Inline
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, Inline -> Possible Attr
getInlineAttr)
(Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr, Inline -> Attr -> Possible Inline
setInlineAttr)
, Name
-> Text
-> (Pusher e [Inline], Inline -> Possible [Inline])
-> (Peeker e [Inline], Inline -> [Inline] -> Possible Inline)
-> Member e (DocumentedFunction e) Inline
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
"image caption"
(Pusher e Inline -> Pusher e [Inline]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline, \case
Image Attr
_ [Inline]
capt (Text, Text)
_ -> [Inline] -> Possible [Inline]
forall a. a -> Possible a
Actual [Inline]
capt
Inline
_ -> Possible [Inline]
forall a. Possible a
Absent)
(Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlines, \case
Image Attr
attr [Inline]
_ (Text, Text)
target -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> ([Inline] -> Inline) -> [Inline] -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[Inline]
capt -> Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
capt (Text, Text)
target)
Inline
_ -> Possible Inline -> [Inline] -> Possible Inline
forall a b. a -> b -> a
const Possible Inline
forall a. Possible a
Absent)
, Name
-> Text
-> (Pusher e [Citation], Inline -> Possible [Citation])
-> (Peeker e [Citation], Inline -> [Citation] -> Possible Inline)
-> Member e (DocumentedFunction e) Inline
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
"citations" Text
"list of citations"
(Pusher e Citation -> Pusher e [Citation]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Citation
forall e. LuaError e => Citation -> LuaE e ()
pushCitation, \case {Cite [Citation]
cs [Inline]
_ -> [Citation] -> Possible [Citation]
forall a. a -> Possible a
Actual [Citation]
cs; Inline
_ -> Possible [Citation]
forall a. Possible a
Absent})
(Peeker e Citation -> Peeker e [Citation]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Citation
forall e. LuaError e => Peeker e Citation
peekCitation, \case
Cite [Citation]
_ [Inline]
inlns -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> ([Citation] -> Inline) -> [Citation] -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Citation] -> [Inline] -> Inline
`Cite` [Inline]
inlns)
Inline
_ -> Possible Inline -> [Citation] -> Possible Inline
forall a b. a -> b -> a
const Possible Inline
forall a. Possible a
Absent)
, Name
-> Text
-> (Pusher e Content, Inline -> Possible Content)
-> (Peeker e Content, Inline -> Content -> Possible Inline)
-> Member e (DocumentedFunction e) Inline
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 contents"
(Pusher e Content
forall e. LuaError e => Pusher e Content
pushContent, Inline -> Possible Content
getInlineContent)
(Peeker e Content
forall e. LuaError e => Peeker e Content
peekContent, Inline -> Content -> Possible Inline
setInlineContent)
, Name
-> Text
-> (Pusher e Format, Inline -> Possible Format)
-> (Peeker e Format, Inline -> Format -> Possible Inline)
-> Member e (DocumentedFunction e) Inline
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 text"
(Pusher e Format
forall e. LuaError e => Format -> LuaE e ()
pushFormat, \case {RawInline Format
fmt Text
_ -> Format -> Possible Format
forall a. a -> Possible a
Actual Format
fmt; Inline
_ -> Possible Format
forall a. Possible a
Absent})
(Peeker e Format
forall e. LuaError e => Peeker e Format
peekFormat, \case
RawInline Format
_ Text
txt -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Format -> Inline) -> Format -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Format -> Text -> Inline
`RawInline` Text
txt)
Inline
_ -> Possible Inline -> Format -> Possible Inline
forall a b. a -> b -> a
const Possible Inline
forall a. Possible a
Absent)
, Name
-> Text
-> (Pusher e MathType, Inline -> Possible MathType)
-> (Peeker e MathType, Inline -> MathType -> Possible Inline)
-> Member e (DocumentedFunction e) Inline
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
"mathtype" Text
"math rendering method"
(Pusher e MathType
forall e. LuaError e => MathType -> LuaE e ()
pushMathType, \case {Math MathType
mt Text
_ -> MathType -> Possible MathType
forall a. a -> Possible a
Actual MathType
mt; Inline
_ -> Possible MathType
forall a. Possible a
Absent})
(Peeker e MathType
forall e. LuaError e => Peeker e MathType
peekMathType, \case
Math MathType
_ Text
txt -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (MathType -> Inline) -> MathType -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MathType -> Text -> Inline
`Math` Text
txt)
Inline
_ -> Possible Inline -> MathType -> Possible Inline
forall a b. a -> b -> a
const Possible Inline
forall a. Possible a
Absent)
, Name
-> Text
-> (Pusher e QuoteType, Inline -> Possible QuoteType)
-> (Peeker e QuoteType, Inline -> QuoteType -> Possible Inline)
-> Member e (DocumentedFunction e) Inline
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
"quotetype" Text
"type of quotes (single or double)"
(Pusher e QuoteType
forall e. LuaError e => QuoteType -> LuaE e ()
pushQuoteType, \case {Quoted QuoteType
qt [Inline]
_ -> QuoteType -> Possible QuoteType
forall a. a -> Possible a
Actual QuoteType
qt; Inline
_ -> Possible QuoteType
forall a. Possible a
Absent})
(Peeker e QuoteType
forall e. LuaError e => Peeker e QuoteType
peekQuoteType, \case
Quoted QuoteType
_ [Inline]
inlns -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (QuoteType -> Inline) -> QuoteType -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QuoteType -> [Inline] -> Inline
`Quoted` [Inline]
inlns)
Inline
_ -> Possible Inline -> QuoteType -> Possible Inline
forall a b. a -> b -> a
const Possible Inline
forall a. Possible a
Absent)
, Name
-> Text
-> (Pusher e Text, Inline -> Possible Text)
-> (Peeker e Text, Inline -> Text -> Possible Inline)
-> Member e (DocumentedFunction e) Inline
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
"src" Text
"image source"
(Pusher e Text
forall e. Pusher e Text
pushText, \case
Image Attr
_ [Inline]
_ (Text
src, Text
_) -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
src
Inline
_ -> Possible Text
forall a. Possible a
Absent)
(Peeker e Text
forall e. Peeker e Text
peekText, \case
Image Attr
attr [Inline]
capt (Text
_, Text
title) -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Text -> Inline) -> Text -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
capt ((Text, Text) -> Inline)
-> (Text -> (Text, Text)) -> Text -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,Text
title)
Inline
_ -> Possible Inline -> Text -> Possible Inline
forall a b. a -> b -> a
const Possible Inline
forall a. Possible a
Absent)
, Name
-> Text
-> (Pusher e Text, Inline -> Possible Text)
-> (Peeker e Text, Inline -> Text -> Possible Inline)
-> Member e (DocumentedFunction e) Inline
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
"target" Text
"link target URL"
(Pusher e Text
forall e. Pusher e Text
pushText, \case
Link Attr
_ [Inline]
_ (Text
tgt, Text
_) -> Text -> Possible Text
forall a. a -> Possible a
Actual Text
tgt
Inline
_ -> Possible Text
forall a. Possible a
Absent)
(Peeker e Text
forall e. Peeker e Text
peekText, \case
Link Attr
attr [Inline]
capt (Text
_, Text
title) -> Inline -> Possible Inline
forall a. a -> Possible a
Actual (Inline -> Possible Inline)
-> (Text -> Inline) -> Text -> Possible Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
capt ((Text, Text) -> Inline)
-> (Text -> (Text, Text)) -> Text -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,Text
title)
Inline
_ -> Possible Inline -> Text -> Possible Inline
forall a b. a -> b -> a
const Possible Inline
forall a. Possible a
Absent)
, Name
-> Text
-> (Pusher e Text, Inline -> Possible Text)
-> (Peeker e Text, Inline -> Text -> Possible Inline)
-> Member e (DocumentedFunction e) Inline
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
"title" Text
"title text"
(Pusher e Text
forall e. Pusher e Text
pushText, Inline -> Possible Text
getInlineTitle)
(Peeker e Text
forall e. Peeker e Text
peekText, Inline -> Text -> Possible Inline
setInlineTitle)
, Name
-> Text
-> (Pusher e Text, Inline -> Possible Text)
-> (Peeker e Text, Inline -> Text -> Possible Inline)
-> Member e (DocumentedFunction e) Inline
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, Inline -> Possible Text
getInlineText)
(Peeker e Text
forall e. Peeker e Text
peekText, Inline -> Text -> Possible Inline
setInlineText)
, Name
-> Text
-> (Pusher e String, Inline -> String)
-> Member e (DocumentedFunction e) Inline
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"tag" Text
"type of Inline"
(Pusher e String
forall e. String -> LuaE e ()
pushString, Constr -> String
showConstr (Constr -> String) -> (Inline -> Constr) -> Inline -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> Constr
forall a. Data a => a -> Constr
toConstr )
, Name
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Inline
forall e fn a. Name -> Text -> [AliasIndex] -> Member e fn a
alias Name
"t" Text
"tag" [AliasIndex
"tag"]
, Name
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Inline
forall e fn a. Name -> Text -> [AliasIndex] -> Member e fn a
alias Name
"c" Text
"content" [AliasIndex
"content"]
, Name
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Inline
forall e fn a. Name -> Text -> [AliasIndex] -> Member e fn a
alias Name
"identifier" Text
"element identifier" [AliasIndex
"attr", AliasIndex
"identifier"]
, Name
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Inline
forall e fn a. Name -> Text -> [AliasIndex] -> Member e fn a
alias Name
"classes" Text
"element classes" [AliasIndex
"attr", AliasIndex
"classes"]
, Name
-> Text -> [AliasIndex] -> Member e (DocumentedFunction e) Inline
forall e fn a. Name -> Text -> [AliasIndex] -> Member e fn a
alias Name
"attributes" Text
"other element attributes" [AliasIndex
"attr", AliasIndex
"attributes"]
, DocumentedFunction e -> Member e (DocumentedFunction e) Inline
forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method (DocumentedFunction e -> Member e (DocumentedFunction e) Inline)
-> DocumentedFunction e -> Member e (DocumentedFunction e) Inline
forall a b. (a -> b) -> a -> b
$ Name
-> (Inline -> LuaE e Inline)
-> HsFnPrecursor e (Inline -> LuaE e Inline)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"clone"
### return
HsFnPrecursor e (Inline -> LuaE e Inline)
-> Parameter e Inline -> HsFnPrecursor e (LuaE e Inline)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Inline -> Text -> Text -> Text -> Parameter e Inline
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Inline
forall e. LuaError e => Peeker e Inline
peekInline Text
"inline" Text
"Inline" Text
"self"
HsFnPrecursor e (LuaE e Inline)
-> FunctionResults e Inline -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Inline -> Text -> Text -> FunctionResults e Inline
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Inline
forall e. LuaError e => Inline -> LuaE e ()
pushInline Text
"Inline" Text
"cloned Inline"
]
pushInline :: forall e. LuaError e => Inline -> LuaE e ()
pushInline :: Inline -> LuaE e ()
pushInline = UDTypeWithList e (DocumentedFunction e) Inline Void
-> Inline -> LuaE e ()
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD UDTypeWithList e (DocumentedFunction e) Inline Void
forall e. LuaError e => DocumentedType e Inline
typeInline
peekInline :: forall e. LuaError e => Peeker e Inline
peekInline :: Peeker e Inline
peekInline = Name -> Peek e Inline -> Peek e Inline
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Inline" (Peek e Inline -> Peek e Inline)
-> Peeker e Inline -> Peeker e Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \StackIndex
idx -> UDTypeWithList e (DocumentedFunction e) Inline Void
-> Peeker e Inline
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD UDTypeWithList e (DocumentedFunction e) Inline Void
forall e. LuaError e => DocumentedType e Inline
typeInline StackIndex
idx
peekFuzzyInlines :: LuaError e => Peeker e [Inline]
peekFuzzyInlines :: Peeker e [Inline]
peekFuzzyInlines = [Peeker e [Inline]] -> Peeker e [Inline]
forall e a. LuaError e => [Peeker e a] -> Peeker e a
choice
[ 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
peekInline
, (Inline -> [Inline]) -> Peek e Inline -> Peek e [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Inline -> [Inline]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Peek e Inline -> Peek e [Inline])
-> Peeker e Inline -> Peeker e [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e Inline
forall e. LuaError e => Peeker e Inline
peekInline
, \StackIndex
idx -> Inline -> [Inline]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> (Text -> Inline) -> Text -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inline
Str (Text -> [Inline]) -> Peek e Text -> Peek e [Inline]
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Text
forall e. Peeker e Text
peekText StackIndex
idx
]
peekFuzzyBlocks :: LuaError e => Peeker e [Block]
peekFuzzyBlocks :: Peeker e [Block]
peekFuzzyBlocks = [Peeker e [Block]] -> Peeker e [Block]
forall e a. LuaError e => [Peeker e a] -> Peeker e a
choice
[ 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
, (Block -> [Block]) -> Peek e Block -> Peek e [Block]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Block -> [Block]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Peek e Block -> Peek e [Block])
-> Peeker e Block -> Peeker e [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e Block
forall e. LuaError e => Peeker e Block
peekBlock
, \StackIndex
idx -> Block -> [Block]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> [Block]) -> (Text -> Block) -> Text -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Block
Plain ([Inline] -> Block) -> (Text -> [Inline]) -> Text -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> [Inline]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> (Text -> Inline) -> Text -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inline
Str (Text -> [Block]) -> Peek e Text -> Peek e [Block]
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Text
forall e. Peeker e Text
peekText StackIndex
idx
]
pushListAttributes :: forall e. LuaError e => ListAttributes -> LuaE e ()
pushListAttributes :: ListAttributes -> LuaE e ()
pushListAttributes (Int
start, ListNumberStyle
style, ListNumberDelim
delimiter) =
Name -> [LuaE e ()] -> LuaE e ()
forall e. LuaError e => Name -> [LuaE e ()] -> LuaE e ()
pushViaConstr' Name
"ListAttributes"
[ Int -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push Int
start, ListNumberStyle -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push ListNumberStyle
style, ListNumberDelim -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push ListNumberDelim
delimiter ]
peekListAttributes :: LuaError e => Peeker e ListAttributes
peekListAttributes :: Peeker e ListAttributes
peekListAttributes = Name -> Peek e ListAttributes -> Peek e ListAttributes
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"ListAttributes" (Peek e ListAttributes -> Peek e ListAttributes)
-> Peeker e ListAttributes -> Peeker e ListAttributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e Int
-> Peeker e ListNumberStyle
-> Peeker e ListNumberDelim
-> Peeker e ListAttributes
forall e a b c.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e c -> Peeker e (a, b, c)
peekTriple
Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral
Peeker e ListNumberStyle
forall a e. Read a => Peeker e a
peekRead
Peeker e ListNumberDelim
forall a e. Read a => Peeker e a
peekRead
instance Peekable Inline where
peek :: StackIndex -> LuaE e Inline
peek = Peek e Inline -> LuaE e Inline
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e Inline -> LuaE e Inline)
-> (StackIndex -> Peek e Inline) -> StackIndex -> LuaE e Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Inline
forall e. LuaError e => Peeker e Inline
peekInline
instance Peekable Block where
peek :: StackIndex -> LuaE e Block
peek = Peek e Block -> LuaE e Block
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e Block -> LuaE e Block)
-> (StackIndex -> Peek e Block) -> StackIndex -> LuaE e Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Block
forall e. LuaError e => Peeker e Block
peekBlock
instance Peekable Meta where
peek :: StackIndex -> LuaE e Meta
peek = Peek e Meta -> LuaE e Meta
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e Meta -> LuaE e Meta)
-> (StackIndex -> Peek e Meta) -> StackIndex -> LuaE e Meta
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Meta
forall e. LuaError e => Peeker e Meta
peekMeta
instance Peekable Pandoc where
peek :: StackIndex -> LuaE e Pandoc
peek = Peek e Pandoc -> LuaE e Pandoc
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e Pandoc -> LuaE e Pandoc)
-> (StackIndex -> Peek e Pandoc) -> StackIndex -> LuaE e Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Pandoc
forall e. LuaError e => Peeker e Pandoc
peekPandoc
instance Peekable Version where
peek :: StackIndex -> LuaE e Version
peek = Peek e Version -> LuaE e Version
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e Version -> LuaE e Version)
-> (StackIndex -> Peek e Version) -> StackIndex -> LuaE e Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Version
forall e. LuaError e => Peeker e Version
peekVersionFuzzy
instance {-# OVERLAPPING #-} Peekable Attr where
peek :: StackIndex -> LuaE e Attr
peek = Peek e Attr -> LuaE e Attr
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e Attr -> LuaE e Attr)
-> (StackIndex -> Peek e Attr) -> StackIndex -> LuaE e Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Attr
forall e. LuaError e => Peeker e Attr
peekAttr