{-|
Module      :  HsLua.Aeson
Copyright   :  © 2017–2021 Albert Krewinkel
License     :  MIT
Maintainer  :  Albert Krewinkel <tarleb@zeitkraut.de>

Glue to HsLua for aeson values.

This provides a @StackValue@ instance for aeson's @Value@ type. The following
conventions are used:

- @Null@ values are encoded as a special value (stored in the registry field
  @HSLUA_AESON_NULL@). Using @nil@ would cause problems with null-containing
  arrays.

- Objects are converted to tables in a straight-forward way.

- Arrays are converted to Lua tables. Array-length is included as the value at
  index 0. This makes it possible to distinguish between empty arrays and empty
  objects.

- JSON numbers are converted to Lua numbers (usually doubles), which can cause
  a loss of precision.
-}
module HsLua.Aeson
  ( peekValue
  , pushValue
  , peekVector
  , pushVector
  , pushNull
  , peekScientific
  , pushScientific
  , peekKeyMap
  , pushKeyMap
  ) where

import Control.Monad ((<$!>), when)
import Data.Aeson.Key (Key, toText, fromText)
import Data.Aeson.KeyMap
import Data.Scientific (Scientific, toRealFloat, fromFloatDigits)
import Data.String (IsString (fromString))
import Data.Vector (Vector)
import HsLua.Core as Lua
import HsLua.Marshalling as Lua

import qualified Data.Aeson as Aeson
import qualified Data.Aeson.KeyMap as KeyMap
import qualified Data.Vector as Vector
import qualified HsLua.Core.Unsafe as Unsafe

-- Scientific
pushScientific :: Pusher e Scientific
pushScientific :: Pusher e Scientific
pushScientific = forall e. RealFloat Double => Double -> LuaE e ()
forall a e. RealFloat a => a -> LuaE e ()
pushRealFloat @Double (Double -> LuaE e ())
-> (Scientific -> Double) -> Pusher e Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Double
forall a. RealFloat a => Scientific -> a
toRealFloat

peekScientific :: Peeker e Scientific
peekScientific :: Peeker e Scientific
peekScientific StackIndex
idx = Double -> Scientific
forall a. RealFloat a => a -> Scientific
fromFloatDigits (Double -> Scientific) -> Peek e Double -> Peek e Scientific
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Double
forall a e. (RealFloat a, Read a) => Peeker e a
peekRealFloat @Double StackIndex
idx

-- | Hslua StackValue instance for the Aeson Value data type.
pushValue :: LuaError e => Pusher e Aeson.Value
pushValue :: Pusher e Value
pushValue = \case
  Aeson.Object Object
o -> Pusher e Value -> Pusher e Object
forall e a. LuaError e => Pusher e a -> Pusher e (KeyMap a)
pushKeyMap Pusher e Value
forall e. LuaError e => Pusher e Value
pushValue Object
o
  Aeson.Number Scientific
n -> Int -> LuaE e Bool
forall e. Int -> LuaE e Bool
checkstack Int
1 LuaE e Bool -> (Bool -> LuaE e ()) -> LuaE e ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> Pusher e Scientific
forall e. Pusher e Scientific
pushScientific Scientific
n
    Bool
False -> String -> LuaE e ()
forall e a. LuaError e => String -> LuaE e a
failLua String
"stack overflow"
  Aeson.String Text
s -> Int -> LuaE e Bool
forall e. Int -> LuaE e Bool
checkstack Int
1 LuaE e Bool -> (Bool -> LuaE e ()) -> LuaE e ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> Pusher e Text
forall e. Pusher e Text
pushText Text
s
    Bool
False -> String -> LuaE e ()
forall e a. LuaError e => String -> LuaE e a
failLua String
"stack overflow"
  Aeson.Array Array
a  -> Pusher e Value -> Pusher e Array
forall e a. LuaError e => Pusher e a -> Pusher e (Vector a)
pushVector Pusher e Value
forall e. LuaError e => Pusher e Value
pushValue Array
a
  Aeson.Bool Bool
b   -> Int -> LuaE e Bool
forall e. Int -> LuaE e Bool
checkstack Int
1 LuaE e Bool -> (Bool -> LuaE e ()) -> LuaE e ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> Bool -> LuaE e ()
forall e. Pusher e Bool
pushBool Bool
b
    Bool
