{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{- |
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.List
  ( pushPandocList
  , luaopen_list_ptr
  , pushListModule
  , newListMetatable
  ) where

import Data.ByteString (useAsCString)
import Foreign.C
import HsLua

-- | Pushes a list as a numerically-indexed Lua table, and sets a
-- metatable that offers a number of convenience functions.
pushPandocList :: LuaError e => Pusher e a -> Pusher e [a]
pushPandocList :: Pusher e a -> Pusher e [a]
pushPandocList Pusher e a
pushItem [a]
items = do
  Pusher e a -> Pusher e [a]
forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList Pusher e a
pushItem [a]
items
  Name -> LuaE e Type
forall e. Name -> LuaE e Type
getmetatable' Name
"List" LuaE e Type -> (Type -> LuaE e ()) -> LuaE e ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Type
TypeTable -> StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth CInt
2)
    Type
_ -> String -> LuaE e ()
forall e a. LuaError e => String -> LuaE e a
failLua String
"List has not been initialized correctly."

-- | Pointer to the function that opens the List module and pushes it to the
-- stack.
foreign import ccall unsafe "listmod.c &luaopen_list"
  luaopen_list_ptr :: CFunction

-- | Opens the List module and pushes it to the stack.
pushListModule :: LuaError e => LuaE e ()
pushListModule :: LuaE e ()
pushListModule = do
  CFunction -> LuaE e ()
forall e. CFunction -> LuaE e ()
pushcfunction CFunction
luaopen_list_ptr
  NumArgs -> NumResults -> LuaE e ()
forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
call NumArgs
0 NumResults
1

-- | Creates a new list metatable with the given name.
foreign import ccall "listmod.c lualist_newmetatable"
  lualist_newmetatable :: State -> CString -> IO CInt

-- | Pushes the metatable of the given List type, creating it if
-- necessary. The @setup@ operation is run when the metatable did not
-- exists, was created, and is then at the top of the stack. The
-- operation may modify the table but must be balanced, and must leave
-- the stack as it found it.
newListMetatable :: Name -> LuaE e () {-^ setup -} -> LuaE e ()
newListMetatable :: Name -> LuaE e () -> LuaE e ()
newListMetatable (Name ByteString
name) LuaE e ()
setup = do
  State
l <- LuaE e State
forall e. LuaE e State
state
  IO CInt -> LuaE e CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ByteString -> (CString -> IO CInt) -> IO CInt
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString ByteString
name (State -> CString -> IO CInt
lualist_newmetatable State
l)) LuaE e CInt -> (CInt -> LuaE e ()) -> LuaE e ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    CInt
0 -> () -> LuaE e ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()   -- metatable already registered; no need to setup again
    CInt
_ -> LuaE e ()
setup