{-# LANGUAGE DerivingStrategies   #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{- |
Copyright   : © 2021-2024 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 Control.Applicative (optional)
import Data.Maybe (fromMaybe)
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
import qualified Data.Text as T

-- | 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
$c== :: SimpleTable -> SimpleTable -> Bool
== :: SimpleTable -> SimpleTable -> Bool
$c/= :: SimpleTable -> SimpleTable -> Bool
/= :: 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
$cshowsPrec :: Int -> SimpleTable -> ShowS
showsPrec :: Int -> SimpleTable -> ShowS
$cshow :: SimpleTable -> String
show :: SimpleTable -> String
$cshowList :: [SimpleTable] -> ShowS
showList :: [SimpleTable] -> ShowS
Show)

typeSimpleTable :: LuaError e => DocumentedType e SimpleTable
typeSimpleTable :: forall e. LuaError e => 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
$ (Maybe SimpleTable -> Maybe SimpleTable -> LuaE e Bool)
-> HsFnPrecursor
     e (Maybe SimpleTable -> Maybe SimpleTable -> LuaE e Bool)
forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b))
    HsFnPrecursor
  e (Maybe SimpleTable -> Maybe SimpleTable -> LuaE e Bool)
-> Parameter e (Maybe SimpleTable)
-> HsFnPrecursor e (Maybe SimpleTable -> LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e (Maybe SimpleTable)
-> TypeSpec -> Text -> Text -> Parameter e (Maybe SimpleTable)
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (Peek e SimpleTable -> Peek e (Maybe SimpleTable)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e SimpleTable -> Peek e (Maybe SimpleTable))
-> (StackIndex -> Peek e SimpleTable)
-> Peeker e (Maybe SimpleTable)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e SimpleTable
forall e. LuaError e => Peeker e SimpleTable
peekSimpleTable) TypeSpec
"value" Text
"a" Text
""
    HsFnPrecursor e (Maybe SimpleTable -> LuaE e Bool)
-> Parameter e (Maybe SimpleTable) -> HsFnPrecursor e (LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e (Maybe SimpleTable)
-> TypeSpec -> Text -> Text -> Parameter e (Maybe SimpleTable)
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (Peek e SimpleTable -> Peek e (Maybe SimpleTable)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e SimpleTable -> Peek e (Maybe SimpleTable))
-> (StackIndex -> Peek e SimpleTable)
-> Peeker e (Maybe SimpleTable)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e SimpleTable
forall e. LuaError e => Peeker e SimpleTable
peekSimpleTable) TypeSpec
"value" 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 -> TypeSpec -> Text -> FunctionResults e Bool
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e Bool
forall e. Pusher e Bool
pushBool TypeSpec
"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 -> TypeSpec -> Text -> FunctionResults e String
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e String
forall e. String -> LuaE e ()
pushString TypeSpec
"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 = 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 = 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 = 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 = 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 = 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")

  , AliasIndex
-> Text
-> [AliasIndex]
-> Member e (DocumentedFunction e) SimpleTable
forall e fn a. AliasIndex -> Text -> [AliasIndex] -> Member e fn a
alias AliasIndex
"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 :: forall e. LuaError e => 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 :: forall e. LuaError e => SimpleTable -> LuaE e ()
pushSimpleTable = DocumentedTypeWithList e SimpleTable Void
-> SimpleTable -> LuaE e ()
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> a -> LuaE e ()
pushUD DocumentedTypeWithList 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 :: forall e. LuaError e => 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)
-> (StackIndex -> Peek e SimpleTable)
-> StackIndex
-> Peek e SimpleTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocumentedTypeWithList e SimpleTable Void
-> StackIndex -> Peek e SimpleTable
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Peeker e a
peekUD DocumentedTypeWithList e SimpleTable Void
forall e. LuaError e => DocumentedType e SimpleTable
typeSimpleTable

-- | Constructor for the 'SimpleTable' type.
mkSimpleTable :: LuaError e => DocumentedFunction e
mkSimpleTable :: forall e. LuaError e => 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]
-> TypeSpec -> Text -> Text -> Parameter e [Inline]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [Inline]
forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy TypeSpec
"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]
-> TypeSpec -> Text -> Text -> Parameter e [Alignment]
forall e a. Peeker e a -> TypeSpec -> 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) TypeSpec
"{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]
-> TypeSpec -> Text -> Text -> Parameter e [Double]
forall e a. Peeker e a -> TypeSpec -> 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) TypeSpec
"{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]]
-> TypeSpec -> Text -> Text -> Parameter e [[Block]]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [[Block]]
forall e. LuaError e => Peeker e [[Block]]
peekRow TypeSpec
"{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]]]
-> TypeSpec -> Text -> Text -> Parameter e [[[Block]]]
forall e a. Peeker e a -> TypeSpec -> 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) TypeSpec
"{{Blocks,...},...}" Text
"rows"
        Text
"table 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
-> TypeSpec -> Text -> FunctionResults e SimpleTable
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e SimpleTable
forall e. LuaError e => SimpleTable -> LuaE e ()
pushSimpleTable TypeSpec
"SimpleTable" Text
"new SimpleTable object"
  #? T.unlines
  [ "Usage:"
  , " "
  , "    local caption = \"Overview\""
  , "    local aligns = {pandoc.AlignDefault, pandoc.AlignDefault}"
  , "    local widths = {0, 0} -- let pandoc determine col widths"
  , "    local headers = {{pandoc.Plain({pandoc.Str \"Language\"})},"
  , "                     {pandoc.Plain({pandoc.Str \"Typing\"})}}"
  , "    local rows = {"
  , "      {{pandoc.Plain \"Haskell\"}, {pandoc.Plain \"static\"}},"
  , "      {{pandoc.Plain \"Lua\"}, {pandoc.Plain \"Dynamic\"}},"
  , "    }"
  , "    simple_table = pandoc.SimpleTable("
  , "      caption,"
  , "      aligns,"
  , "      widths,"
  , "      headers,"
  , "      rows"
  , "    )"
  ]