{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
-----------------------------------------------------------------------------
--
-- Module      :  Language.Javascript.JSaddle.Native
-- Copyright   :  (c) Hamish Mackenzie
-- License     :  MIT
--
-- Maintainer  :  Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>
--
-- |
--
-----------------------------------------------------------------------------

module Language.Javascript.JSaddle.Native.Internal (
    wrapJSVal
  , wrapJSString
  , withJSVal
  , withJSVals
  , withObject
  , withJSString
  , setPropertyByName
  , setPropertyAtIndex
  , stringToValue
  , numberToValue
  , jsonValueToValue
  , getPropertyByName
  , getPropertyAtIndex
  , callAsFunction
  , callAsConstructor
  , newEmptyObject
  , newAsyncCallback
  , newSyncCallback
  , newArray
  , evaluateScript
  , deRefVal
  , valueToBool
  , valueToNumber
  , valueToString
  , valueToJSON
  , valueToJSONValue
  , isNull
  , isUndefined
  , strictEqual
  , instanceOf
  , propertyNames
) where

import Control.Monad.IO.Class (MonadIO(..))

import Data.Aeson (Value)

import Language.Javascript.JSaddle.Types
       (AsyncCommand(..), JSM(..), JSString(..), addCallback,
        Object(..), JSVal(..), JSValueForSend(..), JSCallAsFunction,
        JSStringReceived(..), JSStringForSend(..), JSObjectForSend(..))
import Language.Javascript.JSaddle.Monad (askJSM)
import Language.Javascript.JSaddle.Run
       (Command(..), Result(..), sendCommand,
        sendAsyncCommand, sendLazyCommand, wrapJSVal)
import GHC.IORef (IORef(..), readIORef)
import GHC.STRef (STRef(..))
import GHC.IO (IO(..))
import GHC.Base (touch#)

wrapJSString :: MonadIO m => JSStringReceived -> m JSString
wrapJSString :: JSStringReceived -> m JSString
wrapJSString (JSStringReceived Text
ref) = JSString -> m JSString
forall (m :: * -> *) a. Monad m => a -> m a
return (JSString -> m JSString) -> JSString -> m JSString
forall a b. (a -> b) -> a -> b
$ Text -> JSString
JSString Text
ref

touchIORef :: IORef a -> IO ()
touchIORef :: IORef a -> IO ()
touchIORef (IORef (STRef MutVar# RealWorld a
r#)) = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case MutVar# RealWorld a -> State# RealWorld -> State# RealWorld
forall a. a -> State# RealWorld -> State# RealWorld
touch# MutVar# RealWorld a
r# State# RealWorld
s of State# RealWorld
s' -> (# State# RealWorld
s', () #)

withJSVal :: MonadIO m => JSVal -> (JSValueForSend -> m a) -> m a
withJSVal :: JSVal -> (JSValueForSend -> m a) -> m a
withJSVal (JSVal IORef JSValueRef
ref) JSValueForSend -> m a
f = do
    a
result <- (JSValueForSend -> m a
f (JSValueForSend -> m a)
-> (JSValueRef -> JSValueForSend) -> JSValueRef -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValueRef -> JSValueForSend
JSValueForSend) (JSValueRef -> m a) -> m JSValueRef -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO JSValueRef -> m JSValueRef
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef JSValueRef -> IO JSValueRef
forall a. IORef a -> IO a
readIORef IORef JSValueRef
ref)
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef JSValueRef -> IO ()
forall a. IORef a -> IO ()
touchIORef IORef JSValueRef
ref
    a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

withJSVals :: MonadIO m => [JSVal] -> ([JSValueForSend] -> m a) -> m a
withJSVals :: [JSVal] -> ([JSValueForSend] -> m a) -> m a
withJSVals [JSVal]
v [JSValueForSend] -> m a
f =
 do a
result <- [JSValueForSend] -> m a
f ([JSValueForSend] -> m a) -> m [JSValueForSend] -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JSVal -> m JSValueForSend) -> [JSVal] -> m [JSValueForSend]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(JSVal IORef JSValueRef
ref) -> IO JSValueForSend -> m JSValueForSend
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO JSValueForSend -> m JSValueForSend)
-> IO JSValueForSend -> m JSValueForSend
forall a b. (a -> b) -> a -> b
$ JSValueRef -> JSValueForSend
JSValueForSend (JSValueRef -> JSValueForSend)
-> IO JSValueRef -> IO JSValueForSend
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef JSValueRef -> IO JSValueRef
forall a. IORef a -> IO a
readIORef IORef JSValueRef
ref) [JSVal]
v
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ (JSVal -> IO ()) -> [JSVal] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(JSVal IORef JSValueRef
ref) -> IORef JSValueRef -> IO ()
forall a. IORef a -> IO ()
touchIORef IORef JSValueRef
ref) [JSVal]
v
    a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

