git.iko.soy/jsaddle
on master help sign in
Trying out some different threading options
087d653Hamish Mackenzie
jsaddle-wkwebview/src/Language/Javascript/JSaddle/WKWebView/Internal.hs+16−12
compare with master
unifiedsplit
@@ -7,7 +7,8 @@ module Language.Javascript.JSaddle.WKWebView.Internal
7 ) where
7 ) where
8
8
9import Control.Monad (void, join)
9import Control.Monad (void, join)
10−import Control.Concurrent (forkIO)
10+import Control.Concurrent (forkIO, forkOS)
11+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
11
12
12import Data.Monoid ((<>))
13import Data.Monoid ((<>))
13import Data.ByteString (useAsCString, packCString)
14import Data.ByteString (useAsCString, packCString)
@@ -37,9 +38,8 @@ foreign import ccall mainBundleResourcePathC :: IO CString
37-- | Run JSaddle in WKWebView
38-- | Run JSaddle in WKWebView
38jsaddleMain :: JSM () -> WKWebView -> IO ()
39jsaddleMain :: JSM () -> WKWebView -> IO ()
39jsaddleMain f webView = do
40jsaddleMain f webView = do
40− jsaddleMain' f webView
41+ jsaddleMain' f webView $
41−
42− useAsCString (toStrict indexHtml) $ loadHTMLString webView
42+ useAsCString (toStrict indexHtml) $ loadHTMLString webView
43
43
44-- | Run JSaddle in a WKWebView first loading the specified file
44-- | Run JSaddle in a WKWebView first loading the specified file
45-- from the mainBundle (relative to the resourcePath).
45-- from the mainBundle (relative to the resourcePath).
@@ -47,23 +47,27 @@ jsaddleMainFile :: BS.ByteString -- ^ The file to navigate to.
47 -> BS.ByteString -- ^ The path to allow read access to.
47 -> BS.ByteString -- ^ The path to allow read access to.
48 -> JSM () -> WKWebView -> IO ()
48 -> JSM () -> WKWebView -> IO ()
49jsaddleMainFile url allowing f webView = do
49jsaddleMainFile url allowing f webView = do
50− jsaddleMain' f webView
50+ jsaddleMain' f webView $
51+ useAsCString url $ \u ->
52+ useAsCString allowing $ \a ->
53+ loadBundleFile webView u a
51
54
52− useAsCString url $ \u ->
55+jsaddleMain' :: JSM () -> WKWebView -> IO () -> IO ()
53− useAsCString allowing $ \a ->
56+jsaddleMain' f webView loadHtml = do
54− loadBundleFile webView u a
57+ ready <- newEmptyMVar
55
58
56−jsaddleMain' :: JSM () -> WKWebView -> IO ()
57−jsaddleMain' f webView = do
58 (processResult, start) <- runJavaScript (\batch ->
59 (processResult, start) <- runJavaScript (\batch ->
59 useAsCString (toStrict $ "runJSaddleBatch(" <> encode batch <> ");") $
60 useAsCString (toStrict $ "runJSaddleBatch(" <> encode batch <> ");") $
60 evaluateJavaScript webView)
61 evaluateJavaScript webView)
61 f
62 f
62
63
63− startHandler <- newStablePtr (
64+ startHandler <- newStablePtr (putMVar ready ())
64− useAsCString (toStrict jsaddleJs) (evaluateJavaScript webView) >> void (forkIO start))
65 resultHandler <- newStablePtr processResult
65 resultHandler <- newStablePtr processResult
66 addJSaddleHandler webView startHandler resultHandler
66 addJSaddleHandler webView startHandler resultHandler
67+ loadHtml
68+ void . forkOS $ do
69+ takeMVar ready
70+ useAsCString (toStrict jsaddleJs) (evaluateJavaScript webView) >> void (forkIO start)
67
71
68jsaddleStart :: StablePtr (IO ()) -> IO ()
72jsaddleStart :: StablePtr (IO ()) -> IO ()
69jsaddleStart ptrHandler = join (deRefStablePtr ptrHandler)
73jsaddleStart ptrHandler = join (deRefStablePtr ptrHandler)
jsaddle/src/Language/Javascript/JSaddle/Run.hs+4−3
@@ -42,7 +42,7 @@ import Control.Monad (void, when, forever, zipWithM_)
42import Control.Monad.IO.Class (MonadIO(..))
42import Control.Monad.IO.Class (MonadIO(..))
43import Control.Monad.Trans.Reader (ask, runReaderT)
43import Control.Monad.Trans.Reader (ask, runReaderT)
44import Control.Monad.STM (atomically)
44import Control.Monad.STM (atomically)
45−import Control.Concurrent (forkIO)
45+import Control.Concurrent (forkIO, forkOS)
46import Control.Concurrent.STM.TChan
46import Control.Concurrent.STM.TChan
47 (tryReadTChan, TChan, readTChan, writeTChan, newTChanIO)
47 (tryReadTChan, TChan, readTChan, writeTChan, newTChanIO)
48import Control.Concurrent.STM.TVar
48import Control.Concurrent.STM.TVar
@@ -164,8 +164,9 @@ runJavaScript sendBatch entryPoint = do
164 Nothing -> liftIO $ putStrLn "Callback called after it was freed"
164 Nothing -> liftIO $ putStrLn "Callback called after it was freed"
165 Just cb -> void . forkIO $ runReaderT (unJSM $ cb f' this' args) ctx
165 Just cb -> void . forkIO $ runReaderT (unJSM $ cb f' this' args) ctx
166 m -> atomically $ writeTChan recvChan m
166 m -> atomically $ writeTChan recvChan m
167− _ <- forkIO . forever $ readBatch commandChan >>= \case
167+ _ <- forkOS . forever $ readBatch commandChan >>= \case
168− (batch, resultMVars) -> do
168+ (batch@(Batch cmds _), resultMVars) -> do
169+ -- putStrLn $ "sendBatch " <> show (length cmds, last cmds)
169 sendBatch batch
170 sendBatch batch
170 atomically (readTChan recvChan) >>= \case
171 atomically (readTChan recvChan) >>= \case
171 Success results -> zipWithM_ putMVar resultMVars results
172 Success results -> zipWithM_ putMVar resultMVars results