module Language.Javascript.JSaddle.Native.Internal (
wrapJSVal
, wrapJSString
, withJSVal
, withJSVals
, withObject
, withJSString
, setPropertyByName
, setPropertyAtIndex
, stringToValue
, numberToValue
, jsonValueToValue
, getPropertyByName
, getPropertyAtIndex
, callAsFunction
, callAsConstructor
, newEmptyObject
, newCallback
, newArray
, evaluateScript
, deRefVal
, valueToBool
, valueToNumber
, valueToString
, valueToJSON
, valueToJSONValue
, isNull
, isUndefined
, strictEqual
, instanceOf
, propertyNames
) where
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Primitive (touch)
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(..), AsyncCommand(..), Result(..), sendCommand,
sendAsyncCommand, sendLazyCommand, wrapJSVal)
wrapJSString :: MonadIO m => JSStringReceived -> m JSString
wrapJSString (JSStringReceived ref) = return $ JSString ref
withJSVal :: MonadIO m => JSVal -> (JSValueForSend -> m a) -> m a
withJSVal v@(JSVal ref) f =
do result <- f (JSValueForSend ref)
liftIO $ touch v
return result
withJSVals :: MonadIO m => [JSVal] -> ([JSValueForSend] -> m a) -> m a
withJSVals v f =
do result <- f (map (\(JSVal ref) -> JSValueForSend ref) v)
liftIO $ mapM_ touch v
return result
withObject :: MonadIO m => Object -> (JSObjectForSend -> m a) -> m a
withObject (Object o) f = withJSVal o (f . JSObjectForSend)
withJSString :: MonadIO m => JSString -> (JSStringForSend -> m a) -> m a
withJSString v@(JSString ref) f =
do result <- f (JSStringForSend ref)
liftIO $ touch v
return result
setPropertyByName :: JSString -> JSVal -> Object -> JSM ()
setPropertyByName name val this =
withObject this $ \rthis ->
withJSString name $ \rname ->
withJSVal val $ \rval ->
sendAsyncCommand $ SetPropertyByName rthis rname rval
setPropertyAtIndex :: Int -> JSVal -> Object -> JSM ()
setPropertyAtIndex index val this =
withObject this $ \rthis ->
withJSVal val $ \rval ->
sendAsyncCommand $ SetPropertyAtIndex rthis index rval
stringToValue :: JSString -> JSM JSVal
stringToValue s = withJSString s $ sendLazyCommand . StringToValue
numberToValue :: Double -> JSM JSVal
numberToValue = sendLazyCommand . NumberToValue
jsonValueToValue :: Value -> JSM JSVal
jsonValueToValue = sendLazyCommand . JSONValueToValue
getPropertyByName :: JSString -> Object -> JSM JSVal
getPropertyByName name this =
withObject this $ \rthis ->
withJSString name $ sendLazyCommand . GetPropertyByName rthis
getPropertyAtIndex :: Int -> Object -> JSM JSVal
getPropertyAtIndex index this =
withObject this $ \rthis -> sendLazyCommand $ GetPropertyAtIndex rthis index
callAsFunction :: Object -> Object -> [JSVal] -> JSM JSVal
callAsFunction f this args =
withObject f $ \rfunction ->
withObject this $ \rthis ->
withJSVals args $ sendLazyCommand . CallAsFunction rfunction rthis
callAsConstructor :: Object -> [JSVal] -> JSM JSVal
callAsConstructor f args =
withObject f $ \rfunction ->
withJSVals args $ sendLazyCommand . CallAsConstructor rfunction
newEmptyObject :: JSM Object
newEmptyObject = Object <$> sendLazyCommand NewEmptyObject
newCallback :: JSCallAsFunction -> JSM Object
newCallback f = do
object <- Object <$> sendLazyCommand NewCallback
add <- addCallback <$> askJSM
liftIO $ add object f
return object
newArray :: [JSVal] -> JSM JSVal
newArray xs = withJSVals xs $ \xs' -> sendLazyCommand (NewArray xs')
evaluateScript :: JSString -> JSM JSVal
evaluateScript script = withJSString script $ sendLazyCommand . EvaluateScript
deRefVal :: JSVal -> JSM Result
deRefVal value = withJSVal value $ sendCommand . DeRefVal
valueToBool :: JSVal -> JSM Bool
valueToBool (JSVal 0) = return False
valueToBool (JSVal 1) = return False
valueToBool (JSVal 2) = return False
valueToBool (JSVal 3) = return True
valueToBool v = withJSVal v $ \rval -> do
~(ValueToBoolResult result) <- sendCommand (ValueToBool rval)
return result
valueToNumber :: JSVal -> JSM Double
valueToNumber value =
withJSVal value $ \rval -> do
~(ValueToNumberResult result) <- sendCommand (ValueToNumber rval)
return result
valueToString :: JSVal -> JSM JSString
valueToString value = withJSVal value $ \rval -> do
~(ValueToStringResult result) <- sendCommand (ValueToString rval)
wrapJSString result
valueToJSON :: JSVal -> JSM JSString
valueToJSON value = withJSVal value $ \rval -> do
~(ValueToJSONResult result) <- sendCommand (ValueToJSON rval)
wrapJSString result
valueToJSONValue :: JSVal -> JSM Value
valueToJSONValue value = withJSVal value $ \rval -> do
~(ValueToJSONValueResult result) <- sendCommand (ValueToJSONValue rval)
return result
isNull :: JSVal -> JSM Bool
isNull (JSVal 0) = return True
isNull v = withJSVal v $ \rval -> do
~(IsNullResult result) <- sendCommand $ IsNull rval
return result
isUndefined :: JSVal -> JSM Bool
isUndefined (JSVal 1) = return True
isUndefined v = withJSVal v $ \rval -> do
~(IsUndefinedResult result) <- sendCommand $ IsUndefined rval
return result
strictEqual :: JSVal -> JSVal -> JSM Bool
strictEqual a b =
withJSVal a $ \aref ->
withJSVal b $ \bref -> do
~(StrictEqualResult result) <- sendCommand $ StrictEqual aref bref
return result
instanceOf :: JSVal -> Object -> JSM Bool
instanceOf value constructor =
withJSVal value $ \rval ->
withObject constructor $ \c' -> do
~(InstanceOfResult result) <- sendCommand $ InstanceOf rval c'
return result
propertyNames :: Object -> JSM [JSString]
propertyNames this =
withObject this $ \rthis -> do
~(PropertyNamesResult result) <- sendCommand $ PropertyNames rthis
mapM wrapJSString result