git.iko.soy/jsaddle
on master help sign in
Trying out some different threading options
commit087d653169c4d0732a86210b208279651a38b420 authorHamish Mackenzie <Hamish.K.Mackenzie@googlemail.com> dateSat 18 Feb 2017, 03:14 (10 years ago) parent8096eef
2 files changed+20−15
compare with master
unifiedsplit
jsaddle-wkwebview/src/Language/Javascript/JSaddle/WKWebView/Internal.hs+16−12 jsaddle/src/Language/Javascript/JSaddle/Run.hs+4−3
jsaddle-wkwebview/src/Language/Javascript/JSaddle/WKWebView/Internal.hs+16−12
@@ -7,7 +7,8 @@ module Language.Javascript.JSaddle.WKWebView.Internal
77 ) where
88
99import Control.Monad (void, join)
10−import Control.Concurrent (forkIO)
10+import Control.Concurrent (forkIO, forkOS)
11+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
1112
1213import Data.Monoid ((<>))
1314import Data.ByteString (useAsCString, packCString)
@@ -37,9 +38,8 @@ foreign import ccall mainBundleResourcePathC :: IO CString
3738-- | Run JSaddle in WKWebView
3839jsaddleMain :: JSM () -> WKWebView -> IO ()
3940jsaddleMain f webView = do
40− jsaddleMain' f webView
41−
42− useAsCString (toStrict indexHtml) $ loadHTMLString webView
41+ jsaddleMain' f webView $
42+ useAsCString (toStrict indexHtml) $ loadHTMLString webView
4343
4444-- | Run JSaddle in a WKWebView first loading the specified file
4545-- from the mainBundle (relative to the resourcePath).
@@ -47,23 +47,27 @@ jsaddleMainFile :: BS.ByteString -- ^ The file to navigate to.
4747 -> BS.ByteString -- ^ The path to allow read access to.
4848 -> JSM () -> WKWebView -> IO ()
4949jsaddleMainFile 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
5154
52− useAsCString url $ \u ->
53− useAsCString allowing $ \a ->
54− loadBundleFile webView u a
55+jsaddleMain' :: JSM () -> WKWebView -> IO () -> IO ()
56+jsaddleMain' f webView loadHtml = do
57+ ready <- newEmptyMVar
5558
56−jsaddleMain' :: JSM () -> WKWebView -> IO ()
57−jsaddleMain' f webView = do
5859 (processResult, start) <- runJavaScript (\batch ->
5960 useAsCString (toStrict $ "runJSaddleBatch(" <> encode batch <> ");") $
6061 evaluateJavaScript webView)
6162 f
6263
63− startHandler <- newStablePtr (
64− useAsCString (toStrict jsaddleJs) (evaluateJavaScript webView) >> void (forkIO start))
64+ startHandler <- newStablePtr (putMVar ready ())
6565 resultHandler <- newStablePtr processResult
6666 addJSaddleHandler webView startHandler resultHandler
67+ loadHtml
68+ void . forkOS $ do
69+ takeMVar ready
70+ useAsCString (toStrict jsaddleJs) (evaluateJavaScript webView) >> void (forkIO start)
6771
6872jsaddleStart :: StablePtr (IO ()) -> IO ()
6973jsaddleStart ptrHandler = join (deRefStablePtr ptrHandler)
jsaddle/src/Language/Javascript/JSaddle/Run.hs+4−3
@@ -42,7 +42,7 @@ import Control.Monad (void, when, forever, zipWithM_)
4242import Control.Monad.IO.Class (MonadIO(..))
4343import Control.Monad.Trans.Reader (ask, runReaderT)
4444import Control.Monad.STM (atomically)
45−import Control.Concurrent (forkIO)
45+import Control.Concurrent (forkIO, forkOS)
4646import Control.Concurrent.STM.TChan
4747 (tryReadTChan, TChan, readTChan, writeTChan, newTChanIO)
4848import Control.Concurrent.STM.TVar
@@ -164,8 +164,9 @@ runJavaScript sendBatch entryPoint = do
164164 Nothing -> liftIO $ putStrLn "Callback called after it was freed"
165165 Just cb -> void . forkIO $ runReaderT (unJSM $ cb f' this' args) ctx
166166 m -> atomically $ writeTChan recvChan m
167− _ <- forkIO . forever $ readBatch commandChan >>= \case
168− (batch, resultMVars) -> do
167+ _ <- forkOS . forever $ readBatch commandChan >>= \case
168+ (batch@(Batch cmds _), resultMVars) -> do
169+ -- putStrLn $ "sendBatch " <> show (length cmds, last cmds)
169170 sendBatch batch
170171 atomically (readTChan recvChan) >>= \case
171172 Success results -> zipWithM_ putMVar resultMVars results