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

Marshaling/unmarshaling functions and constructor for 'ListAttributes'
values.
-}
module Text.Pandoc.Lua.Marshal.ListAttributes
  ( typeListAttributes
  , peekListAttributes
  , pushListAttributes
  , mkListAttributes
  , peekListNumberDelim
  , pushListNumberDelim
  , peekListNumberStyle
  , pushListNumberStyle
  ) where

import Data.Maybe (fromMaybe)
import HsLua
import Text.Pandoc.Definition
  ( ListAttributes, ListNumberStyle (..), ListNumberDelim (..))

-- | 'ListAttributes' Lua object type.
typeListAttributes :: LuaError e => DocumentedType e ListAttributes
typeListAttributes :: DocumentedType e ListAttributes
typeListAttributes = Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) ListAttributes]
-> DocumentedType e ListAttributes
forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"ListAttributes"
  [ 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
$ (ListAttributes -> ListAttributes -> LuaE e Bool)
-> HsFnPrecursor
     e (ListAttributes -> ListAttributes -> LuaE e Bool)
forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure2 (==)
    HsFnPrecursor e (ListAttributes -> ListAttributes -> LuaE e Bool)
-> Parameter e ListAttributes
-> HsFnPrecursor e (ListAttributes -> LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e ListAttributes
-> Text -> Text -> Text -> Parameter e ListAttributes
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e ListAttributes
forall e. LuaError e => Peeker e ListAttributes
peekListAttributes Text
"a" Text
"ListAttributes" Text
""
    HsFnPrecursor e (ListAttributes -> LuaE e Bool)
-> Parameter e ListAttributes -> HsFnPrecursor e (LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e ListAttributes
-> Text -> Text -> Text -> Parameter e ListAttributes
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e ListAttributes
forall e. LuaError e => Peeker e ListAttributes
peekListAttributes Text
"b" Text
"ListAttributes" 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 are equal"
  ]
  [ Name
-> Text
-> (Pusher e Int, ListAttributes -> Int)
-> (Peeker e Int, ListAttributes -> Int -> ListAttributes)
-> Member e (DocumentedFunction e) ListAttributes
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
"start" Text
"number of the first list item"
      (Pusher e Int
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, \(Int
start,ListNumberStyle
_,ListNumberDelim
_) -> Int
start)
      (Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \(Int
_,ListNumberStyle
style,ListNumberDelim
delim) -> (,ListNumberStyle
style,ListNumberDelim
delim))
  , Name
-> Text
-> (Pusher e ListNumberStyle, ListAttributes -> ListNumberStyle)
-> (Peeker e ListNumberStyle,
    ListAttributes -> ListNumberStyle -> ListAttributes)
-> Member e (DocumentedFunction e) ListAttributes
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
"style" Text
"style used for list numbering"
      (Pusher e ListNumberStyle
forall e. Pusher e ListNumberStyle
pushListNumberStyle, \(Int
_,ListNumberStyle
style,ListNumberDelim
_) -> ListNumberStyle
style)
      (Peeker e ListNumberStyle
forall e. Peeker e ListNumberStyle
peekListNumberStyle, \(Int
start,ListNumberStyle
_,ListNumberDelim
delim) -> (Int
start,,ListNumberDelim
delim))
  , Name
-> Text
-> (Pusher e ListNumberDelim, ListAttributes -> ListNumberDelim)
-> (Peeker e ListNumberDelim,
    ListAttributes -> ListNumberDelim -> ListAttributes)
-> Member e (DocumentedFunction e) ListAttributes
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
"delimiter" Text
"delimiter of list numbers"
      (Pusher e ListNumberDelim
forall e. Pusher e ListNumberDelim
pushListNumberDelim, \(Int
_,ListNumberStyle
_,ListNumberDelim
delim) -> ListNumberDelim
delim)
      (Peeker e ListNumberDelim
forall e. Peeker e ListNumberDelim
peekListNumberDelim, \(Int
start,ListNumberStyle
style,ListNumberDelim
_) -> (Int
start,ListNumberStyle
style,))
  , DocumentedFunction e
-> Member e (DocumentedFunction e) ListAttributes
forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method (DocumentedFunction e
 -> Member e (DocumentedFunction e) ListAttributes)
-> DocumentedFunction e
-> Member e (DocumentedFunction e) ListAttributes
forall a b. (a -> b) -> a -> b
$ Name
-> (ListAttributes -> LuaE e ListAttributes)
-> HsFnPrecursor e (ListAttributes -> LuaE e ListAttributes)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"clone"
    ### return
    HsFnPrecursor e (ListAttributes -> LuaE e ListAttributes)
-> Parameter e ListAttributes
-> HsFnPrecursor e (LuaE e ListAttributes)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> DocumentedType e ListAttributes
-> Text -> Text -> Parameter e ListAttributes
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam DocumentedType e ListAttributes
forall e. LuaError e => DocumentedType e ListAttributes
typeListAttributes Text
"a" Text
""
    HsFnPrecursor e (LuaE e ListAttributes)
-> FunctionResults e ListAttributes -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e ListAttributes
-> Text -> Text -> FunctionResults e ListAttributes
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult (DocumentedType e ListAttributes -> Pusher e ListAttributes
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD DocumentedType e ListAttributes
forall e. LuaError e => DocumentedType e ListAttributes
typeListAttributes) Text
"ListAttributes"
          Text
"cloned ListAttributes value"
  ]

-- | Pushes a 'ListAttributes' value as userdata object.
pushListAttributes :: LuaError e => Pusher e ListAttributes
pushListAttributes :: Pusher e ListAttributes
pushListAttributes = UDTypeWithList e (DocumentedFunction e) ListAttributes Void
-> Pusher e ListAttributes
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD UDTypeWithList e (DocumentedFunction e) ListAttributes Void
forall e. LuaError e => DocumentedType e ListAttributes
typeListAttributes

-- | Retrieve a 'ListAttributes' triple, either from userdata or from a
-- Lua tuple.
peekListAttributes :: LuaError e => Peeker e ListAttributes
peekListAttributes :: Peeker e ListAttributes
peekListAttributes = Name -> Peek e ListAttributes -> Peek e ListAttributes
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"ListAttributes" (Peek e ListAttributes -> Peek e ListAttributes)
-> Peeker e ListAttributes -> Peeker e ListAttributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Peeker e ListAttributes] -> Peeker e ListAttributes
forall e a. LuaError e => [Peeker e a] -> Peeker e a
choice
  [ UDTypeWithList e (DocumentedFunction e) ListAttributes Void
-> Peeker e ListAttributes
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD UDTypeWithList e (DocumentedFunction e) ListAttributes Void
forall e. LuaError e => DocumentedType e ListAttributes
typeListAttributes
  , Peeker e Int
-> Peeker e ListNumberStyle
-> Peeker e ListNumberDelim
-> Peeker e ListAttributes
forall e a b c.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e c -> Peeker e (a, b, c)
peekTriple Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral Peeker e ListNumberStyle
forall a e. Read a => Peeker e a
peekRead Peeker e ListNumberDelim
forall a e. Read a => Peeker e a
peekRead
  ]

-- | Constructor for a new 'ListAttributes' value.
mkListAttributes :: LuaError e => DocumentedFunction e
mkListAttributes :: DocumentedFunction e
mkListAttributes = Name
-> (Maybe Int
    -> Maybe ListNumberStyle
    -> Maybe ListNumberDelim
    -> LuaE e ListAttributes)
-> HsFnPrecursor
     e
     (Maybe Int
      -> Maybe ListNumberStyle
      -> Maybe ListNumberDelim
      -> LuaE e ListAttributes)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"ListAttributes"
  ### liftPure3 (\mstart mstyle mdelim ->
                   ( fromMaybe 1 mstart
                   , fromMaybe DefaultStyle mstyle
                   , fromMaybe DefaultDelim mdelim
                   ))
  HsFnPrecursor
  e
  (Maybe Int
   -> Maybe ListNumberStyle
   -> Maybe ListNumberDelim
   -> LuaE e ListAttributes)
