{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module      : Foreign.Lua.Types.Pushable
Copyright   : © 2007–2012 Gracjan Polak,
                2012–2016 Ömer Sinan Ağacan,
                2017-2019 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>
Stability   : beta
Portability : FlexibleInstances, ScopedTypeVariables

Sending haskell objects to the lua stack.
-}
module Foreign.Lua.Types.Pushable
  ( Pushable (..)
  , pushList
  ) 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 Foreign.Ptr (Ptr)

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

-- | A value that can be pushed to the Lua stack.
class Pushable a where
  -- | Pushes a value onto Lua stack, casting it into meaningfully nearest Lua
  -- type.
  push :: a -> Lua ()

instance Pushable () where
  push :: () -> Lua ()
push = Lua () -> () -> Lua ()
forall a b. a -> b -> a
const Lua ()
pushnil

instance Pushable Lua.Integer where
  push :: Integer -> Lua ()
push = Integer -> Lua ()
pushinteger

instance Pushable Lua.Number where
  push :: Number -> Lua ()
push = Number -> Lua ()
pushnumber

instance Pushable ByteString where
  push :: ByteString -> Lua ()
push = ByteString -> Lua ()
pushstring

instance Pushable Bool where
  push :: Bool -> Lua ()
push = Bool -> Lua ()
pushboolean

instance Pushable CFunction where
  push :: CFunction -> Lua ()
push = CFunction -> Lua ()
pushcfunction

instance Pushable (Ptr a) where
  push :: Ptr a -> Lua ()
push = Ptr a -> Lua ()
forall a. Ptr a -> Lua ()
pushlightuserdata

instance Pushable T.Text where
  push :: Text -> Lua ()
push = ByteString -> Lua ()
forall a. Pushable a => a -> Lua ()
push (ByteString -> Lua ()) -> (Text -> ByteString) -> Text -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Utf8.fromText

instance Pushable BL.ByteString where
  push :: ByteString -> Lua ()
push = ByteString -> Lua ()
forall a. Pushable a => a -> Lua ()
push (ByteString -> Lua ())
-> (ByteString -> ByteString) -> ByteString -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict

instance Pushable Prelude.Integer where
  push :: Integer -> Lua ()
push = Integer -> Lua ()
pushInteger

instance Pushable Int where
  push :: Int -> Lua ()
push = Integer -> Lua ()
pushInteger (Integer -> Lua ()) -> (Int -> Integer) -> Int -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Pushable Float where
  push :: Float -> Lua ()
push = Float -> Lua ()
forall a. (RealFloat a, Show a) => a -> Lua ()
pushRealFloat

instance Pushable Double where
  push :: Double -> Lua ()
push = Double -> Lua ()
forall a. (RealFloat a, Show a) => a -> Lua ()
pushRealFloat

instance {-# OVERLAPS #-} Pushable [Char] where
  push :: [Char] -> Lua ()
push = ByteString -> Lua ()
forall a. Pushable a => a -> Lua ()
push (ByteString -> Lua ())
-> ([Char] -> ByteString) -> [Char] -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
Utf8.fromString

instance Pushable a => Pushable [a] where
  push :: [a] -> Lua ()
push = [a] -> Lua ()
forall a. Pushable a => [a] -> Lua ()
pushList


-- | Push an @Int@ to the Lua stack. Numbers representable as Lua integers are
-- pushed as such; bigger integers are represented using their string
-- representation.
pushInteger :: Prelude.Integer -> Lua ()
pushInteger :: Integer -> Lua ()
pushInteger i :: Integer
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)
  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 ()
forall a. Pushable a => a -> Lua ()
push (Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Lua.Integer)
     else [Char] -> Lua ()
forall a. Pushable a => a -> Lua ()
push (Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
i)

-- | Push a floating point number to the Lua stack.
pushRealFloat :: (RealFloat a, Show a) => a -> Lua ()
pushRealFloat :: a -> Lua ()
pushRealFloat f :: a
f =
  let
    number :: Number
number = 0 :: Lua.Number
    doubleFitsInNumber :: Bool
doubleFitsInNumber = 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
doubleFitsInNumber
     then Number -> Lua ()
forall a. Pushable a => a -> Lua ()
push (a -> Number
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
f :: Lua.Number)
     else [Char] -> Lua ()
forall a. Pushable a => a -> Lua ()
push (a -> [Char]
forall a. Show a => a -> [Char]
show a
f)

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

instance (Pushable a, Pushable b) => Pushable (Map a b) where
  push :: Map a b -> Lua ()
push m :: Map a b
m = do
    let addValue :: (a, a) -> Lua ()
addValue (k :: a
k, v :: a
v) = a -> Lua ()
forall a. Pushable a => a -> Lua ()
push a
k Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> a -> Lua ()
forall a. Pushable a => a -> Lua ()
push a
v Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> Lua ()
rawset (-3)
    Lua ()
