{-|
Module      : Foreign.Lua.Push
Copyright   : © 2020 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>
Stability   : beta
Portability : Portable

Functions which marshal and push Haskell values onto Lua's stack.
-}
module Foreign.Lua.Push
  ( Pusher
  -- * Primitives
  , pushBool
  , pushIntegral
  , pushRealFloat
  -- * Strings
  , pushByteString
  , pushLazyByteString
  , pushString
  , pushText
  -- * Collections
  , pushList
  , pushMap
  , pushSet
  ) where

import Control.Monad (zipWithM_)
import Data.ByteString (ByteString)
import Data.Map (Map, toList)
import Data.Set (Set)
import Foreign.Lua.Core as Lua
import Numeric (showGFloat)

import qualified Data.Text as T
import qualified Data.ByteString.Lazy as BL
import qualified Foreign.Lua.Utf8 as Utf8

-- | Function to push a value to Lua's stack.
type Pusher a = a -> Lua ()

-- | Pushes a 'Bool' as a Lua boolean.
pushBool :: Pusher Bool
pushBool :: Pusher Bool
pushBool = Pusher Bool
pushboolean

-- | Pushes a 'T.Text' value as an UTF-8 encoded string.
pushText :: Pusher T.Text
pushText :: Pusher Text
pushText = ByteString -> Lua ()
pushstring (ByteString -> Lua ()) -> (Text -> ByteString) -> Pusher Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Utf8.fromText

-- | Pushes a 'ByteString' as a raw string.
pushByteString :: Pusher ByteString
pushByteString :: ByteString -> Lua ()
pushByteString = ByteString -> Lua ()
pushstring

-- | Pushes a lazy 'BL.ByteString' as a raw string.
pushLazyByteString :: Pusher BL.ByteString
pushLazyByteString :: Pusher ByteString
pushLazyByteString = ByteString -> Lua ()
pushstring (ByteString -> Lua ())
-> (ByteString -> ByteString) -> Pusher ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict

-- | Pushes a 'String' as an UTF-8 encoded Lua string.
pushString :: String -> Lua ()
pushString :: String -> Lua ()
pushString = ByteString -> Lua ()
pushstring (ByteString -> Lua ())
-> (String -> ByteString) -> String -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
Utf8.fromString

-- | Pushes an @Integer@ to the Lua stack. Values representable as Lua
-- integers are pushed as such; bigger integers are represented using
-- their string representation.
pushIntegral :: (Integral a, Show a) => a -> Lua ()
pushIntegral :: a -> Lua ()
pushIntegral a
i =
  let maxInt :: Integer
maxInt = Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
forall a. Bounded a => a
maxBound :: Lua.Integer)
      minInt :: Integer
minInt = Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
forall a. Bounded a => a
minBound :: Lua.Integer)
      i' :: Integer
i' = a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i :: Prelude.Integer
  in if Integer
i' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
minInt Bool -> Bool -> Bool
&& Integer
i' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
maxInt
     then Integer -> Lua ()
pushinteger (Integer -> Lua ()) -> Integer -> Lua ()
forall a b. (a -> b) -> a -> b
$ a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i
     else String -> Lua ()
pushString  (String -> Lua ()) -> String -> Lua ()
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
i

-- | Push a floating point number to the Lua stack. Uses a string
-- representation for all types which do not match the float properties
-- of the 'Lua.Number' type.
pushRealFloat :: RealFloat a => a -> Lua ()
pushRealFloat :: a -> Lua ()
pushRealFloat a
f =
  let
    number :: Number
number = Number
0 :: Lua.Number
    realFloatFitsInNumber :: Bool
realFloatFitsInNumber = Number -> Integer
forall a. RealFloat a => a -> Integer
floatRadix Number
number Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Integer
forall a. RealFloat a => a -> Integer
floatRadix a
f
      Bool -> Bool -> Bool
&& Number -> Int
forall a. RealFloat a => a -> Int
floatDigits Number
number Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Int
forall a. RealFloat a => a -> Int
floatDigits a
f
      Bool -> Bool -> Bool
&& Number -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange Number
number (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== a -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange a
f
  in if Bool
realFloatFitsInNumber
     then Number -> Lua ()
pushnumber (a -> Number
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
f :: Lua.Number)
     else String -> Lua ()
pushString (Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showGFloat Maybe Int
forall a. Maybe a
Nothing a
f String
"")

-- | Push list of pairs as default key-value Lua table.
pushKeyValuePairs :: Pusher a -> Pusher b -> Pusher [(a,b)]
pushKeyValuePairs :: Pusher a -> Pusher b -> Pusher [(a, b)]
pushKeyValuePairs Pusher a
pushKey Pusher b
pushValue [(a, b)]
m = do
  let addValue :: (a, b) -> Lua ()
addValue (a
k, b
v) = Pusher a
pushKey a
k Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pusher b
pushValue b
v Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> Lua ()
rawset (-StackIndex
3)
  Lua ()
newtable
  ((a, b) -> Lua ()) -> Pusher [(a, b)]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (a, b) -> Lua ()
addValue [(a, b)]
m

-- | Push list as numerically indexed table.
pushList :: Pusher a -> [a] -> Lua ()
pushList :: Pusher a -> [a] -> Lua ()
pushList Pusher a
push [a]
xs = do
  let setField :: Integer -> Pusher a
setField Integer
i a
x = Pusher a
push a
x Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> Integer -> Lua ()
rawseti (-StackIndex
2) Integer
i
  Lua ()
newtable
  (Integer -> Pusher a) -> [Integer] -> [a] -> Lua ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ Integer -> Pusher a
setField [Integer
1..] [a]
xs

-- | Push 'Map' as default key-value Lua table.
pushMap :: Pusher a -> Pusher b -> Pusher (Map a b)
pushMap :: Pusher a -> Pusher b -> Pusher (Map a b)
pushMap Pusher a
pushKey Pusher b
pushValue Map a b
m = Pusher a -> Pusher b -> Pusher [(a, b)]
forall a b. Pusher a -> Pusher b -> Pusher [(a, b)]
pushKeyValuePairs Pusher a
pushKey Pusher b
pushValue Pusher [(a, b)] -> Pusher [(a, b)]
forall a b. (a -> b) -> a -> b
$ Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
toList Map a b
m

-- | Push a 'Set' as idiomatic Lua set, i.e., as a table with the set
-- elements as keys and @true@ as values.
pushSet :: Pusher a -> Pusher (Set a)
pushSet :: Pusher a -> Pusher (Set a)
pushSet Pusher a
pushElement Set a
set = do
  let addItem :: Pusher a
addItem a
item = Pusher a
pushElement a
item Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pusher Bool
pushboolean Bool
True Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> Lua ()
rawset (-StackIndex
3)
  Lua ()
newtable
  Pusher a -> Pusher (Set a)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Pusher a
addItem Set a
set