@@ -296,18 +296,13 @@ foreign import javascript unsafe "function(){ return $1(arguments); }" funWithAr
296296
297297#else
298298
299−askJSContext :: MonadIO m => WithWebView x m JSContextRef
300−askJSContext = do
301− wv <- askWebView
302− liftIO $ webFrameGetGlobalContext =<< webViewGetMainFrame (unWebViewSingleton wv)
303−
304299-- | Make a JS string available that is not wrapped up as a JSValueRef
305300withJSStringRaw :: MonadAsyncException m => String -> (JSStringRef -> m r) -> m r
306301withJSStringRaw str a = do
307302 bracket (liftIO $ jsstringcreatewithutf8cstring str) (liftIO . jsstringrelease) $ \strRef -> do
308303 a strRef
309304
310−fromJSNumberRaw :: MonadIO m => JSValueRef -> WithWebView x m Double
305+fromJSNumberRaw :: (MonadIO m, HasJSContext m) => JSValueRef -> m Double
311306fromJSNumberRaw val = do
312307 jsContext <- askJSContext
313308 liftIO $ jsvaluetonumber jsContext val nullPtr --TODO: Exceptions
@@ -324,15 +319,70 @@ instance MonadIO m => HasJS (JSCtx_JavaScriptCore x) (WithWebView x m) where
324319 wv <- askWebView
325320 liftIO $ runWithWebView a wv
326321
322+newtype WithJSContext x m a = WithJSContext { unWithJSContext :: ReaderT JSContextRef m a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadTrans, MonadException, MonadAsyncException)
323+
324+runWithJSContext :: WithJSContext x m a -> JSContextRef -> m a
325+runWithJSContext = runReaderT . unWithJSContext
326+
327+class Monad m => HasJSContext m where
328+ askJSContext :: m JSContextRef
329+
330+instance MonadIO m => HasJSContext (WithWebView x m) where
331+ askJSContext = do
332+ wv <- askWebView
333+ liftIO $ webFrameGetGlobalContext =<< webViewGetMainFrame (unWebViewSingleton wv)
334+
335+instance Monad m => HasJSContext (WithJSContext x m) where
336+ askJSContext = WithJSContext ask
337+
338+lowerWithJSContext :: (HasJSContext m, MonadIO m) => WithJSContext x IO a -> m a
339+lowerWithJSContext a = do
340+ c <- askJSContext
341+ liftIO $ runWithJSContext a c
342+
343+liftWithWebViewThroughWithJSContext :: (HasJSContext m, HasWebView m, MonadIO m, MonadTrans t, Monad m1)
344+ => ((t1 -> t m1 a) -> WithJSContext x IO b)
345+ -> (t1 -> WithWebView (WebViewPhantom m) m1 a)
346+ -> m b
347+liftWithWebViewThroughWithJSContext f a = do
348+ wv <- askWebView
349+ lowerWithJSContext $ f $ \b' -> lift $ runWithWebView (a b') wv
350+
327351instance MonadJS (JSCtx_JavaScriptCore x) (WithWebView x IO) where
352+ forkJS a = do
353+ wv <- askWebView
354+ liftIO $ forkIO $ runWithWebView a wv
355+ mkJSFun a = do
356+ wv <- askWebView
357+ lowerWithJSContext $ mkJSFun $ \args -> lift $ runWithWebView (a args) wv
358+ runJS expr args = lowerWithJSContext $ runJS expr args
359+ mkJSUndefined = lowerWithJSContext mkJSUndefined
360+ isJSNull = lowerWithJSContext . isJSNull
361+ isJSUndefined = lowerWithJSContext . isJSUndefined
362+ fromJSBool = lowerWithJSContext . fromJSBool
363+ fromJSString = lowerWithJSContext . fromJSString
364+ fromJSArray = lowerWithJSContext . fromJSArray
365+ fromJSUint8Array = lowerWithJSContext . fromJSUint8Array
366+ fromJSNumber = lowerWithJSContext . fromJSNumber
367+ freeJSFun = lowerWithJSContext . freeJSFun
368+ withJSBool = liftWithWebViewThroughWithJSContext . withJSBool
369+ withJSString = liftWithWebViewThroughWithJSContext . withJSString
370+ withJSNumber = liftWithWebViewThroughWithJSContext . withJSNumber
371+ withJSArray = liftWithWebViewThroughWithJSContext . withJSArray
372+ withJSUint8Array = liftWithWebViewThroughWithJSContext . withJSUint8Array
373+ withJSNode = liftWithWebViewThroughWithJSContext . withJSNode
374+ setJSProp propName valRef objRef = lowerWithJSContext $ setJSProp propName valRef objRef
375+ getJSProp propName objRef = lowerWithJSContext $ getJSProp propName objRef
376+
377+instance MonadJS (JSCtx_JavaScriptCore x) (WithJSContext x IO) where
328378 runJS (JSFFI body) args = do
329379 jsContext <- askJSContext
330380 withJSArray args $ \(JSRef_JavaScriptCore this) -> liftIO $ do
331381 result <- bracket (jsstringcreatewithutf8cstring body) jsstringrelease $ \script -> jsevaluatescript jsContext script this nullPtr 1 nullPtr
332382 return $ JSRef_JavaScriptCore result --TODO: Protect and unprotect result
333383 forkJS a = do
334− wv <- askWebView
335− liftIO $ forkIO $ runWithWebView a wv
384+ c <- askJSContext
385+ liftIO $ forkIO $ runWithJSContext a c
336386 mkJSUndefined = do
337387 jsContext <- askJSContext
338388 fmap JSRef_JavaScriptCore $ liftIO $ jsvaluemakeundefined jsContext
@@ -393,14 +443,13 @@ instance MonadJS (JSCtx_JavaScriptCore x) (WithWebView x IO) where
393443 jsContext <- askJSContext
394444 liftIO $ jsvaluetonumber jsContext val nullPtr --TODO: Exceptions
395445 mkJSFun a = do
396− wv <- askWebView
397446 jsContext <- askJSContext
398447 cb <- liftIO $ mkJSObjectCallAsFunctionCallback $ \_ _ _ argc argv _ -> do --TODO: Use the exception pointer to handle haskell exceptions
399448 args <- forM [0..fromIntegral (argc-1)] $ \n -> do
400449 x <- peekElemOff argv n
401450 jsvalueprotect jsContext x
402451 return $ JSRef_JavaScriptCore x --TODO: Unprotect eventually
403− unJSRef_JavaScriptCore <$> runWithWebView (a args) wv
452+ unJSRef_JavaScriptCore <$> runWithJSContext (a args) jsContext
404453 cbRef <- liftIO $ jsobjectmakefunctionwithcallback jsContext nullPtr cb
405454 liftIO $ jsvalueprotect jsContext cbRef
406455 return $ JSFun $ JSRef_JavaScriptCore cbRef