{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-|
Module      : HsLua.Marshalling.Userdata
Copyright   : © 2007–2012 Gracjan Polak;
              © 2012–2016 Ömer Sinan Ağacan;
              © 2017-2023 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb@hslua.org>
Stability   : beta
Portability : non-portable (depends on GHC)

Convenience functions to use Haskell values as Lua userdata.
-}
module HsLua.Marshalling.Userdata
  ( pushIterator
  ) where

import Control.Monad (void)
import HsLua.Core as Lua

-- | Pushes three values to the stack that can be used in a generic for
-- loop to lazily iterate over all values in the list. Keeps the
-- remaining list in a userdata state.
--
-- If the values pusher function returns @'NumResults' 0@ for a list
-- item, then this item will be skipped and the values for the next item
-- will be pushed.
pushIterator :: forall a e. LuaError e
             => (a -> LuaE e NumResults)  -- ^ pusher for the values
             -> [a]                       -- ^ list to iterate over lazily
             -> LuaE e NumResults
pushIterator :: forall a e.
LuaError e =>
(a -> LuaE e NumResults) -> [a] -> LuaE e NumResults
pushIterator a -> LuaE e NumResults
pushValues [a]
xs = do
  -- push initial state
  forall e. LuaError e => HaskellFunction e -> LuaE e ()
pushHaskellFunction LuaE e NumResults
nextItem
  LuaE e ()
pushInitialState
  forall e. LuaE e ()
pushnil
  forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> NumResults
NumResults CInt
3)
  where
    nextItem :: LuaE e NumResults
    nextItem :: LuaE e NumResults
nextItem = do
      Maybe [a]
props <- forall a e. StackIndex -> Name -> LuaE e (Maybe a)
fromuserdata @[a] (CInt -> StackIndex
nthBottom CInt
1) Name
statename
      case Maybe [a]
props of
        Maybe [a]
Nothing -> forall e a. LuaError e => String -> LuaE e a
failLua
          String
"Error in iterator: could not retrieve iterator state."
        Just [] -> NumResults
2 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (forall e. LuaE e ()
pushnil forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. LuaE e ()
pushnil)  -- end loop
        Just (a
y:[a]
ys) -> do
          Bool
success <- forall a e. StackIndex -> Name -> a -> LuaE e Bool
putuserdata @[a] (CInt -> StackIndex
nthBottom CInt
1) Name
statename [a]
ys
          if Bool -> Bool
not Bool
success
            then forall e a. LuaError e => String -> LuaE e a
failLua String
"Error in iterator: could not update iterator state."
            else a -> LuaE e NumResults
pushValues a
y forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              NumResults
0 -> LuaE e NumResults
nextItem  -- keep going if nothing was pushed
              NumResults
n -> forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
n

    statename :: Name
    statename :: Name
statename = Name
"HsLua iterator state"

    pushInitialState :: LuaE e ()
    pushInitialState :: LuaE e ()
pushInitialState = do
      forall a e. a -> Int -> LuaE e ()
newhsuserdatauv @[a] [a]
xs Int
0
      forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e. Name -> LuaE e Bool
newudmetatable Name
statename)
      forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth CInt
2)