newtable
    ((a, b) -> Lua ()) -> [(a, b)] -> Lua ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (a, b) -> Lua ()
forall a a. (Pushable a, Pushable a) => (a, a) -> Lua ()
addValue (Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
toList Map a b
m)

instance Pushable a => Pushable (Set a) where
  push :: Set a -> Lua ()
push set :: Set a
set = do
    let addItem :: a -> Lua ()
addItem item :: a
item = a -> Lua ()
forall a. Pushable a => a -> Lua ()
push a
item Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> Lua ()
forall a. Pushable a => a -> Lua ()
push Bool
True Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> Lua ()
rawset (-3)
    Lua ()
newtable
    (a -> Lua ()) -> Set a -> Lua ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> Lua ()
forall a. Pushable a => a -> Lua ()
addItem Set a
set

--
-- Tuples
--
instance (Pushable a, Pushable b) => Pushable (a, b) where
  push :: (a, b) -> Lua ()
push (a :: a
a, b :: b
b) = do
    Lua ()
newtable
    Integer -> a -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 1 a
a
    Integer -> b -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 2 b
b

instance (Pushable a, Pushable b, Pushable c) =>
         Pushable (a, b, c)
 where
  push :: (a, b, c) -> Lua ()
push (a :: a
a, b :: b
b, c :: c
c) = do
    Lua ()
newtable
    Integer -> a -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 1 a
a
    Integer -> b -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 2 b
b
    Integer -> c -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 3 c
c

instance (Pushable a, Pushable b, Pushable c, Pushable d) =>
         Pushable (a, b, c, d)
 where
  push :: (a, b, c, d) -> Lua ()
push (a :: a
a, b :: b
b, c :: c
c, d :: d
d) = do
    Lua ()
newtable
    Integer -> a -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 1 a
a
    Integer -> b -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 2 b
b
    Integer -> c -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 3 c
c
    Integer -> d -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 4 d
d

instance (Pushable a, Pushable b, Pushable c,
          Pushable d, Pushable e) =>
         Pushable (a, b, c, d, e)
 where
  push :: (a, b, c, d, e) -> Lua ()
push (a :: a
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e) = do
    Lua ()
newtable
    Integer -> a -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 1 a
a
    Integer -> b -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 2 b
b
    Integer -> c -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 3 c
c
    Integer -> d -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 4 d
d
    Integer -> e -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 5 e
e

instance (Pushable a, Pushable b, Pushable c,
          Pushable d, Pushable e, Pushable f) =>
         Pushable (a, b, c, d, e, f)
 where
  push :: (a, b, c, d, e, f) -> Lua ()
push (a :: a
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f) = do
    Lua ()
newtable
    Integer -> a -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 1 a
a
    Integer -> b -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 2 b
b
    Integer -> c -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 3 c
c
    Integer -> d -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 4 d
d
    Integer -> e -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 5 e
e
    Integer -> f -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 6 f
f

instance (Pushable a, Pushable b, Pushable c, Pushable d,
          Pushable e, Pushable f, Pushable g) =>
         Pushable (a, b, c, d, e, f, g)
 where
  push :: (a, b, c, d, e, f, g) -> Lua ()
push (a :: a
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g) = do
    Lua ()
newtable
    Integer -> a -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 1 a
a
    Integer -> b -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 2 b
b
    Integer -> c -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 3 c
c
    Integer -> d -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 4 d
d
    Integer -> e -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 5 e
e
    Integer -> f -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 6 f
f
    Integer -> g -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 7 g
g

instance (Pushable a, Pushable b, Pushable c, Pushable d,
          Pushable e, Pushable f, Pushable g, Pushable h) =>
         Pushable (a, b, c, d, e, f, g, h)
 where
  push :: (a, b, c, d, e, f, g, h) -> Lua ()
push (a :: a
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: h
h) = do
    Lua ()
newtable
    Integer -> a -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 1 a
a
    Integer -> b -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 2 b
b
    Integer -> c -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 3 c
c
    Integer -> d -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 4 d
d
    Integer -> e -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 5 e
e
    Integer -> f -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 6 f
f
    Integer -> g -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 7 g
g
    Integer -> h -> Lua ()
forall a. Pushable a => Integer -> a -> Lua ()
addRawInt 8 h
h

-- | Set numeric key/value in table at the top of the stack.
addRawInt :: Pushable a => Lua.Integer -> a -> Lua ()
addRawInt :: Integer -> a -> Lua ()
addRawInt idx :: Integer
idx val :: a
val = do
  a -> Lua ()
forall a. Pushable a => a -> Lua ()
push a
val
  StackIndex -> Integer -> Lua ()
rawseti (-2) Integer
idx