False -> String -> LuaE e ()
forall e a. LuaError e => String -> LuaE e a
failLua String
"stack overflow"
  Value
Aeson.Null     -> LuaE e ()
forall e. LuaError e => LuaE e ()
pushNull

peekValue :: LuaError e => Peeker e Aeson.Value
peekValue :: Peeker e Value
peekValue StackIndex
idx = LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) Peek e Type -> (Type -> Peek e Value) -> Peek e Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeBoolean -> Bool -> Value
Aeson.Bool  (Bool -> Value) -> Peek e Bool -> Peek e Value
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Bool
forall e. Peeker e Bool
peekBool StackIndex
idx
  Type
TypeNumber -> Scientific -> Value
Aeson.Number (Scientific -> Value) -> Peek e Scientific -> Peek e Value
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Scientific
forall e. Peeker e Scientific
peekScientific StackIndex
idx
  Type
TypeString -> Text -> Value
Aeson.String (Text -> Value) -> Peek e Text -> Peek e Value
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Text
forall e. Peeker e Text
peekText StackIndex
idx
  Type
TypeTable -> LuaE e Bool -> Peek e Bool
forall e a. LuaE e a -> Peek e a
liftLua (Int -> LuaE e Bool
forall e. Int -> LuaE e Bool
checkstack Int
1) Peek e Bool -> (Bool -> Peek e Value) -> Peek e Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
False -> ByteString -> Peek e Value
forall a e. ByteString -> Peek e a
failPeek ByteString
"stack overflow"
    Bool
True -> do
      Bool
isInt <- LuaE e Bool -> Peek e Bool
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e Bool -> Peek e Bool) -> LuaE e Bool -> Peek e Bool
forall a b. (a -> b) -> a -> b
$ StackIndex -> Integer -> LuaE e ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawgeti StackIndex
idx Integer
0 LuaE e () -> LuaE e Bool -> LuaE e Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
isinteger StackIndex
top LuaE e Bool -> LuaE e () -> LuaE e Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1
      if Bool
isInt
        then Array -> Value
Aeson.Array (Array -> Value) -> Peek e Array -> Peek e Value
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Value -> Peeker e Array
forall e a. LuaError e => Peeker e a -> Peeker e (Vector a)
peekVector Peeker e Value
forall e. LuaError e => Peeker e Value
peekValue StackIndex
idx
        else do
          Int
rawlen' <- LuaE e Int -> Peek e Int
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e Int -> Peek e Int) -> LuaE e Int -> Peek e Int
forall a b. (a -> b) -> a -> b
$ StackIndex -> LuaE e Int
forall e. StackIndex -> LuaE e Int
rawlen StackIndex
idx
          if Int
rawlen' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
            then Array -> Value
Aeson.Array (Array -> Value) -> Peek e Array -> Peek e Value
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Value -> Peeker e Array
forall e a. LuaError e => Peeker e a -> Peeker e (Vector a)
peekVector Peeker e Value
forall e. LuaError e => Peeker e Value
peekValue StackIndex
idx
            else do
              Bool
isNull' <- LuaE e Bool -> Peek e Bool
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e Bool -> Peek e Bool) -> LuaE e Bool -> Peek e Bool
forall a b. (a -> b) -> a -> b
$ StackIndex -> LuaE e Bool
forall e. LuaError e => StackIndex -> LuaE e Bool
isNull StackIndex
idx
              if Bool
isNull'
                then Value -> Peek e Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
Aeson.Null
                else Object -> Value
Aeson.Object (Object -> Value) -> Peek e Object -> Peek e Value
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Value -> Peeker e Object
forall e a. Peeker e a -> Peeker e (KeyMap a)
peekKeyMap Peeker e Value
forall e. LuaError e => Peeker e Value
peekValue StackIndex
idx
  Type
TypeNil -> Value -> Peek e Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
Aeson.Null
  Type
luaType -> String -> Peek e Value
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unexpected type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
luaType)

-- | Registry key containing the representation for JSON null values.
nullRegistryField :: Name
nullRegistryField :: Name
nullRegistryField = Name
"HSLUA_AESON_NULL"

