{-# LANGUAGE OverloadedStrings    #-}
{- |
Copyright               : © 2021-2023 Albert Krewinkel
SPDX-License-Identifier : MIT
Maintainer              : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>

Marshaling/unmarshaling functions of 'TableFoot' values.
-}
module Text.Pandoc.Lua.Marshal.TableFoot
  ( peekTableFoot
  , pushTableFoot
  , typeTableFoot
  , mkTableFoot
  ) where

import Control.Applicative (optional)
import Data.Aeson (encode)
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

-- | Push a TableFoot as a userdata value.
pushTableFoot :: LuaError e => TableFoot -> LuaE e ()
pushTableFoot :: forall e. LuaError e => TableFoot -> LuaE e ()
pushTableFoot = forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> a -> LuaE e ()
pushUD forall e. LuaError e => DocumentedType e TableFoot
typeTableFoot

-- | Retrieves a 'Cell' from the stack.
peekTableFoot :: LuaError e => Peeker e TableFoot
peekTableFoot :: forall e. LuaError e => Peeker e TableFoot
peekTableFoot = forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Peeker e a
peekUD forall e. LuaError e => DocumentedType e TableFoot
typeTableFoot

-- | Row object type.
typeTableFoot :: LuaError e => DocumentedType e TableFoot
typeTableFoot :: forall e. LuaError e => DocumentedType e TableFoot
typeTableFoot = forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"pandoc TableFoot"
  [ forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Eq forall a b. (a -> b) -> a -> b
$ forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"__eq"
     ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b))
     forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => Peeker e TableFoot
peekTableFoot) TypeSpec
"TableFoot" Text
"self" Text
""
     forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => Peeker e TableFoot
peekTableFoot) TypeSpec
"any" Text
"object" Text
""
     forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. Pusher e Bool
pushBool TypeSpec
"boolean" Text
"true iff the two values are equal"
  , forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Tostring forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure show
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e TableFoot
peekTableFoot TypeSpec
"TableFoot" Text
"self" Text
""
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. String -> LuaE e ()
pushString TypeSpec
"string" Text
"native Haskell representation"
  , forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation (Name -> Operation
CustomOperation Name
"__tojson") forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure encode
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam forall e. LuaError e => DocumentedType e TableFoot
typeTableFoot Text
"self" Text
""
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. Pusher e ByteString
pushLazyByteString TypeSpec
"string" Text
"JSON representation"
  ]
  [ 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
"attr" Text
"table foot attributes"
      (forall e. LuaError e => Pusher e Attr
pushAttr, \(TableFoot Attr
attr [Row]
_) -> Attr
attr)
      (forall e. LuaError e => Peeker e Attr
peekAttr, \(TableFoot Attr
_ [Row]
cells) Attr
attr ->
                   Attr -> [Row] -> TableFoot
TableFoot Attr
attr [Row]
cells)
  , 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
"rows" Text
"footer rows"
      (forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList forall e. LuaError e => Row -> LuaE e ()
pushRow, \(TableFoot Attr
_ [Row]
rows) -> [Row]
rows)
      (forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e Row
peekRowFuzzy, \(TableFoot Attr
attr [Row]
_) [Row]
rows ->
                                Attr -> [Row] -> TableFoot
TableFoot Attr
attr [Row]
rows)

  , forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias AliasIndex
"identifier" Text
"cell ID"         [AliasIndex
"attr", AliasIndex
"identifier"]
  , forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias AliasIndex
"classes"    Text
"cell classes"    [AliasIndex
"attr", AliasIndex
"classes"]
  , forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias AliasIndex
"attributes" Text
"cell attributes" [AliasIndex
"attr", AliasIndex
"attributes"]

  , forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method forall a b. (a -> b) -> a -> b
$ forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"clone"
    ### return
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e TableFoot
peekTableFoot TypeSpec
"TableFoot" Text
"self" Text
""
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => TableFoot -> LuaE e ()
pushTableFoot TypeSpec
"TableFoot" Text
"cloned object"
  ]

-- | Constructor function for 'Row' values.
mkTableFoot :: LuaError e => DocumentedFunction e
mkTableFoot :: forall e. LuaError e => DocumentedFunction e
mkTableFoot = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"TableFoot"
  ### liftPure2 (\mCells mAttr -> TableFoot
                  (fromMaybe nullAttr mAttr)
                  (fromMaybe [] mCells))
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e Row
peekRowFuzzy) TypeSpec
"{Row,...}" Text
"rows" Text
"footer rows")
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Attr
peekAttr TypeSpec
"Attr" Text
"attr" Text
"table foot attributes")
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => TableFoot -> LuaE e ()
pushTableFoot TypeSpec
"TableFoot" Text
"new TableFoot object"