{-# LANGUAGE DerivingStrategies   #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{- |
Copyright   : © 2021 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <albert@zeitkraut.de>

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

import HsLua as Lua
import Text.Pandoc.Lua.Marshal.Alignment (peekAlignment, pushAlignment)
import Text.Pandoc.Lua.Marshal.Block (peekBlocksFuzzy, pushBlocks)
import Text.Pandoc.Lua.Marshal.Inline (peekInlinesFuzzy, pushInlines)
import Text.Pandoc.Lua.Marshal.List (pushPandocList)
import Text.Pandoc.Definition

-- | 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]]]
  } deriving stock (SimpleTable -> SimpleTable -> Bool
(SimpleTable -> SimpleTable -> Bool)
-> (SimpleTable -> SimpleTable -> Bool) -> Eq SimpleTable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleTable -> SimpleTable -> Bool
$c/= :: SimpleTable -> SimpleTable -> Bool
== :: SimpleTable -> SimpleTable -> Bool
$c== :: SimpleTable -> SimpleTable -> Bool
Eq, Int -> SimpleTable -> ShowS
[SimpleTable] -> ShowS
SimpleTable -> String
(Int -> SimpleTable -> ShowS)
-> (SimpleTable -> String)
-> ([SimpleTable] -> ShowS)
-> Show SimpleTable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleTable] -> ShowS
$cshowList :: [SimpleTable] -> ShowS
show :: SimpleTable -> String
$cshow :: SimpleTable -> String
showsPrec :: Int -> SimpleTable -> ShowS
$cshowsPrec :: Int -> SimpleTable -> ShowS
Show)

