module Language.Javascript.JSaddle.Native (
#if !defined(ghcjs_HOST_OS)
wrapJSVal
, wrapJSString
, withJSVal
, withJSVals
, withObject
, withJSString
, withToJSVal
#endif
) where
#if !defined(ghcjs_HOST_OS)
import Control.Monad.Trans.Reader (ask)
import Control.Monad.IO.Class (MonadIO, MonadIO(..))
import Language.Javascript.JSaddle.Types
(JSContextRef(..), AsyncCommand(..), JSM, JSString(..),
Object(..), JSVal(..), JSValueReceived(..), JSValueForSend(..),
JSStringReceived(..), JSStringForSend(..), JSObjectForSend(..))
import Language.Javascript.JSaddle.Classes (ToJSVal(..))
import System.Mem.Weak (addFinalizer)
import Control.Monad.Primitive (touch)
import Control.Monad (when)
wrapJSVal :: JSValueReceived -> JSM JSVal
wrapJSVal (JSValueReceived ref) = do
let result = JSVal ref
when (ref >= 5) $ do
ctx <- ask
liftIO . addFinalizer result $ doSendAsyncCommand ctx $ FreeRef $ JSValueForSend ref
return result
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
withToJSVal :: ToJSVal val => val -> (JSValueForSend -> JSM a) -> JSM a
withToJSVal val f = do
v <- toJSVal val
withJSVal v f
#endif