{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Lua.Marshal.TableFoot
( peekTableFoot
, pushTableFoot
, typeTableFoot
, mkTableFoot
) where
import Control.Applicative (optional)
import Data.Maybe (fromMaybe)
import HsLua
import Text.Pandoc.Lua.Marshal.Attr (peekAttr, pushAttr)
import Text.Pandoc.Lua.Marshal.List (pushPandocList)
import Text.Pandoc.Lua.Marshal.Row (peekRowFuzzy, pushRow)
import Text.Pandoc.Definition
pushTableFoot :: LuaError e => TableFoot -> LuaE e ()
= UDTypeWithList e (DocumentedFunction e) TableFoot Void
-> TableFoot -> LuaE e ()
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD UDTypeWithList e (DocumentedFunction e) TableFoot Void
forall e. LuaError e => DocumentedType e TableFoot
typeTableFoot
peekTableFoot :: LuaError e => Peeker e TableFoot
= UDTypeWithList e (DocumentedFunction e) TableFoot Void
-> Peeker e TableFoot
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD UDTypeWithList e (DocumentedFunction e) TableFoot Void
forall e. LuaError e => DocumentedType e TableFoot
typeTableFoot
typeTableFoot :: LuaError e => DocumentedType e TableFoot
= Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) TableFoot]
-> DocumentedType e TableFoot
forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype "pandoc TableFoot"
[ 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 TableFoot -> Maybe TableFoot -> LuaE e Bool)
-> HsFnPrecursor
e (Maybe TableFoot -> Maybe TableFoot -> LuaE e Bool)
forall a e. Name -> a -> HsFnPrecursor e a
defun "__eq"
### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b))
HsFnPrecursor e (Maybe TableFoot -> Maybe TableFoot -> LuaE e Bool)
-> Parameter e (Maybe TableFoot)
-> HsFnPrecursor e (Maybe TableFoot -> LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e (Maybe TableFoot)
-> Text -> Text -> Text -> Parameter e (Maybe TableFoot)
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (Peek e TableFoot -> Peek e (Maybe TableFoot)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e TableFoot -> Peek e (Maybe TableFoot))
-> (StackIndex -> Peek e TableFoot) -> Peeker e (Maybe TableFoot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e TableFoot
forall e. LuaError e => Peeker e TableFoot
peekTableFoot) "TableFoot" "self" ""
HsFnPrecursor e (Maybe TableFoot -> LuaE e Bool)
-> Parameter e (Maybe TableFoot) -> HsFnPrecursor e (LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e (Maybe TableFoot)
-> Text -> Text -> Text -> Parameter e (Maybe TableFoot)
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (Peek e TableFoot -> Peek e (Maybe TableFoot)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e TableFoot -> Peek e (Maybe TableFoot))
-> (StackIndex -> Peek e TableFoot) -> Peeker e (Maybe TableFoot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e TableFoot
forall e. LuaError e => Peeker e TableFoot
peekTableFoot) "any" "object" ""
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 "boolean" "true iff the two values are equal"
, Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Tostring (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (TableFoot -> LuaE e String)
-> HsFnPrecursor e (TableFoot -> LuaE e String)
forall a e. a -> HsFnPrecursor e a
lambda
### liftPure show
HsFnPrecursor e (TableFoot -> LuaE e String)
-> Parameter e TableFoot -> HsFnPrecursor e (LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> (StackIndex -> Peek e TableFoot)
-> Text -> Text -> Text -> Parameter e TableFoot
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter StackIndex -> Peek e TableFoot
forall e. LuaError e => Peeker e TableFoot
peekTableFoot "TableFoot" "self" ""
HsFnPrecursor e (LuaE e String)
-> FunctionResults e String -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e String -> Text -> Text -> FunctionResults e String
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e String
forall e. String -> LuaE e ()
pushString "string" "native Haskell representation"
]
[ Name
-> Text
-> (Pusher e Attr, TableFoot -> Attr)
-> (Peeker e Attr, TableFoot -> Attr -> TableFoot)
-> Member e (DocumentedFunction e) TableFoot
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 "attr" "table foot attributes"
(Pusher e Attr
forall e. LuaError e => Pusher e Attr
pushAttr, \(TableFoot attr :: Attr
attr _) -> Attr
attr)
(Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr, \(TableFoot _ cells :: [Row]
cells) attr :: Attr
attr ->
Attr -> [Row] -> TableFoot
TableFoot Attr
attr [Row]
cells)
, Name
-> Text
-> (Pusher e [Row], TableFoot -> [Row])
-> (Peeker e [Row], TableFoot -> [Row] -> TableFoot)
-> Member e (DocumentedFunction e) TableFoot
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 "rows" "footer rows"
(Pusher e Row -> Pusher e [Row]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Row
forall e. LuaError e => Row -> LuaE e ()
pushRow, \(TableFoot _ rows :: [Row]
rows) -> [Row]
rows)
(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
peekRowFuzzy, \(TableFoot attr :: Attr
attr _) rows :: [Row]
rows ->
Attr -> [Row] -> TableFoot
TableFoot Attr
attr [Row]
rows)
, AliasIndex
-> Text
-> [AliasIndex]
-> Member e (DocumentedFunction e) TableFoot
forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias "identifier" "cell ID" ["attr", "identifier"]
, AliasIndex
-> Text
-> [AliasIndex]
-> Member e (DocumentedFunction e) TableFoot
forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias "classes" "cell classes" ["attr", "classes"]
, AliasIndex
-> Text
-> [AliasIndex]
-> Member e (DocumentedFunction e) TableFoot
forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias "attributes" "cell attributes" ["attr", "attributes"]
, DocumentedFunction e -> Member e (DocumentedFunction e) TableFoot
forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method (DocumentedFunction e -> Member e (DocumentedFunction e) TableFoot)
-> DocumentedFunction e
-> Member e (DocumentedFunction e) TableFoot
forall a b. (a -> b) -> a -> b
$ Name
-> (TableFoot -> LuaE e TableFoot)
-> HsFnPrecursor e (TableFoot -> LuaE e TableFoot)
forall a e. Name -> a -> HsFnPrecursor e a
defun "clone"
### return
HsFnPrecursor e (TableFoot -> LuaE e TableFoot)
-> Parameter e TableFoot -> HsFnPrecursor e (LuaE e TableFoot)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> (StackIndex -> Peek e TableFoot)
-> Text -> Text -> Text -> Parameter e TableFoot
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter StackIndex -> Peek e TableFoot
forall e. LuaError e => Peeker e TableFoot
peekTableFoot "TableFoot" "self" ""
HsFnPrecursor e (LuaE e TableFoot)
-> FunctionResults e TableFoot -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e TableFoot -> Text -> Text -> FunctionResults e TableFoot
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e TableFoot
forall e. LuaError e => TableFoot -> LuaE e ()
pushTableFoot "TableFoot" "cloned object"
]
mkTableFoot :: LuaError e => DocumentedFunction e
= Name
-> (Maybe [Row] -> Maybe Attr -> LuaE e TableFoot)
-> HsFnPrecursor e (Maybe [Row] -> Maybe Attr -> LuaE e TableFoot)
forall a e. Name -> a -> HsFnPrecursor e a
defun "TableFoot"
### liftPure2 (\mCells mAttr -> TableFoot
(fromMaybe nullAttr mAttr)
(fromMaybe [] mCells))
HsFnPrecursor e (Maybe [Row] -> Maybe Attr -> LuaE e TableFoot)
-> Parameter e (Maybe [Row])
-> HsFnPrecursor e (Maybe Attr -> LuaE e TableFoot)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e [Row] -> Parameter e (Maybe [Row])
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Peeker e [Row] -> Text -> Text -> Text -> Parameter e [Row]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (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
peekRowFuzzy) "{Row,...}" "rows" "footer rows")
HsFnPrecursor e (Maybe Attr -> LuaE e TableFoot)
-> Parameter e (Maybe Attr) -> HsFnPrecursor e (LuaE e TableFoot)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e Attr -> Parameter e (Maybe Attr)
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Peeker e Attr -> Text -> Text -> Text -> Parameter e Attr
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Attr
forall e. LuaError e => Peeker e Attr
peekAttr "Attr" "attr" "table foot attributes")
HsFnPrecursor e (LuaE e TableFoot)
-> FunctionResults e TableFoot -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e TableFoot -> Text -> Text -> FunctionResults e TableFoot
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e TableFoot
forall e. LuaError e => TableFoot -> LuaE e ()
pushTableFoot "TableFoot" "new TableFoot object"