typeSimpleTable :: LuaError e => DocumentedType e SimpleTable
typeSimpleTable :: DocumentedType e SimpleTable
typeSimpleTable = Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) SimpleTable]
-> DocumentedType e SimpleTable
forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"SimpleTable"
  [ 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
$ (SimpleTable -> SimpleTable -> LuaE e Bool)
-> HsFnPrecursor e (SimpleTable -> SimpleTable -> LuaE e Bool)
forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure2 (==)
    HsFnPrecursor e (SimpleTable -> SimpleTable -> LuaE e Bool)
-> Parameter e SimpleTable
-> HsFnPrecursor e (SimpleTable -> LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> DocumentedType e SimpleTable
-> Text -> Text -> Parameter e SimpleTable
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam DocumentedType e SimpleTable
forall e. LuaError e => DocumentedType e SimpleTable
typeSimpleTable Text
"a" Text
""
    HsFnPrecursor e (SimpleTable -> LuaE e Bool)
-> Parameter e SimpleTable -> HsFnPrecursor e (LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> DocumentedType e SimpleTable
-> Text -> Text -> Parameter e SimpleTable
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam DocumentedType e SimpleTable
forall e. LuaError e => DocumentedType e SimpleTable
typeSimpleTable Text
"b" Text
""
    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 Text
"boolean" Text
"whether the two objects 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
$ (SimpleTable -> LuaE e String)
-> HsFnPrecursor e (SimpleTable -> LuaE e String)
forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure show
    HsFnPrecursor e (SimpleTable -> LuaE e String)
-> Parameter e SimpleTable -> HsFnPrecursor e (LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> DocumentedType e SimpleTable
-> Text -> Text -> Parameter e SimpleTable
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam DocumentedType e SimpleTable
forall e. LuaError e => DocumentedType e SimpleTable
typeSimpleTable Text
"self" Text
""
    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 Text
"string" Text
"Haskell string representation"
  ]
  [ Name
-> Text
-> (Pusher e [Inline], SimpleTable -> [Inline])
-> (Peeker e [Inline], SimpleTable -> [Inline] -> SimpleTable)
-> Member e (DocumentedFunction e) SimpleTable
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
"caption" Text
"table caption"
      (Pusher e [Inline]
forall e. LuaError e => Pusher e [Inline]
pushInlines, SimpleTable -> [Inline]
simpleTableCaption)
      (Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy, \SimpleTable
t [Inline]
capt -> SimpleTable
t {simpleTableCaption :: [Inline]
simpleTableCaption = [Inline]
capt})
  , Name
-> Text
-> (Pusher e [Alignment], SimpleTable -> [Alignment])
-> (Peeker e [Alignment],
    SimpleTable -> [Alignment] -> SimpleTable)
-> Member e (DocumentedFunction e) SimpleTable
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
"aligns" Text
"column alignments"
      (Pusher e Alignment -> Pusher e [Alignment]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Alignment
forall e. Pusher e Alignment
pushAlignment, SimpleTable -> [Alignment]
simpleTableAlignments)
      (Peeker e Alignment -> Peeker e [Alignment]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Alignment
forall e. Peeker e Alignment
peekAlignment, \SimpleTable
t [Alignment]
aligns -> SimpleTable
t{simpleTableAlignments :: [Alignment]
simpleTableAlignments = [Alignment]
aligns})
  , Name
-> Text
-> (Pusher e [Double], SimpleTable -> [Double])
-> (Peeker e [Double], SimpleTable -> [Double] -> SimpleTable)
-> Member e (DocumentedFunction e) SimpleTable
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
"widths" Text
"relative column widths"
      (Pusher e Double -> Pusher e [Double]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Double
forall a e. RealFloat a => a -> LuaE e ()
pushRealFloat, SimpleTable -> [Double]
simpleTableColumnWidths)
      (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, \SimpleTable
t [Double]
ws -> SimpleTable
t{simpleTableColumnWidths :: [Double]
simpleTableColumnWidths = [Double]
ws})
  , Name
-> Text
-> (Pusher e [[Block]], SimpleTable -> [[Block]])
-> (Peeker e [[Block]], SimpleTable -> [[Block]] -> SimpleTable)
-> Member e (DocumentedFunction e) SimpleTable
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
"headers" Text
"table header"
      (Pusher e [[Block]]
pushRow, SimpleTable -> [[Block]]
simpleTableHeader)
      (Peeker e [[Block]]
forall e. LuaError e => Peeker e [[Block]]
peekRow, \SimpleTable
t [[Block]]
h -> SimpleTable
t{simpleTableHeader :: [[Block]]
simpleTableHeader = [[Block]]
h})
  , Name
-> Text
-> (Pusher e [[[Block]]], SimpleTable -> [[[Block]]])
-> (Peeker e [[[Block]]],
    SimpleTable -> [[[Block]]] -> SimpleTable)
-> Member e (DocumentedFunction e) SimpleTable
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
"table body rows"
      (Pusher e [[Block]] -> Pusher e [[[Block]]]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e [[Block]]
pushRow, SimpleTable -> [[[Block]]]
simpleTableBody)
      (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]]
peekRow, \SimpleTable
t [[[Block]]]
bs -> SimpleTable
t{simpleTableBody :: [[[Block]]]
simpleTableBody = [[[Block]]]
bs})

  , Name
-> Text
-> (Pusher e Text, SimpleTable -> Text)
-> Member e (DocumentedFunction e) SimpleTable
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"t" Text
"type tag (always 'SimpleTable')"
      (Pusher e Text
forall e. Pusher e Text
pushText, Text -> SimpleTable -> Text
forall a b. a -> b -> a
const Text
"SimpleTable")

  , Name
-> Text
-> [AliasIndex]
-> Member e (DocumentedFunction e) SimpleTable
forall e fn a. Name -> Text -> [AliasIndex] -> Member e fn a
alias Name
"header" Text
"alias for `headers`" [AliasIndex
"headers"]
  ]
 where
  pushRow :: Pusher e [[Block]]
pushRow = Pusher e [Block] -> Pusher e [[Block]]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e [Block]
forall e. LuaError e => Pusher e [Block]
pushBlocks

peekRow :: LuaError e => Peeker e [[Block]]
peekRow :: Peeker e [[Block]]
peekRow = 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]
peekBlocksFuzzy

-- | 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 = UDTypeWithList e (DocumentedFunction e) SimpleTable Void
-> SimpleTable -> LuaE e ()
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD UDTypeWithList e (DocumentedFunction e) SimpleTable Void
forall e. LuaError e => DocumentedType e SimpleTable
typeSimpleTable