-> Parameter e (Maybe Int)
-> HsFnPrecursor
     e
     (Maybe ListNumberStyle
      -> Maybe ListNumberDelim -> LuaE e ListAttributes)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Int -> Text -> Text -> Text -> Parameter e (Maybe Int)
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral Text
"integer" Text
"start" Text
"number of first item"
  HsFnPrecursor
  e
  (Maybe ListNumberStyle
   -> Maybe ListNumberDelim -> LuaE e ListAttributes)
-> Parameter e (Maybe ListNumberStyle)
-> HsFnPrecursor e (Maybe ListNumberDelim -> LuaE e ListAttributes)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e ListNumberStyle
-> Text -> Text -> Text -> Parameter e (Maybe ListNumberStyle)
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker e ListNumberStyle
forall a e. Read a => Peeker e a
peekRead Text
"string" Text
"style" Text
"list numbering style"
  HsFnPrecursor e (Maybe ListNumberDelim -> LuaE e ListAttributes)
-> Parameter e (Maybe ListNumberDelim)
-> HsFnPrecursor e (LuaE e ListAttributes)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e ListNumberDelim
-> Text -> Text -> Text -> Parameter e (Maybe ListNumberDelim)
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter Peeker e ListNumberDelim
forall a e. Read a => Peeker e a
peekRead Text
"string" Text
"delimiter" Text
"list number delimiter"
  HsFnPrecursor e (LuaE e ListAttributes)