-- | Push the value which represents JSON null values to the stack (a specific
-- empty table by default). Internally, this uses the contents of the
-- @HSLUA_AESON_NULL@ registry field; modifying this field is possible, but it
-- must always be non-nil.
pushNull :: LuaError e => LuaE e ()
pushNull :: LuaE e ()
pushNull = Int -> LuaE e Bool
forall e. Int -> LuaE e Bool
checkstack Int
3 LuaE e Bool -> (Bool -> LuaE e ()) -> LuaE e ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Bool
False -> String -> LuaE e ()
forall e a. LuaError e => String -> LuaE e a
failLua String
"stack overflow while pushing null"
  Bool
True -> do
    Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
nullRegistryField
    StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawget StackIndex
registryindex
    Bool
uninitialized <- StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
isnil StackIndex
top
    Bool -> LuaE e () -> LuaE e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
uninitialized (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ do
      Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1 -- remove nil
      LuaE e ()
forall e. LuaE e ()
newtable
      StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
pushvalue StackIndex
top
      StackIndex -> Name -> LuaE e ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield StackIndex
registryindex Name
nullRegistryField

-- | Check if the value under the given index represents a @null@ value.
isNull :: LuaError e => StackIndex -> LuaE e Bool
isNull :: StackIndex -> LuaE e Bool
isNull StackIndex
idx = do
  StackIndex
idx' <- StackIndex -> LuaE e StackIndex
forall e. StackIndex -> LuaE e StackIndex
absindex StackIndex
idx
  LuaE e ()
forall e. LuaError e => LuaE e ()
pushNull
  StackIndex -> StackIndex -> LuaE e Bool
forall e. StackIndex -> StackIndex -> LuaE e Bool
rawequal StackIndex
idx' StackIndex
top LuaE e Bool -> LuaE e () -> LuaE e Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1

-- | Push a vector onto the stack.
pushVector :: LuaError e
           => Pusher e a
           -> Pusher e (Vector a)
pushVector :: Pusher e a -> Pusher e (Vector a)
pushVector Pusher e a
pushItem !Vector a
v = do
  Int -> LuaE e Bool
forall e. Int -> LuaE e Bool
checkstack Int
3 LuaE e Bool -> (Bool -> LuaE e ()) -> LuaE e ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
False -> String -> LuaE e ()
forall e a. LuaError e => String -> LuaE e a
failLua String
"stack overflow"
    Bool
True -> do
      Pusher e a -> [a] -> LuaE e ()
forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList Pusher e a
pushItem ([a] -> LuaE e ()) -> [a] -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ Vector a -> [a]
forall a. Vector a -> [a]
Vector.toList Vector a
v
      Int -> LuaE e ()
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral (Vector a -> Int
forall a. Vector a -> Int
Vector.length Vector a
v)
      StackIndex -> Integer -> LuaE e ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawseti (CInt -> StackIndex
nth CInt
2) Integer
0

-- | Try reading the value under the given index as a vector.
peekVector :: LuaError e
           => Peeker e a
           -> Peeker e (Vector a)
peekVector :: Peeker e a -> Peeker e (Vector a)
peekVector Peeker e a
peekItem = (Peek e (Vector a) -> Peek e (Vector a))
-> Peeker e (Vector a) -> Peeker e (Vector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name -> Peek e (Vector a) -> Peek e (Vector a)
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"list") (Peeker e (Vector a) -> Peeker e (Vector a))
-> (Peeker e (Vector a) -> Peeker e (Vector a))
-> Peeker e (Vector a)
-> Peeker e (Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Name
-> (StackIndex -> LuaE e Bool)
-> Peeker e (Vector a)
-> Peeker e (Vector a)
forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"table" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
istable (Peeker e (Vector a) -> Peeker e (Vector a))
-> Peeker e (Vector a) -> Peeker e (Vector a)
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx -> do
  let elementsAt :: [Integer] -> Peek e [a]
elementsAt [] = [a] -> Peek e [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      elementsAt (Integer
i : [Integer]
is) = do
        LuaE e Bool -> Peek e Bool
forall e a. LuaE e a -> Peek e a
liftLua (Int -> LuaE e Bool
forall e. Int -> LuaE e Bool
checkstack Int
2) Peek e Bool -> (Bool -> Peek e [a]) -> Peek e [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Bool
False -> ByteString -> Peek e [a]
forall a e. ByteString -> Peek e a
failPeek ByteString
"Lua stack overflow"
          Bool
True  -> do
            a
x  <- Name -> Peek e a -> Peek e a
forall e a. Name -> Peek e a -> Peek e a
retrieving (Name
"index " Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Integer -> Name
forall a. IsString a => Integer -> a
showInt Integer
i) (Peek e a -> Peek e a) -> Peek e a -> Peek e a
forall a b. (a -> b) -> a -> b
$ do
              LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Integer -> LuaE e ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawgeti StackIndex
idx Integer
i)
              Peeker e a
peekItem StackIndex
top Peek e a -> LuaE e () -> Peek e a
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1
            [a]
xs <- [Integer] -> Peek e [a]
elementsAt [Integer]
is
            [a] -> Peek e [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
      showInt :: Integer -> a
showInt (Lua.Integer Int64
x) = String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ Int64 -> String
forall a. Show a => a -> String
show Int64
x
  Int
listLength <- LuaE e Int -> Peek e Int
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Int
forall e. StackIndex -> LuaE e Int
rawlen StackIndex
idx)
  [a]
list <- [Integer] -> Peek e [a]
elementsAt [Integer
1..Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
listLength]
  Vector a -> Peek e (Vector a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector a -> Peek e (Vector a)) -> Vector a -> Peek e (Vector a)
forall a b. (a -> b) -> a -> b
$! [a] -> Vector a
forall a. [a] -> Vector a
Vector.fromList [a]
list

-- | Pushes a 'KeyMap' onto the stack.
pushKeyMap :: LuaError e
           => Pusher e a
           -> Pusher e (KeyMap a)
pushKeyMap :: Pusher e a -> Pusher e (KeyMap a)
pushKeyMap Pusher e a
pushVal KeyMap a
x =
  Int -> LuaE e Bool
forall e. Int -> LuaE e Bool
checkstack Int
3 LuaE e Bool -> (Bool -> LuaE e ()) -> LuaE e ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> Pusher e Key -> Pusher e a -> Pusher e [(Key, a)]
forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> Pusher e [(a, b)]
pushKeyValuePairs Pusher e Key
forall e. Pusher e Key
pushKey Pusher e a
pushVal Pusher e [(Key, a)] -> Pusher e [(Key, a)]
forall a b. (a -> b) -> a -> b
$ KeyMap a -> [(Key, a)]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList KeyMap a
x
    Bool
False -> String -> LuaE e ()
forall e a. LuaError e => String -> LuaE e a
failLua String
"stack overflow"

-- | Retrieves a 'KeyMap' from a Lua table.
peekKeyMap :: Peeker e a
           -> Peeker e (KeyMap a)
peekKeyMap :: Peeker e a -> Peeker e (KeyMap a)
peekKeyMap Peeker e a
peekVal =
  Name
-> (StackIndex -> LuaE e Bool)
-> Peeker e (KeyMap a)
-> Peeker e (KeyMap a)
forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"table" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
istable (Peeker e (KeyMap a) -> Peeker e (KeyMap a))
-> Peeker e (KeyMap a) -> Peeker e (KeyMap a)
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx -> Peek e (KeyMap a) -> Peek e (KeyMap a)
forall e a. Peek e a -> Peek e a
cleanup (Peek e (KeyMap a) -> Peek e (KeyMap a))
-> Peek e (KeyMap a) -> Peek e (KeyMap a)
forall a b. (a -> b) -> a -> b
$ do
  LuaE e Bool -> Peek e Bool
forall e a. LuaE e a -> Peek e a
liftLua (Int -> LuaE e Bool
forall e. Int -> LuaE e Bool
checkstack Int
1) Peek e Bool -> (Bool -> Peek e (KeyMap a)) -> Peek e (KeyMap a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
False -> ByteString -> Peek e (KeyMap a)
forall a e. ByteString -> Peek e a
failPeek ByteString
"Lua stack overflow"
    Bool
True -> do
      StackIndex
idx' <- LuaE e StackIndex -> Peek e StackIndex
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e StackIndex -> Peek e StackIndex)
-> LuaE e StackIndex -> Peek e StackIndex
forall a b. (a -> b) -> a -> b
$ StackIndex -> LuaE e StackIndex
forall e. StackIndex -> LuaE e StackIndex
absindex StackIndex
idx
      let remainingPairs :: Peek e [(Key, a)]
remainingPairs = Peeker e a -> Peeker e (Maybe (Key, a))
forall e b. Peeker e b -> Peeker e (Maybe (Key, b))
nextPair Peeker e a
peekVal StackIndex
idx' Peek e (Maybe (Key, a))
-> (Maybe (Key, a) -> Peek e [(Key, a)]) -> Peek e [(Key, a)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe (Key, a)
Nothing -> [(Key, a)] -> Peek e [(Key, a)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
            Just (Key, a)
a  -> ((Key, a)
a(Key, a) -> [(Key, a)] -> [(Key, a)]
forall a. a -> [a] -> [a]
:) ([(Key, a)] -> [(Key, a)])
-> Peek e [(Key, a)] -> Peek e [(Key, a)]
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peek e [(Key, a)]
remainingPairs
      LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua LuaE e ()
forall e. LuaE e ()
pushnil
      [(Key, a)] -> KeyMap a
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList ([(Key, a)] -> KeyMap a) -> Peek e [(Key, a)] -> Peek e (KeyMap a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peek e [(Key, a)]
remainingPairs

-- | Pushes a JSON key to the stack.
pushKey :: Pusher e Key
pushKey :: Pusher e Key
pushKey = Pusher e Text
forall e. Pusher e Text
pushText Pusher e Text -> (Key -> Text) -> Pusher e Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Text
toText

-- | Retrieves a JSON key from the stack.
peekKey :: Peeker e Key
peekKey :: Peeker e Key
peekKey = (Text -> Key) -> Peek e Text -> Peek e Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Key
fromText (Peek e Text -> Peek e Key)
-> (StackIndex -> Peek e Text) -> Peeker e Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Text
forall e. Peeker e Text
peekText

-- | Get the next key-value pair from a table. Assumes the last
-- key to be on the top of the stack and the table at the given
-- index @idx@. The next key, if it exists, is left at the top of
-- the stack.
--
-- The key must be either nil or must exist in the table, or this
-- function will crash with an unrecoverable error.
nextPair :: Peeker e b -> Peeker e (Maybe (Key, b))
nextPair :: Peeker e b -> Peeker e (Maybe (Key, b))
nextPair Peeker e b
peekVal StackIndex
idx = Name -> Peek e (Maybe (Key, b)) -> Peek e (Maybe (Key, b))
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"key-value pair" (Peek e (Maybe (Key, b)) -> Peek e (Maybe (Key, b)))
-> Peek e (Maybe (Key, b)) -> Peek e (Maybe (Key, b))
forall a b. (a -> b) -> a -> b
$ do
  LuaE e Bool -> Peek e Bool
forall e a. LuaE e a -> Peek e a
liftLua (Int -> LuaE e Bool
forall e. Int -> LuaE e Bool
checkstack Int
1) Peek e Bool
-> (Bool -> Peek e (Maybe (Key, b))) -> Peek e (Maybe (Key, b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
False -> ByteString -> Peek e (Maybe (Key, b))
forall a e. ByteString -> Peek e a
failPeek ByteString
"Lua stack overflow"
    Bool
True -> do
      Bool
hasNext <- LuaE e Bool -> Peek e Bool
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e Bool -> Peek e Bool) -> LuaE e Bool -> Peek e Bool
forall a b. (a -> b) -> a -> b
$ StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
Unsafe.next StackIndex
idx
      if Bool -> Bool
not Bool
hasNext
        then Maybe (Key, b) -> Peek e (Maybe (Key, b))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Key, b)
forall a. Maybe a
Nothing
        else do
        Key
key   <- Name -> Peek e Key -> Peek e Key
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"key"   (Peek e Key -> Peek e Key) -> Peek e Key -> Peek e Key
forall a b. (a -> b) -> a -> b
$! Peeker e Key
forall e. Peeker e Key
peekKey (CInt -> StackIndex
nth CInt
2)
        b
value <- Name -> Peek e b -> Peek e b
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"value" (Peek e b -> Peek e b) -> Peek e b -> Peek e b
forall a b. (a -> b) -> a -> b
$! Peeker e b
peekVal (CInt -> StackIndex
nth CInt
1)
        Maybe (Key, b) -> Peek e (Maybe (Key, b))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Key, b) -> Maybe (Key, b)
forall a. a -> Maybe a
Just (Key
key, b
value))
          Peek e (Maybe (Key, b)) -> LuaE e () -> Peek e (Maybe (Key, b))
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1  -- remove value, leave the key