withObject :: MonadIO m => Object -> (JSObjectForSend -> m a) -> m a
withObject :: Object -> (JSObjectForSend -> m a) -> m a
withObject (Object JSVal
o) JSObjectForSend -> m a
f = JSVal -> (JSValueForSend -> m a) -> m a
forall (m :: * -> *) a.
MonadIO m =>
JSVal -> (JSValueForSend -> m a) -> m a
withJSVal JSVal
o (JSObjectForSend -> m a
f (JSObjectForSend -> m a)
-> (JSValueForSend -> JSObjectForSend) -> JSValueForSend -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValueForSend -> JSObjectForSend
JSObjectForSend)

withJSString :: MonadIO m => JSString -> (JSStringForSend -> m a) -> m a
withJSString :: JSString -> (JSStringForSend -> m a) -> m a
withJSString (JSString Text
ref) JSStringForSend -> m a
f = JSStringForSend -> m a
f (Text -> JSStringForSend
JSStringForSend Text
ref)

setPropertyByName :: JSString -> JSVal -> Object -> JSM ()
setPropertyByName :: JSString -> JSVal -> Object -> JSM ()
setPropertyByName JSString
name JSVal
val Object
this =
    Object -> (JSObjectForSend -> JSM ()) -> JSM ()
forall (m :: * -> *) a.
MonadIO m =>
Object -> (JSObjectForSend -> m a) -> m a
withObject Object
this ((JSObjectForSend -> JSM ()) -> JSM ())
-> (JSObjectForSend -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \JSObjectForSend
rthis ->
        JSString -> (JSStringForSend -> JSM ()) -> JSM ()
forall (m :: * -> *) a.
MonadIO m =>
JSString -> (JSStringForSend -> m a) -> m a
withJSString JSString
name ((JSStringForSend -> JSM ()) -> JSM ())
-> (JSStringForSend -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \JSStringForSend
rname ->
            JSVal -> (JSValueForSend -> JSM ()) -> JSM ()
forall (m :: * -> *) a.
MonadIO m =>
JSVal -> (JSValueForSend -> m a) -> m a
withJSVal JSVal
val ((JSValueForSend -> JSM ()) -> JSM ())
-> (JSValueForSend -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \JSValueForSend
rval ->
                AsyncCommand -> JSM ()
sendAsyncCommand (AsyncCommand -> JSM ()) -> AsyncCommand -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSObjectForSend
-> JSStringForSend -> JSValueForSend -> AsyncCommand
SetPropertyByName JSObjectForSend
rthis JSStringForSend
rname JSValueForSend
rval
{-# INLINE setPropertyByName #-}

setPropertyAtIndex :: Int -> JSVal -> Object -> JSM ()
setPropertyAtIndex :: Int -> JSVal -> Object -> JSM ()
setPropertyAtIndex Int
index JSVal
val Object
this =
    Object -> (JSObjectForSend -> JSM ()) -> JSM ()
forall (m :: * -> *) a.
MonadIO m =>
Object -> (JSObjectForSend -> m a) -> m a
withObject Object
this ((JSObjectForSend -> JSM ()) -> JSM ())
-> (JSObjectForSend -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \JSObjectForSend
rthis ->
        JSVal -> (JSValueForSend -> JSM ()) -> JSM ()
forall (m :: * -> *) a.
MonadIO m =>
JSVal -> (JSValueForSend -> m a) -> m a
withJSVal JSVal
val ((JSValueForSend -> JSM ()) -> JSM ())
-> (JSValueForSend -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \JSValueForSend
rval ->
            AsyncCommand -> JSM ()
sendAsyncCommand (AsyncCommand -> JSM ()) -> AsyncCommand -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSObjectForSend -> Int -> JSValueForSend -> AsyncCommand
SetPropertyAtIndex JSObjectForSend
rthis Int
index JSValueForSend
rval
{-# INLINE setPropertyAtIndex #-}

stringToValue :: JSString -> JSM JSVal
stringToValue :: JSString -> JSM JSVal
stringToValue JSString
s = JSString -> (JSStringForSend -> JSM JSVal) -> JSM JSVal
forall (m :: * -> *) a.
MonadIO m =>
JSString -> (JSStringForSend -> m a) -> m a
withJSString JSString
s ((JSStringForSend -> JSM JSVal) -> JSM JSVal)
-> (JSStringForSend -> JSM JSVal) -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ (JSValueForSend -> AsyncCommand) -> JSM JSVal
sendLazyCommand ((JSValueForSend -> AsyncCommand) -> JSM JSVal)
-> (JSStringForSend -> JSValueForSend -> AsyncCommand)
-> JSStringForSend
-> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSStringForSend -> JSValueForSend -> AsyncCommand
StringToValue
{-# INLINE stringToValue #-}

numberToValue :: Double -> JSM JSVal
numberToValue :: Double -> JSM JSVal
numberToValue = (JSValueForSend -> AsyncCommand) -> JSM JSVal
sendLazyCommand ((JSValueForSend -> AsyncCommand) -> JSM JSVal)
-> (Double -> JSValueForSend -> AsyncCommand)
-> Double
-> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> JSValueForSend -> AsyncCommand
NumberToValue
{-# INLINE numberToValue #-}

jsonValueToValue :: Value -> JSM JSVal
jsonValueToValue :: Value -> JSM JSVal
jsonValueToValue = (JSValueForSend -> AsyncCommand) -> JSM JSVal
sendLazyCommand ((JSValueForSend -> AsyncCommand) -> JSM JSVal)
-> (Value -> JSValueForSend -> AsyncCommand) -> Value -> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> JSValueForSend -> AsyncCommand
JSONValueToValue
{-# INLINE jsonValueToValue #-}

getPropertyByName :: JSString -> Object -> JSM JSVal
getPropertyByName :: JSString -> Object -> JSM JSVal
getPropertyByName JSString
name Object
this =
    Object -> (JSObjectForSend -> JSM JSVal) -> JSM JSVal
forall (m :: * -> *) a.
MonadIO m =>
Object -> (JSObjectForSend -> m a) -> m a
withObject Object
this ((JSObjectForSend -> JSM JSVal) -> JSM JSVal)
-> (JSObjectForSend -> JSM JSVal) -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ \JSObjectForSend
rthis ->
        JSString -> (JSStringForSend -> JSM JSVal) -> JSM JSVal
forall (m :: * -> *) a.
MonadIO m =>
JSString -> (JSStringForSend -> m a) -> m a
withJSString JSString
name ((JSStringForSend -> JSM JSVal) -> JSM JSVal)
-> (JSStringForSend -> JSM JSVal) -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ (JSValueForSend -> AsyncCommand) -> JSM JSVal
sendLazyCommand ((JSValueForSend -> AsyncCommand) -> JSM JSVal)
-> (JSStringForSend -> JSValueForSend -> AsyncCommand)
-> JSStringForSend
-> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSObjectForSend
-> JSStringForSend -> JSValueForSend -> AsyncCommand
GetPropertyByName JSObjectForSend
rthis
{-# INLINE getPropertyByName #-}

getPropertyAtIndex :: Int -> Object -> JSM JSVal
getPropertyAtIndex :: Int -> Object -> JSM JSVal
getPropertyAtIndex Int
index Object
this =
    Object -> (JSObjectForSend -> JSM JSVal) -> JSM JSVal
forall (m :: * -> *) a.
MonadIO m =>
Object -> (JSObjectForSend -> m a) -> m a
withObject Object
this ((JSObjectForSend -> JSM JSVal) -> JSM JSVal)
-> (JSObjectForSend -> JSM JSVal) -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ \JSObjectForSend
rthis -> (JSValueForSend -> AsyncCommand) -> JSM JSVal
sendLazyCommand ((JSValueForSend -> AsyncCommand) -> JSM JSVal)
-> (JSValueForSend -> AsyncCommand) -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ JSObjectForSend -> Int -> JSValueForSend -> AsyncCommand
GetPropertyAtIndex JSObjectForSend
rthis Int
index
{-# INLINE getPropertyAtIndex #-}

callAsFunction :: Object -> Object -> [JSVal] -> JSM JSVal
callAsFunction :: Object -> Object -> [JSVal] -> JSM JSVal
callAsFunction Object
f Object
this [JSVal]
args =
    Object -> (JSObjectForSend -> JSM JSVal) -> JSM JSVal
forall (m :: * -> *) a.
MonadIO m =>
Object -> (JSObjectForSend -> m a) -> m a
withObject Object
f ((JSObjectForSend -> JSM JSVal) -> JSM JSVal)
-> (JSObjectForSend -> JSM JSVal) -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ \JSObjectForSend
rfunction ->
        Object -> (JSObjectForSend -> JSM JSVal) -> JSM JSVal
forall (m :: * -> *) a.
MonadIO m =>
Object -> (JSObjectForSend -> m a) -> m a
withObject Object
this ((JSObjectForSend -> JSM JSVal) -> JSM JSVal)
-> (JSObjectForSend -> JSM JSVal) -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ \JSObjectForSend
rthis ->
            [JSVal] -> ([JSValueForSend] -> JSM JSVal) -> JSM JSVal
forall (m :: * -> *) a.
MonadIO m =>
[JSVal] -> ([JSValueForSend] -> m a) -> m a
withJSVals [JSVal]
args (([JSValueForSend] -> JSM JSVal) -> JSM JSVal)
-> ([JSValueForSend] -> JSM JSVal) -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ (JSValueForSend -> AsyncCommand) -> JSM JSVal
sendLazyCommand ((JSValueForSend -> AsyncCommand) -> JSM JSVal)
-> ([JSValueForSend] -> JSValueForSend -> AsyncCommand)
-> [JSValueForSend]
-> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSObjectForSend
-> JSObjectForSend
-> [JSValueForSend]
-> JSValueForSend
-> AsyncCommand
CallAsFunction JSObjectForSend
rfunction JSObjectForSend
rthis
{-# INLINE callAsFunction #-}

callAsConstructor :: Object -> [JSVal] -> JSM JSVal
callAsConstructor :: Object -> [JSVal] -> JSM JSVal
callAsConstructor Object
f [JSVal]
args =
    Object -> (JSObjectForSend -> JSM JSVal) -> JSM JSVal
forall (m :: * -> *) a.
MonadIO m =>
Object -> (JSObjectForSend -> m a) -> m a
withObject Object
f ((JSObjectForSend -> JSM JSVal) -> JSM JSVal)
-> (JSObjectForSend -> JSM JSVal) -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ \JSObjectForSend
rfunction ->
        [JSVal] -> ([JSValueForSend] -> JSM JSVal) -> JSM JSVal
forall (m :: * -> *) a.
MonadIO m =>
[JSVal] -> ([JSValueForSend] -> m a) -> m a
withJSVals [JSVal]
args (([JSValueForSend] -> JSM JSVal) -> JSM JSVal)
-> ([JSValueForSend] -> JSM JSVal) -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ (JSValueForSend -> AsyncCommand) -> JSM JSVal
sendLazyCommand ((JSValueForSend -> AsyncCommand) -> JSM JSVal)
-> ([JSValueForSend] -> JSValueForSend -> AsyncCommand)
-> [JSValueForSend]
-> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSObjectForSend
-> [JSValueForSend] -> JSValueForSend -> AsyncCommand
CallAsConstructor JSObjectForSend
rfunction
{-# INLINE callAsConstructor #-}

newEmptyObject :: JSM Object
newEmptyObject :: JSM Object
newEmptyObject = JSVal -> Object
Object (JSVal -> Object) -> JSM JSVal -> JSM Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JSValueForSend -> AsyncCommand) -> JSM JSVal
sendLazyCommand JSValueForSend -> AsyncCommand
NewEmptyObject
{-# INLINE newEmptyObject #-}

newAsyncCallback :: JSCallAsFunction -> JSM Object
newAsyncCallback :: JSCallAsFunction -> JSM Object
newAsyncCallback JSCallAsFunction
f = do
    Object
object <- JSVal -> Object
Object (JSVal -> Object) -> JSM JSVal -> JSM Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JSValueForSend -> AsyncCommand) -> JSM JSVal
sendLazyCommand JSValueForSend -> AsyncCommand
NewAsyncCallback
    Object -> JSCallAsFunction -> IO ()
add <- JSContextRef -> Object -> JSCallAsFunction -> IO ()
addCallback (JSContextRef -> Object -> JSCallAsFunction -> IO ())
-> JSM JSContextRef -> JSM (Object -> JSCallAsFunction -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSM JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
    IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ Object -> JSCallAsFunction -> IO ()
add Object
object JSCallAsFunction
f
    Object -> JSM Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
object
{-# INLINE newAsyncCallback #-}

newSyncCallback :: JSCallAsFunction -> JSM Object
newSyncCallback :: JSCallAsFunction -> JSM Object
newSyncCallback JSCallAsFunction
f = do
    Object
object <- JSVal -> Object
Object (JSVal -> Object) -> JSM JSVal -> JSM Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JSValueForSend -> AsyncCommand) -> JSM JSVal
sendLazyCommand JSValueForSend -> AsyncCommand
NewSyncCallback
    Object -> JSCallAsFunction -> IO ()
add <- JSContextRef -> Object -> JSCallAsFunction -> IO ()
addCallback (JSContextRef -> Object -> JSCallAsFunction -> IO ())
-> JSM JSContextRef -> JSM (Object -> JSCallAsFunction -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSM JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
    IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ Object -> JSCallAsFunction -> IO ()
add Object
object JSCallAsFunction
f
    Object -> JSM Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
object
{-# INLINE newSyncCallback #-}

newArray :: [JSVal] -> JSM JSVal
newArray :: [JSVal] -> JSM JSVal
newArray [JSVal]
xs = [JSVal] -> ([JSValueForSend] -> JSM JSVal) -> JSM JSVal
forall (m :: * -> *) a.
MonadIO m =>
[JSVal] -> ([JSValueForSend] -> m a) -> m a
withJSVals [JSVal]
xs (([JSValueForSend] -> JSM JSVal) -> JSM JSVal)
-> ([JSValueForSend] -> JSM JSVal) -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ \[JSValueForSend]
xs' -> (JSValueForSend -> AsyncCommand) -> JSM JSVal
sendLazyCommand ([JSValueForSend] -> JSValueForSend -> AsyncCommand
NewArray [JSValueForSend]
xs')
{-# INLINE newArray #-}

evaluateScript :: JSString -> JSM JSVal
evaluateScript :: JSString -> JSM JSVal
evaluateScript JSString
script = JSString -> (JSStringForSend -> JSM JSVal) -> JSM JSVal
forall (m :: * -> *) a.
MonadIO m =>
JSString -> (JSStringForSend -> m a) -> m a
withJSString JSString
script ((JSStringForSend -> JSM JSVal) -> JSM JSVal)
-> (JSStringForSend -> JSM JSVal) -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ (JSValueForSend -> AsyncCommand) -> JSM JSVal
sendLazyCommand ((JSValueForSend -> AsyncCommand) -> JSM JSVal)
-> (JSStringForSend -> JSValueForSend -> AsyncCommand)
-> JSStringForSend
-> JSM JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSStringForSend -> JSValueForSend -> AsyncCommand
EvaluateScript
{-# INLINE evaluateScript #-}

deRefVal :: JSVal -> JSM Result
deRefVal :: JSVal -> JSM Result
deRefVal JSVal
value = JSVal -> (JSValueForSend -> JSM Result) -> JSM Result
forall (m :: * -> *) a.
MonadIO m =>
JSVal -> (JSValueForSend -> m a) -> m a
withJSVal JSVal
value ((JSValueForSend -> JSM Result) -> JSM Result)
-> (JSValueForSend -> JSM Result) -> JSM Result
forall a b. (a -> b) -> a -> b
$ Command -> JSM Result
sendCommand (Command -> JSM Result)
-> (JSValueForSend -> Command) -> JSValueForSend -> JSM Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValueForSend -> Command
DeRefVal
{-# INLINE deRefVal #-}

valueToBool :: JSVal -> JSM Bool
valueToBool :: JSVal -> JSM Bool
valueToBool v :: JSVal
v@(JSVal IORef JSValueRef
ref) = IO JSValueRef -> JSM JSValueRef
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef JSValueRef -> IO JSValueRef
forall a. IORef a -> IO a
readIORef IORef JSValueRef
ref) JSM JSValueRef -> (JSValueRef -> JSM Bool) -> JSM Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    JSValueRef
0 -> Bool -> JSM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False -- null
    JSValueRef
1 -> Bool -> JSM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False -- undefined
    JSValueRef
2 -> Bool -> JSM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False -- false
    JSValueRef
3 -> Bool -> JSM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True  -- true
    JSValueRef
_ -> JSVal -> (JSValueForSend -> JSM Bool) -> JSM Bool
forall (m :: * -> *) a.
MonadIO m =>
JSVal -> (JSValueForSend -> m a) -> m a
withJSVal JSVal
v ((JSValueForSend -> JSM Bool) -> JSM Bool)
-> (JSValueForSend -> JSM Bool) -> JSM Bool
forall a b. (a -> b) -> a -> b
$ \JSValueForSend
rval -> do
        ~(ValueToBoolResult Bool
result) <- Command -> JSM Result
sendCommand (JSValueForSend -> Command
ValueToBool JSValueForSend
rval)
        Bool -> JSM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result
{-# INLINE valueToBool #-}

valueToNumber :: JSVal -> JSM Double
valueToNumber :: JSVal -> JSM Double
valueToNumber JSVal
value =
    JSVal -> (JSValueForSend -> JSM Double) -> JSM Double
forall (m :: * -> *) a.
MonadIO m =>
JSVal -> (JSValueForSend -> m a) -> m a
withJSVal JSVal
value ((JSValueForSend -> JSM Double) -> JSM Double)
-> (JSValueForSend -> JSM Double) -> JSM Double
forall a b. (a -> b) -> a -> b
$ \JSValueForSend
rval -> do
        ~(ValueToNumberResult Double
result) <- Command -> JSM Result
sendCommand (JSValueForSend -> Command
ValueToNumber JSValueForSend
rval)
        Double -> JSM Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result
{-# INLINE valueToNumber #-}

valueToString :: JSVal -> JSM JSString
valueToString :: JSVal -> JSM JSString
valueToString JSVal
value = JSVal -> (JSValueForSend -> JSM JSString) -> JSM JSString
forall (m :: * -> *) a.
MonadIO m =>
JSVal -> (JSValueForSend -> m a) -> m a
withJSVal JSVal
value ((JSValueForSend -> JSM JSString) -> JSM JSString)
-> (JSValueForSend -> JSM JSString) -> JSM JSString
forall a b. (a -> b) -> a -> b
$ \JSValueForSend
rval -> do
    ~(ValueToStringResult JSStringReceived
result) <- Command -> JSM Result
sendCommand (JSValueForSend -> Command
ValueToString JSValueForSend
rval)
    JSStringReceived -> JSM JSString
forall (m :: * -> *). MonadIO m => JSStringReceived -> m JSString
wrapJSString JSStringReceived
result
{-# INLINE valueToString #-}

valueToJSON :: JSVal -> JSM JSString
valueToJSON :: JSVal -> JSM JSString
valueToJSON JSVal
value = JSVal -> (JSValueForSend -> JSM JSString) -> JSM JSString
forall (m :: * -> *) a.
MonadIO m =>
JSVal -> (JSValueForSend -> m a) -> m a
withJSVal JSVal
value ((JSValueForSend -> JSM JSString) -> JSM JSString)
-> (JSValueForSend -> JSM JSString) -> JSM JSString
forall a b. (a -> b) -> a -> b
$ \JSValueForSend
rval -> do
    ~(ValueToJSONResult JSStringReceived
result) <- Command -> JSM Result
sendCommand (JSValueForSend -> Command
ValueToJSON JSValueForSend
rval)
    JSStringReceived -> JSM JSString
forall (m :: * -> *). MonadIO m => JSStringReceived -> m JSString
wrapJSString JSStringReceived
result
{-# INLINE valueToJSON #-}

valueToJSONValue :: JSVal -> JSM Value
valueToJSONValue :: JSVal -> JSM Value
valueToJSONValue JSVal
value = JSVal -> (JSValueForSend -> JSM Value) -> JSM Value
forall (m :: * -> *) a.
MonadIO m =>
JSVal -> (JSValueForSend -> m a) -> m a
withJSVal JSVal
value ((JSValueForSend -> JSM Value) -> JSM Value)
-> (JSValueForSend -> JSM Value) -> JSM Value
forall a b. (a -> b) -> a -> b
$ \JSValueForSend
rval -> do
    ~(ValueToJSONValueResult Value
result) <- Command -> JSM Result
sendCommand (JSValueForSend -> Command
ValueToJSONValue JSValueForSend
rval)
    Value -> JSM Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result
{-# INLINE valueToJSONValue #-}

isNull :: JSVal -> JSM Bool
isNull :: JSVal -> JSM Bool
isNull v :: JSVal
v@(JSVal IORef JSValueRef
ref) = IO JSValueRef -> JSM JSValueRef
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef JSValueRef -> IO JSValueRef
forall a. IORef a -> IO a
readIORef IORef JSValueRef
ref) JSM JSValueRef -> (JSValueRef -> JSM Bool) -> JSM Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    JSValueRef
0 -> Bool -> JSM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True  -- null
    JSValueRef
1 -> Bool -> JSM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False -- undefined
    JSValueRef
2 -> Bool -> JSM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False -- false
    JSValueRef
3 -> Bool -> JSM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False -- true
    JSValueRef
_ -> JSVal -> (JSValueForSend -> JSM Bool) -> JSM Bool
forall (m :: * -> *) a.
MonadIO m =>
JSVal -> (JSValueForSend -> m a) -> m a
withJSVal JSVal
v ((JSValueForSend -> JSM Bool) -> JSM Bool)
-> (JSValueForSend -> JSM Bool) -> JSM Bool
forall a b. (a -> b) -> a -> b
$ \JSValueForSend
rval -> do
        ~(IsNullResult Bool
result) <- Command -> JSM Result
sendCommand (Command -> JSM Result) -> Command -> JSM Result
forall a b. (a -> b) -> a -> b
$ JSValueForSend -> Command
IsNull JSValueForSend
rval
        Bool -> JSM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result
{-# INLINE isNull #-}

isUndefined :: JSVal -> JSM Bool
isUndefined :: JSVal -> JSM Bool
isUndefined v :: JSVal
v@(JSVal IORef JSValueRef
ref) = IO JSValueRef -> JSM JSValueRef
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef JSValueRef -> IO JSValueRef
forall a. IORef a -> IO a
readIORef IORef JSValueRef
ref) JSM JSValueRef -> (JSValueRef -> JSM Bool) -> JSM Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    JSValueRef
0 -> Bool -> JSM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False -- null
    JSValueRef
1 -> Bool -> JSM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True  -- undefined
    JSValueRef
2 -> Bool -> JSM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False -- false
    JSValueRef
3 -> Bool -> JSM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False -- true
    JSValueRef
_ -> JSVal -> (JSValueForSend -> JSM Bool) -> JSM Bool
forall (m :: * -> *) a.
MonadIO m =>
JSVal -> (JSValueForSend -> m a) -> m a
withJSVal JSVal
v ((JSValueForSend -> JSM Bool) -> JSM Bool)
-> (JSValueForSend -> JSM Bool) -> JSM Bool
forall a b. (a -> b) -> a -> b
$ \JSValueForSend
rval -> do
        ~(IsUndefinedResult Bool
result) <- Command -> JSM Result
sendCommand (Command -> JSM Result) -> Command -> JSM Result
forall a b. (a -> b) -> a -> b
$ JSValueForSend -> Command
IsUndefined JSValueForSend
rval
        Bool -> JSM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result
{-# INLINE isUndefined #-}

strictEqual :: JSVal -> JSVal -> JSM Bool
strictEqual :: JSVal -> JSVal -> JSM Bool
strictEqual JSVal
a JSVal
b =
    JSVal -> (JSValueForSend -> JSM Bool) -> JSM Bool
forall (m :: * -> *) a.
MonadIO m =>
JSVal -> (JSValueForSend -> m a) -> m a
withJSVal JSVal
a ((JSValueForSend -> JSM Bool) -> JSM Bool)
-> (JSValueForSend -> JSM Bool) -> JSM Bool
forall a b. (a -> b) -> a -> b
$ \JSValueForSend
aref ->
        JSVal -> (JSValueForSend -> JSM Bool) -> JSM Bool
forall (m :: * -> *) a.
MonadIO m =>
JSVal -> (JSValueForSend -> m a) -> m a
withJSVal JSVal
b ((JSValueForSend -> JSM Bool) -> JSM Bool)
-> (JSValueForSend -> JSM Bool) -> JSM Bool
forall a b. (a -> b) -> a -> b
$ \JSValueForSend
bref -> do
            ~(StrictEqualResult Bool
result) <- Command -> JSM Result
sendCommand (Command -> JSM Result) -> Command -> JSM Result
forall a b. (a -> b) -> a -> b
$ JSValueForSend -> JSValueForSend -> Command
StrictEqual JSValueForSend
aref JSValueForSend
bref
            Bool -> JSM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result
{-# INLINE strictEqual #-}

instanceOf :: JSVal -> Object -> JSM Bool
instanceOf :: JSVal -> Object -> JSM Bool
instanceOf JSVal
value Object
constructor =
    JSVal -> (JSValueForSend -> JSM Bool) -> JSM Bool
forall (m :: * -> *) a.
MonadIO m =>
JSVal -> (JSValueForSend -> m a) -> m a
withJSVal JSVal
value ((JSValueForSend -> JSM Bool) -> JSM Bool)
-> (JSValueForSend -> JSM Bool) -> JSM Bool
forall a b. (a -> b) -> a -> b
$ \JSValueForSend
rval ->
        Object -> (JSObjectForSend -> JSM Bool) -> JSM Bool
forall (m :: * -> *) a.
MonadIO m =>
Object -> (JSObjectForSend -> m a) -> m a
withObject Object
constructor ((JSObjectForSend -> JSM Bool) -> JSM Bool)
-> (JSObjectForSend -> JSM Bool) -> JSM Bool
forall a b. (a -> b) -> a -> b
$ \JSObjectForSend
c' -> do
            ~(InstanceOfResult Bool
result) <- Command -> JSM Result
sendCommand (Command -> JSM Result) -> Command -> JSM Result
forall a b. (a -> b) -> a -> b
$ JSValueForSend -> JSObjectForSend -> Command
InstanceOf JSValueForSend
rval JSObjectForSend
c'
            Bool -> JSM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result
{-# INLINE instanceOf #-}

propertyNames :: Object -> JSM [JSString]
propertyNames :: Object -> JSM [JSString]
propertyNames Object
this =
    Object -> (JSObjectForSend -> JSM [JSString]) -> JSM [JSString]
forall (m :: * -> *) a.
MonadIO m =>
Object -> (JSObjectForSend -> m a) -> m a
withObject Object
this ((JSObjectForSend -> JSM [JSString]) -> JSM [JSString])
-> (JSObjectForSend -> JSM [JSString]) -> JSM [JSString]
forall a b. (a -> b) -> a -> b
$ \JSObjectForSend
rthis -> do
        ~(PropertyNamesResult [JSStringReceived]
result) <- Command -> JSM Result
sendCommand (Command -> JSM Result) -> Command -> JSM Result
forall a b. (a -> b) -> a -> b
$ JSObjectForSend -> Command
PropertyNames JSObjectForSend
rthis
        (JSStringReceived -> JSM JSString)
-> [JSStringReceived] -> JSM [JSString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM JSStringReceived -> JSM JSString
forall (m :: * -> *). MonadIO m => JSStringReceived -> m JSString
wrapJSString [JSStringReceived]
result
{-# INLINE propertyNames #-}