-> FunctionResults e ListAttributes -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e ListAttributes
-> Text -> Text -> FunctionResults e ListAttributes
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e ListAttributes
forall e. LuaError e => Pusher e ListAttributes
pushListAttributes Text
"ListAttributes" Text
"new ListAttributes"
  #? "Creates a new ListAttributes object."

-- | Pushes a 'ListNumberDelim' value as string.
pushListNumberDelim :: Pusher e ListNumberDelim
pushListNumberDelim :: Pusher e ListNumberDelim
pushListNumberDelim = String -> LuaE e ()
forall e. String -> LuaE e ()
pushString (String -> LuaE e ())
-> (ListNumberDelim -> String) -> Pusher e ListNumberDelim
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListNumberDelim -> String
forall a. Show a => a -> String
show
{-# INLINE pushListNumberDelim #-}

-- | Retrieves a 'ListNumberDelim' value from a string.
peekListNumberDelim :: Peeker e ListNumberDelim
peekListNumberDelim :: Peeker e ListNumberDelim
peekListNumberDelim = Peeker e ListNumberDelim
forall a e. Read a => Peeker e a
peekRead
{-# INLINE peekListNumberDelim #-}

-- | Pushes a 'ListNumberStyle' value as string.
pushListNumberStyle :: Pusher e ListNumberStyle
pushListNumberStyle :: Pusher e ListNumberStyle
pushListNumberStyle = String -> LuaE e ()
forall e. String -> LuaE e ()
pushString (String -> LuaE e ())
-> (ListNumberStyle -> String) -> Pusher e ListNumberStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListNumberStyle -> String
forall a. Show a => a -> String
show
{-# INLINE pushListNumberStyle #-}

-- | Retrieves a 'ListNumberStyle' value from a string.
peekListNumberStyle :: Peeker e ListNumberStyle
peekListNumberStyle :: Peeker e ListNumberStyle
peekListNumberStyle = Peeker e ListNumberStyle
forall a e. Read a => Peeker e a
peekRead
{-# INLINE peekListNumberStyle #-}