{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeApplications     #-}
{- |
   Module      : Text.Pandoc.Lua.Marshaling.SimpleTable
   Copyright   : © 2020-2021 Albert Krewinkel
   License     : GNU GPL, version 2 or above

   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
   Stability   : alpha

Definition and marshaling of the 'SimpleTable' data type used as a
convenience type when dealing with tables.
-}
module Text.Pandoc.Lua.Marshaling.SimpleTable
  ( SimpleTable (..)
  , peekSimpleTable
  , pushSimpleTable
  )
  where

import Control.Monad ((<$!>))
import HsLua as Lua
import Text.Pandoc.Definition
import Text.Pandoc.Lua.Util (pushViaConstructor)
import Text.Pandoc.Lua.Marshaling.AST

-- | A simple (legacy-style) table.
data SimpleTable = SimpleTable
  { SimpleTable -> [Inline]
simpleTableCaption :: [Inline]
  , SimpleTable -> [Alignment]
simpleTableAlignments :: [Alignment]
  , SimpleTable -> [Double]
simpleTableColumnWidths :: [Double]
  , SimpleTable -> [[Block]]
simpleTableHeader :: [[Block]]
  , SimpleTable -> [[[Block]]]
simpleTableBody :: [[[Block]]]
  }

-- | Push a simple table to the stack by calling the
-- @pandoc.SimpleTable@ constructor.
pushSimpleTable :: forall e. LuaError e => SimpleTable -> LuaE e ()
pushSimpleTable :: SimpleTable -> LuaE e ()
pushSimpleTable SimpleTable
tbl = Name
-> [Inline]
-> [Alignment]
-> [Double]
-> [[Block]]
-> [[[Block]]]
-> LuaE e ()
forall e a. (LuaError e, PushViaCall e a) => Name -> a
pushViaConstructor @e Name
"SimpleTable"
  (SimpleTable -> [Inline]
simpleTableCaption SimpleTable
tbl)
  (SimpleTable -> [Alignment]
simpleTableAlignments SimpleTable
tbl)
  (SimpleTable -> [Double]
simpleTableColumnWidths SimpleTable
tbl)
  (SimpleTable -> [[Block]]
simpleTableHeader SimpleTable
tbl)
  (SimpleTable -> [[[Block]]]
simpleTableBody SimpleTable
tbl)

-- | Retrieve a simple table from the stack.
peekSimpleTable :: forall e. LuaError e => Peeker e SimpleTable
peekSimpleTable :: Peeker e SimpleTable
peekSimpleTable StackIndex
idx = Name -> Peek e SimpleTable -> Peek e SimpleTable
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"SimpleTable" (Peek e SimpleTable -> Peek e SimpleTable)
-> Peek e SimpleTable -> Peek e SimpleTable
forall a b. (a -> b) -> a -> b
$ [Inline]
-> [Alignment]
-> [Double]
-> [[Block]]
-> [[[Block]]]
-> SimpleTable
SimpleTable
  ([Inline]
 -> [Alignment]
 -> [Double]
 -> [[Block]]
 -> [[[Block]]]
 -> SimpleTable)
-> Peek e [Inline]
-> Peek
     e
     ([Alignment]
      -> [Double] -> [[Block]] -> [[[Block]]] -> SimpleTable)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m 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
"caption" StackIndex
idx
  Peek
  e
  ([Alignment]
   -> [Double] -> [[Block]] -> [[[Block]]] -> SimpleTable)
-> Peek e [Alignment]
-> Peek e ([Double] -> [[Block]] -> [[[Block]]] -> SimpleTable)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Peeker e [Alignment] -> Name -> Peeker e [Alignment]
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (Peeker e Alignment -> Peeker e [Alignment]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Alignment
forall a e. Read a => Peeker e a
peekRead) Name
"aligns" StackIndex
idx
  Peek e ([Double] -> [[Block]] -> [[[Block]]] -> SimpleTable)
-> Peek e [Double]
-> Peek e ([[Block]] -> [[[Block]]] -> SimpleTable)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Peeker e [Double] -> Name -> Peeker e [Double]
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (Peeker e Double -> Peeker e [Double]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Double
forall a e. (RealFloat a, Read a) => Peeker e a
peekRealFloat) Name
"widths" StackIndex
idx
  Peek e ([[Block]] -> [[[Block]]] -> SimpleTable)
-> Peek e [[Block]] -> Peek e ([[[Block]]] -> SimpleTable)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Peeker e [[Block]] -> Name -> Peeker e [[Block]]
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (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
"headers" StackIndex
idx
  Peek e ([[[Block]]] -> SimpleTable)
-> Peek e [[[Block]]] -> Peek e SimpleTable
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Peeker e [[[Block]]] -> Name -> Peeker e [[[Block]]]
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (Peeker e [[Block]] -> Peeker e [[[Block]]]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList (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
"rows" StackIndex
idx