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

Marshaling/unmarshaling functions of table 'Cell' values.
-}
module Text.Pandoc.Lua.Marshal.Cell
  ( peekCell
  , peekCellFuzzy
  , pushCell
  , typeCell
  , mkCell
  ) where

import Control.Applicative (optional)
import Control.Monad ((<$!>))
import Data.Aeson (encode)
import Data.Maybe (fromMaybe)
import HsLua
import Text.Pandoc.Lua.Marshal.Alignment (peekAlignment, pushAlignment)
import Text.Pandoc.Lua.Marshal.Attr (peekAttr, pushAttr)
import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Block
  ( peekBlocksFuzzy, pushBlocks )
import Text.Pandoc.Lua.Marshal.Filter (peekFilter)
import Text.Pandoc.Lua.Marshal.Shared (walkBlocksAndInlines)
import Text.Pandoc.Definition

-- | Push a table cell as a table with fields @attr@, @alignment@,
-- @row_span@, @col_span@, and @contents@.
pushCell :: LuaError e => Cell -> LuaE e ()
pushCell :: forall e. LuaError e => Cell -> LuaE e ()
pushCell = forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> a -> LuaE e ()
pushUD forall e. LuaError e => DocumentedType e Cell
typeCell

-- | Retrieves a 'Cell' object from the stack.
peekCell :: LuaError e => Peeker e Cell
peekCell :: forall e. LuaError e => Peeker e Cell
peekCell = forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Peeker e a
peekUD forall e. LuaError e => DocumentedType e Cell
typeCell

-- | Retrieves a 'Cell' from the stack, accepting either a 'pandoc Cell'
-- userdata object or a table with fields @attr@, @alignment@, @row_span@,
-- @col_span@, and @contents@.
peekCellFuzzy :: LuaError e => Peeker e Cell
peekCellFuzzy :: forall e. LuaError e => Peeker e Cell
peekCellFuzzy StackIndex
idx = forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeUserdata -> forall e. LuaError e => Peeker e Cell
peekCell StackIndex
idx
  Type
TypeTable -> do
    Attr
attr <- forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw forall e. LuaError e => Peeker e Attr
peekAttr Name
"attr" StackIndex
idx
    Alignment
algn <- forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw forall e. Peeker e Alignment
peekAlignment Name
"alignment" StackIndex
idx
    RowSpan
rs   <- Int -> RowSpan
RowSpan forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw forall a e. (Integral a, Read a) => Peeker e a
peekIntegral Name
"row_span" StackIndex
idx
    ColSpan
cs   <- Int -> ColSpan
ColSpan forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw forall a e. (Integral a, Read a) => Peeker e a
peekIntegral Name
"col_span" StackIndex
idx
    [Block]
blks <- forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy Name
"contents" StackIndex
idx
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Attr -> Alignment -> RowSpan -> ColSpan -> [Block] -> Cell
Cell Attr
attr Alignment
algn RowSpan
rs ColSpan
cs [Block]
blks
  Type
_ -> forall a e. ByteString -> Peek e a
failPeek forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"Cell or table" StackIndex
idx

-- | Cell object type.
typeCell :: LuaError e => DocumentedType e Cell
typeCell :: forall e. LuaError e => DocumentedType e Cell
typeCell = forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"pandoc Cell"
  [ 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 Cell
peekCell) TypeSpec
"Cell" 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 Cell
peekCell) 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 Cell
peekCell TypeSpec
"Cell" 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 Cell
typeCell 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
"cell attributes"
      (forall e. LuaError e => Pusher e Attr
pushAttr, \(Cell Attr
attr Alignment
_ RowSpan
_ ColSpan
_ [Block]
_) -> Attr
attr)
      (forall e. LuaError e => Peeker e Attr
peekAttr, \(Cell Attr
_ Alignment
align RowSpan
rs ColSpan
cs [Block]
blks) Attr
attr ->
                   Attr -> Alignment -> RowSpan -> ColSpan -> [Block] -> Cell
Cell Attr
attr Alignment
align RowSpan
rs ColSpan
cs [Block]
blks)
  , 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
