module HsLua.Marshalling.Push
( Pusher
, pushBool
, pushIntegral
, pushRealFloat
, pushByteString
, pushLazyByteString
, pushString
, pushText
, pushName
, pushList
, pushNonEmpty
, pushKeyValuePairs
, pushMap
, pushSet
, pushPair
, pushTriple
, pushAsTable
) where
import Control.Monad (forM_, zipWithM_)
import Data.ByteString (ByteString)
import Data.Map (Map, toList)
import Data.Set (Set)
import HsLua.Core as Lua
import Numeric (showGFloat)
import qualified Data.Text as T
import qualified Data.ByteString.Lazy as BL
import qualified Data.List.NonEmpty as NonEmpty
import qualified HsLua.Core.Utf8 as Utf8
type Pusher e a = a -> LuaE e ()
pushBool :: Pusher e Bool
pushBool :: forall e. Pusher e Bool
pushBool = forall e. Pusher e Bool
pushboolean
pushText :: Pusher e T.Text
pushText :: forall e. Pusher e Text
pushText = forall e. ByteString -> LuaE e ()
pushstring forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Utf8.fromText
pushByteString :: Pusher e ByteString
pushByteString :: forall e. ByteString -> LuaE e ()
pushByteString = forall e. ByteString -> LuaE e ()
pushstring
pushLazyByteString :: Pusher e BL.ByteString
pushLazyByteString :: forall e. Pusher e ByteString
pushLazyByteString = forall e. ByteString -> LuaE e ()
pushstring forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict
pushString :: String -> LuaE e ()
pushString :: forall e. String -> LuaE e ()
pushString = forall e. ByteString -> LuaE e ()
pushstring forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
Utf8.fromString
pushName :: Name -> LuaE e ()
pushName :: forall e. Name -> LuaE e ()
pushName (Name ByteString
n) = forall e. ByteString -> LuaE e ()
pushByteString ByteString
n
pushIntegral :: (Integral a, Show a) => a -> LuaE e ()
pushIntegral :: forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral a
i =
let maxInt :: Integer
maxInt = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Lua.Integer)
minInt :: Integer
minInt = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: Lua.Integer)
i' :: Integer
i' = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i :: Prelude.Integer
in if Integer
i' forall a. Ord a => a -> a -> Bool
>= Integer
minInt Bool -> Bool -> Bool
&& Integer
i' forall a. Ord a => a -> a -> Bool
<= Integer
maxInt
then forall e. Integer -> LuaE e ()
pushinteger forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i
else forall e. String -> LuaE e ()
pushString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
i
pushRealFloat :: RealFloat a => a -> LuaE e ()
pushRealFloat :: forall a e. RealFloat a => a -> LuaE e ()
pushRealFloat a
f =
let
number :: Number
number = Number
0 :: Lua.Number
realFloatFitsInNumber :: Bool
realFloatFitsInNumber = forall a. RealFloat a => a -> Integer
floatRadix Number
number forall a. Eq a => a -> a -> Bool
== forall a. RealFloat a => a -> Integer
floatRadix a
f
Bool -> Bool -> Bool
&& forall a. RealFloat a => a -> Int
floatDigits Number
number forall a. Eq a => a -> a -> Bool
== forall a. RealFloat a => a -> Int
floatDigits a
f
Bool -> Bool -> Bool
&& forall a. RealFloat a => a -> (Int, Int)
floatRange Number
number forall a. Eq a => a -> a -> Bool
== forall a. RealFloat a => a -> (Int, Int)
floatRange a
f
in if Bool
realFloatFitsInNumber
then forall e. Number -> LuaE e ()
pushnumber (forall a b. (Real a, Fractional b) => a -> b
realToFrac a
f :: Lua.Number)
else forall e. String -> LuaE e ()
pushString (forall a. RealFloat a => Maybe Int -> a -> ShowS
showGFloat forall a. Maybe a
Nothing a
f String
"")
pushKeyValuePairs :: LuaError e
=> Pusher e a -> Pusher e b -> Pusher e [(a,b)]
pushKeyValuePairs :: forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> Pusher e [(a, b)]
pushKeyValuePairs Pusher e a
pushKey Pusher e b
pushValue [(a, b)]
m = forall e. Int -> LuaE e Bool
checkstack Int
3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
False -> forall e a. LuaError e => String -> LuaE e a
failLua String
"stack overflow while pushing key-value pairs"
Bool
True -> do
let addValue :: (a, b) -> LuaE e ()
addValue (a
k, b
v) = Pusher e a
pushKey a
k forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pusher e b
pushValue b
v forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. LuaError e => StackIndex -> LuaE e ()
rawset (-StackIndex
3)
forall e. LuaE e ()
newtable
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (a, b) -> LuaE e ()
addValue [(a, b)]
m
pushList :: LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList :: forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList Pusher e a
push [a]
xs = forall e. Int -> LuaE e Bool
checkstack Int
2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
False -> forall e a. LuaError e => String -> LuaE e a
failLua String
"stack overflow while pushing a list"
Bool
True -> do
let setField :: Integer -> Pusher e a
setField Integer
i a
x = Pusher e a
push a
x forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawseti (-StackIndex
2) Integer
i
forall e. LuaE e ()
newtable
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ Integer -> Pusher e a
setField [Integer
1..] [a]
xs
pushNonEmpty :: LuaError e => Pusher e a -> NonEmpty.NonEmpty a -> LuaE e ()
pushNonEmpty :: forall e a. LuaError e => Pusher e a -> NonEmpty a -> LuaE e ()
pushNonEmpty Pusher e a
push = forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList Pusher e a
push forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NonEmpty.toList
pushMap :: LuaError e => Pusher e a -> Pusher e b -> Pusher e (Map a b)
pushMap :: forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> Pusher e (Map a b)
pushMap Pusher e a
pushKey Pusher e b
pushValue Map a b
m = forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> Pusher e [(a, b)]
pushKeyValuePairs Pusher e a
pushKey Pusher e b
pushValue forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
toList Map a b
m
pushSet :: LuaError e => Pusher e a -> Pusher e (Set a)
pushSet :: forall e a. LuaError e => Pusher e a -> Pusher e (Set a)
pushSet Pusher e a
pushElement Set a
set = forall e. Int -> LuaE e Bool
checkstack Int
3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
False -> forall e a. LuaError e => String -> LuaE e a
failLua String
"stack overflow while pushing a set"
Bool
True -> do
let addItem :: Pusher e a
addItem a
item = Pusher e a
pushElement a
item forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. Pusher e Bool
pushboolean Bool
True forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. LuaError e => StackIndex -> LuaE e ()
rawset (-StackIndex
3)
forall e. LuaE e ()
newtable
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Pusher e a
addItem Set a
set
pushAsTable :: LuaError e
=> [(Name, a -> LuaE e ())]
-> a -> LuaE e ()
pushAsTable :: forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable [(Name, a -> LuaE e ())]
props a
obj = do
forall e. Int -> Int -> LuaE e ()
createtable Int
0 (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Name, a -> LuaE e ())]
props)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Name, a -> LuaE e ())]
props forall a b. (a -> b) -> a -> b
$ \(Name
name, a -> LuaE e ()
pushValue) -> do
forall e. Name -> LuaE e ()
pushName Name
name
a -> LuaE e ()
pushValue a
obj
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
pushPair :: LuaError e
=> Pusher e a -> Pusher e b
-> (a, b)
-> LuaE e ()
pushPair :: forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> (a, b) -> LuaE e ()
pushPair Pusher e a
pushA Pusher e b
pushB (a
a,b
b) = do
forall e. LuaE e ()
newtable
Pusher e a
pushA a
a
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawseti (CInt -> StackIndex
nth CInt
2) Integer
1
Pusher e b
pushB b
b
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawseti (CInt -> StackIndex
nth CInt
2) Integer
2
pushTriple :: LuaError e
=> Pusher e a -> Pusher e b -> Pusher e c
-> (a, b, c)
-> LuaE e ()
pushTriple :: forall e a b c.
LuaError e =>
Pusher e a -> Pusher e b -> Pusher e c -> (a, b, c) -> LuaE e ()
pushTriple Pusher e a
pushA Pusher e b
pushB Pusher e c
pushC (a
a,b
b,c
c) = do
forall e. LuaE e ()
newtable
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\LuaE e ()
p Integer
i -> LuaE e ()
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawseti (CInt -> StackIndex
nth CInt
2) Integer
i)
[Pusher e a
pushA a
a, Pusher e b
pushB b
b, Pusher e c
pushC c
c]
[Integer
1..]