-- | Retrieve a simple table from the stack.
peekSimpleTable :: forall e. LuaError e => Peeker e SimpleTable
peekSimpleTable :: Peeker e SimpleTable
peekSimpleTable = 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)
-> Peeker e SimpleTable -> Peeker e SimpleTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UDTypeWithList e (DocumentedFunction e) SimpleTable Void
-> Peeker e SimpleTable
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD UDTypeWithList e (DocumentedFunction e) SimpleTable Void
forall e. LuaError e => DocumentedType e SimpleTable
typeSimpleTable

-- | Constructor for the 'SimpleTable' type.
mkSimpleTable :: LuaError e => DocumentedFunction e
mkSimpleTable :: DocumentedFunction e
mkSimpleTable = Name
-> ([Inline]
    -> [Alignment]
    -> [Double]
    -> [[Block]]
    -> [[[Block]]]
    -> LuaE e SimpleTable)
-> HsFnPrecursor
     e
     ([Inline]
      -> [Alignment]
      -> [Double]
      -> [[Block]]
      -> [[[Block]]]
      -> LuaE e SimpleTable)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"SimpleTable"
  ### liftPure5 SimpleTable
  HsFnPrecursor
  e
  ([Inline]
   -> [Alignment]
   -> [Double]
   -> [[Block]]
   -> [[[Block]]]
   -> LuaE e SimpleTable)
-> Parameter e [Inline]
-> HsFnPrecursor
     e
     ([Alignment]
      -> [Double] -> [[Block]] -> [[[Block]]] -> LuaE e SimpleTable)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Inline] -> Text -> Text -> Text -> Parameter e [Inline]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy Text
"Inlines" Text
"caption"
        Text
"table caption"
  HsFnPrecursor
  e
  ([Alignment]
   -> [Double] -> [[Block]] -> [[[Block]]] -> LuaE e SimpleTable)
-> Parameter e [Alignment]
-> HsFnPrecursor
     e ([Double] -> [[Block]] -> [[[Block]]] -> LuaE e SimpleTable)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Alignment]
-> Text -> Text -> Text -> Parameter e [Alignment]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (Peeker e Alignment -> Peeker e [Alignment]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Alignment
forall e. Peeker e Alignment
peekAlignment) Text
"{Alignment,...}" Text
"align"
        Text
"column alignments"
  HsFnPrecursor
  e ([Double] -> [[Block]] -> [[[Block]]] -> LuaE e SimpleTable)
-> Parameter e [Double]
-> HsFnPrecursor e ([[Block]] -> [[[Block]]] -> LuaE e SimpleTable)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Double] -> Text -> Text -> Text -> Parameter e [Double]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (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) Text
"{number,...}" Text
"widths"
        Text
"relative column widths"
  HsFnPrecursor e ([[Block]] -> [[[Block]]] -> LuaE e SimpleTable)
-> Parameter e [[Block]]
-> HsFnPrecursor e ([[[Block]]] -> LuaE e SimpleTable)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [[Block]] -> Text -> Text -> Text -> Parameter e [[Block]]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e [[Block]]
forall e. LuaError e => Peeker e [[Block]]
peekRow Text
"{Blocks,...}" Text
"header"
        Text
"table header row"
  HsFnPrecursor e ([[[Block]]] -> LuaE e SimpleTable)
-> Parameter e [[[Block]]] -> HsFnPrecursor e (LuaE e SimpleTable)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [[[Block]]]
-> Text -> Text -> Text -> Parameter e [[[Block]]]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (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]]
peekRow) Text
"{{Blocks,...},...}" Text
"body"
        Text
"table body rows"
  HsFnPrecursor e (LuaE e SimpleTable)
-> FunctionResults e SimpleTable -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e SimpleTable
-> Text -> Text -> FunctionResults e SimpleTable
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e SimpleTable
forall e. LuaError e => SimpleTable -> LuaE e ()
pushSimpleTable Text
"SimpleTable" Text
"new SimpleTable object"