"alignment" Text
"alignment of cell contents"
      (forall e. Pusher e Alignment
pushAlignment, \(Cell Attr
_ Alignment
align RowSpan
_ ColSpan
_ [Block]
_) -> Alignment
align)
      (forall e. Peeker e Alignment
peekAlignment, \(Cell Attr
attr Alignment
_ RowSpan
rs ColSpan
cs [Block]
blks) Alignment
align ->
                        Attr -> Alignment -> RowSpan -> ColSpan -> [Block] -> Cell
Cell Attr
attr Alignment
align RowSpan
rs ColSpan
cs [Block]
blks)
  , 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
"row_span" Text
"number of rows over which this cell spans"
      (forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, \(Cell Attr
_ Alignment
_ (RowSpan Int
rs) ColSpan
_ [Block]
_) -> Int
rs)
      (forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \(Cell Attr
attr Alignment
align RowSpan
_ ColSpan
cs [Block]
blks) Int
rs ->
                       Attr -> Alignment -> RowSpan -> ColSpan -> [Block] -> Cell
Cell Attr
attr Alignment
align (Int -> RowSpan
RowSpan Int
rs) ColSpan
cs [Block]
blks)
  , 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
"col_span" Text
"number of columns over which this cell spans"
      (forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, \(Cell Attr
_ Alignment
_ RowSpan
_ (ColSpan Int
rs) [Block]
_) -> Int
rs)
      (forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \(Cell Attr
attr Alignment
align RowSpan
rs ColSpan
_ [Block]
blks) Int
cs ->
                       Attr -> Alignment -> RowSpan -> ColSpan -> [Block] -> Cell
Cell Attr
attr Alignment
align RowSpan
rs (Int -> ColSpan
ColSpan Int
cs) [Block]
blks)
  , 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
"contents" Text
"cell contents"
      (forall e. LuaError e => Pusher e [Block]
pushBlocks, \(Cell Attr
_ Alignment
_ RowSpan
_ ColSpan
_ [Block]
blks) -> [Block]
blks)
      (forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy, \(Cell Attr
attr Alignment
align RowSpan
rs ColSpan
cs [Block]
_) [Block]
blks ->
                          Attr -> Alignment -> RowSpan -> ColSpan -> [Block] -> Cell
Cell Attr
attr Alignment
align RowSpan
rs ColSpan
cs [Block]
blks)

  , forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias AliasIndex
"content"    Text
"alias for contents" [AliasIndex
"contents"]
  , 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
"walk"
    ### flip walkBlocksAndInlines
    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 Cell
peekCell TypeSpec
"Cell" 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 e. LuaError e => Peeker e Filter
peekFilter TypeSpec
"Filter" Text
"lua_filter" Text
"table of filter functions"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Cell -> LuaE e ()
pushCell TypeSpec
"Cell" Text
"modified cell"
  ]

-- | Constructor function for 'Cell' values.
mkCell :: LuaError e => DocumentedFunction e
mkCell :: forall e. LuaError e => DocumentedFunction e
mkCell = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Cell"
  ### liftPure5 (\blocks mAlign mRowSpan mColSpan mAttr -> Cell
                  (fromMaybe nullAttr mAttr)
                  (fromMaybe AlignDefault mAlign)
                  (maybe 1 RowSpan mRowSpan)
                  (maybe 1 ColSpan mColSpan)
                  blocks)
  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 [Block]
peekBlocksFuzzy TypeSpec
"Blocks" Text
"blocks" Text
"document contents"
  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. Peeker e Alignment
peekAlignment TypeSpec
"integer" Text
"align" Text
"cell alignment")
  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. (Integral a, Read a) => Peeker e a
peekIntegral TypeSpec
"integer" Text
"row_span" Text
"rows to span")
  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. (Integral a, Read a) => Peeker e a
peekIntegral TypeSpec
"integer" Text
"col_span" Text
"columns to span")
  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
"cell 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 => Cell -> LuaE e ()
pushCell TypeSpec
"Cell" Text
"new Cell object"