git.iko.soy/jsaddle
on dcbc28e help sign in
jsaddle/src/Language/Javascript/JSaddle/Native.hs
102 lines 3.2 kB history raw
1{-# LANGUAGE CPP #-}
2-----------------------------------------------------------------------------
3--
4-- Module : Language.Javascript.JSaddle.Native
5-- Copyright : (c) Hamish Mackenzie
6-- License : MIT
7--
8-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>
9--
10-- |
11--
12-----------------------------------------------------------------------------
14module Language.Javascript.JSaddle.Native (
15#if !defined(ghcjs_HOST_OS)
16 makeNewJSVal
17 , makeNewJSString
18 , wrapJSString
19 , withJSVal
20 , withJSVals
21 , withObject
22 , withJSString
23 , withToJSVal
24#endif
25) where
27#if !defined(ghcjs_HOST_OS)
28import Control.Monad.Trans.Reader (ask)
29import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
30 (JSObjectRef, OpaqueJSString, JSStringRef, OpaqueJSContext,
31 OpaqueJSValue, JSValueRef)
32import Foreign.ForeignPtr
33 (newForeignPtr_, touchForeignPtr, FinalizerPtr, newForeignPtr,
34 FinalizerEnvPtr, newForeignPtrEnv, ForeignPtr)
35import Control.Monad.IO.Class (MonadIO, MonadIO(..))
36import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef
37 (jsvalueprotect)
38import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSStringRef
39 (jsstringretain)
40import Language.Javascript.JSaddle.Types
41 (JSM, JSString, Object(..), JSVal)
42import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
43import Language.Javascript.JSaddle.Classes (ToJSVal(..), ToJSVal)
44import Foreign.Ptr (nullPtr)
46makeNewJSVal :: JSValueRef -> JSM (ForeignPtr OpaqueJSValue)
47makeNewJSVal val = do
48 ctx <- ask
49 liftIO $ do
50 jsvalueprotect ctx val
51 newForeignPtrEnv jsValueUnprotect ctx val
53foreign import ccall unsafe "&JSValueUnprotect"
54 jsValueUnprotect :: FinalizerEnvPtr OpaqueJSContext OpaqueJSValue
56makeNewJSString :: MonadIO m => JSStringRef -> m (ForeignPtr OpaqueJSString)
57makeNewJSString s | s == nullPtr =
58 liftIO $ newForeignPtr_ s
59makeNewJSString s =
60 liftIO $ do
61 s' <- jsstringretain s
62 newForeignPtr jsStringRelease s'
64wrapJSString :: MonadIO m => JSStringRef -> m (ForeignPtr OpaqueJSString)
65wrapJSString s | s == nullPtr =
66 liftIO $ newForeignPtr_ s
67wrapJSString s = liftIO $ newForeignPtr jsStringRelease s
69foreign import ccall unsafe "&JSStringRelease"
70 jsStringRelease :: FinalizerPtr OpaqueJSString
72withJSVal :: MonadIO m => JSVal -> (JSValueRef -> m a) -> m a
73withJSVal v f =
74 do result <- f (unsafeForeignPtrToPtr v)
75 liftIO $ touchForeignPtr v
76 return result
78withJSVals :: MonadIO m => [JSVal] -> ([JSValueRef] -> m a) -> m a
79withJSVals v f =
80 do result <- f (map unsafeForeignPtrToPtr v)
81 liftIO $ mapM_ touchForeignPtr v
82 return result
84withObject :: MonadIO m => Object -> (JSObjectRef -> m a) -> m a
85withObject (Object o) f = do
86 result <- f (unsafeForeignPtrToPtr o)
87 liftIO $ touchForeignPtr o
88 return result
90withJSString :: MonadIO m => JSString -> (JSStringRef -> m a) -> m a
91withJSString v f =
92 do result <- f (unsafeForeignPtrToPtr v)
93 liftIO $ touchForeignPtr v
94 return result
96withToJSVal :: ToJSVal val => val -> (JSValueRef -> JSM a) -> JSM a
97withToJSVal val f = do
98 v <- toJSVal val
99 withJSVal v f
100{-# INLINE withToJSVal #-}
101#endif