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

Marshaling/unmarshaling functions of types that are used exclusively
with tables.
-}
module Text.Pandoc.Lua.Marshal.TableParts
  ( peekCaption
  , pushCaption
  , peekColSpec
  , pushColSpec
  , peekRow
  , pushRow
  , peekTableBody
  , pushTableBody
  , peekTableFoot
  , pushTableFoot
  , peekTableHead
  , pushTableHead
  ) where

import Control.Applicative (optional)
import Control.Monad ((<$!>))
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.Cell (peekCell, pushCell)
import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Inline
  ( peekInlinesFuzzy, pushInlines )
import Text.Pandoc.Lua.Marshal.List (pushPandocList)
import Text.Pandoc.Definition

-- | Push Caption element
pushCaption :: LuaError e => Caption -> LuaE e ()
pushCaption :: Caption -> LuaE e ()
pushCaption (Caption Maybe ShortCaption
shortCaption [Block]
longCaption) = do
  LuaE e ()
forall e. LuaE e ()
newtable
  Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
addField Name
"short" (LuaE e ()
-> (ShortCaption -> LuaE e ()) -> Maybe ShortCaption -> LuaE e ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LuaE e ()
forall e. LuaE e ()
pushnil ShortCaption -> LuaE e ()
forall e. LuaError e => Pusher e ShortCaption
pushInlines Maybe ShortCaption
shortCaption)
  Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
addField Name
"long" (Pusher e [Block]
forall e. LuaError e => Pusher e [Block]
pushBlocks [Block]
longCaption)

-- | Peek Caption element
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 ShortCaption
short <- Peek e ShortCaption -> Peek e (Maybe ShortCaption)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e ShortCaption -> Peek e (Maybe ShortCaption))
-> Peek e ShortCaption -> Peek e (Maybe ShortCaption)
forall a b. (a -> b) -> a -> b
$ Peeker e ShortCaption -> Name -> Peeker e ShortCaption
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e ShortCaption
forall e. LuaError e => Peeker e ShortCaption
peekInlinesFuzzy 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]
peekBlocksFuzzy 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 ShortCaption -> [Block] -> Caption
Caption Maybe ShortCaption
short [Block]
long

-- | Push a ColSpec value as a pair of Alignment and ColWidth.
pushColSpec :: LuaError e => Pusher e ColSpec
pushColSpec :: Pusher e ColSpec
pushColSpec = Pusher e Alignment -> Pusher e ColWidth -> Pusher e ColSpec
forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> (a, b) -> LuaE e ()
pushPair Pusher e Alignment
forall e. Pusher e Alignment
pushAlignment Pusher e ColWidth
forall e. LuaError e => Pusher e ColWidth
pushColWidth

-- | Peek a ColSpec value as a pair of Alignment and ColWidth.
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 e. Peeker e Alignment
peekAlignment Peeker e ColWidth
forall e. Peeker e ColWidth
peekColWidth

peekColWidth :: 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)

-- | Push a ColWidth value by pushing the width as a plain number, or
-- @nil@ for ColWidthDefault.
pushColWidth :: LuaError e => Pusher e ColWidth
pushColWidth :: Pusher e ColWidth
pushColWidth = \case
  (ColWidth Double
w)    -> Double -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push Double
w
  ColWidth
ColWidthDefault -> LuaE e ()
forall e. LuaE e ()
pushnil

-- | Push a table row as a pair of attr and the list of cells.
pushRow :: LuaError e => Pusher e Row
pushRow :: Pusher e Row
pushRow (Row Attr
attr [Cell]
cells) =
  Pusher e Attr -> Pusher e [Cell] -> (Attr, [Cell]) -> LuaE e ()
forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> (a, b) -> LuaE e ()
pushPair Pusher e Attr
forall e. LuaError e => Pusher e Attr
pushAttr (Pusher e Cell -> Pusher e [Cell]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Cell
forall e. LuaError e => Cell -> LuaE e ()
pushCell) (Attr
attr, [Cell]
cells)

-- | Push a table row from a pair of attr and the list of cells.
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)

-- | Pushes a 'TableBody' value as a Lua table with fields @attr@,
-- @row_head_columns@, @head@, and @body@.
pushTableBody :: LuaError e => Pusher e TableBody
pushTableBody :: Pusher e TableBody
pushTableBody (TableBody Attr
attr (RowHeadColumns Int
rowHeadColumns) [Row]
head' [Row]
body) = do
    LuaE e ()
forall e. LuaE e ()
newtable
    Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
addField Name
"attr" (Pusher e Attr
forall e. LuaError e => Pusher e Attr
pushAttr Attr
attr)
    Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
addField Name
"row_head_columns" (Int -> LuaE e ()
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral Int
rowHeadColumns)
    Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
addField Name
"head" (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 => Pusher e Row
pushRow [Row]
head')
    Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
addField Name
"body" (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 => Pusher e Row
pushRow [Row]
body)

-- | Retrieves a 'TableBody' value from a Lua table with fields @attr@,
-- @row_head_columns@, @head@, and @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
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

-- | Push a table head value as the pair of its Attr and rows.
pushTableHead :: LuaError e => Pusher e TableHead
pushTableHead :: Pusher e TableHead
pushTableHead (TableHead Attr
attr [Row]
rows) =
  Pusher e Attr -> Pusher e [Row] -> (Attr, [Row]) -> LuaE e ()
forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> (a, b) -> LuaE e ()
pushPair Pusher e Attr
forall e. LuaError e => Pusher e Attr
pushAttr (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 => Pusher e Row
pushRow) (Attr
attr, [Row]
rows)

-- | Peek a table head value from a pair of Attr and 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)

-- | Pushes a 'TableFoot' value as a pair of the Attr value and the list
-- of table rows.
pushTableFoot :: LuaError e => Pusher e TableFoot
pushTableFoot :: Pusher e TableFoot
pushTableFoot (TableFoot Attr
attr [Row]
rows) =
  Pusher e Attr -> Pusher e [Row] -> (Attr, [Row]) -> LuaE e ()
forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> (a, b) -> LuaE e ()
pushPair Pusher e Attr
forall e. LuaError e => Pusher e Attr
pushAttr (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 => Pusher e Row
pushRow) (Attr
attr, [Row]
rows)

-- | Retrieves a 'TableFoot' value from a pair containing an Attr value
-- and a list of table rows.
peekTableFoot :: LuaError e => Peeker e TableFoot
peekTableFoot :: Peeker e TableFoot
peekTableFoot = ((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)

-- | Add a value to the table at the top of the stack at a string-index.
addField :: LuaError e => Name -> LuaE e () -> LuaE e ()
addField :: Name -> LuaE e () -> LuaE e ()
addField Name
key LuaE e ()
pushValue = do
  Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
key
  LuaE e ()
pushValue
  StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)