@@ -9,11 +9,11 @@ import Control.Concurrent (forkIO)
99
1010import Data.Monoid ((<>))
1111import Data.ByteString (useAsCString, packCString)
12−import Data.ByteString.Unsafe (unsafeUseAsCString)
1312import Data.ByteString.Lazy (ByteString, toStrict, fromStrict)
13+import Data.ByteString.Char8 (unpack)
1414import Data.Aeson (encode, decode)
1515
16−import Foreign.C.String (CString)
16+import Foreign.C.String (CString, newCString)
1717import Foreign.Ptr (FunPtr, Ptr)
1818import Foreign.Marshal.Utils (new)
1919
@@ -23,13 +23,13 @@ import Language.Javascript.JSaddle.Run.Files (initState, runBatch, ghcjsHelpers)
2323
2424import Language.Javascript.JSaddle.CLib.Internal
2525
26−foreign import ccall "dynamic"
26+foreign import ccall safe "dynamic"
2727 mkCallback :: FunPtr (CString -> IO ()) -> CString -> IO ()
2828
29−foreign import ccall "wrapper"
29+foreign import ccall safe "wrapper"
3030 wrapStartCallback :: IO () -> IO (FunPtr (IO ()))
3131
32−foreign import ccall "wrapper"
32+foreign import ccall safe "wrapper"
3333 wrapMessageCallback :: (CString -> IO ()) -> IO (FunPtr (CString -> IO ()))
3434
3535jsaddleInit :: JSM () -> FunPtr (CString -> IO ()) -> IO (Ptr NativeCallbacks)
@@ -38,20 +38,20 @@ jsaddleInit jsm evaluateJavascriptAsyncPtr = do
3838 (processResult, start) <- runJavaScript (\batch ->
3939 useAsCString (toStrict $ "runJSaddleBatch(" <> encode batch <> ");") $
4040 evaluateJavascriptAsync) jsm
41− jsaddleStartPtr <- wrapStartCallback $ void $ forkIO start
41+ jsaddleStartPtr <- wrapStartCallback $ void $ forkIO $ start
4242 jsaddleResultPtr <- wrapMessageCallback $ \s -> do
4343 result <- decode . fromStrict <$> packCString s
4444 case result of
4545 Nothing -> error $ "jsaddle message decode failed: " <> show result
4646 Just r -> processResult r
47− unsafeUseAsCString (toStrict jsaddleJs) $ \jsaddleJsData ->
48− unsafeUseAsCString (toStrict indexHtml) $ \jsaddleHtmlData -> new $
49− NativeCallbacks
50− { _nativeCallbacks_jsaddleStart = jsaddleStartPtr
51− , _nativeCallbacks_jsaddleResult = jsaddleResultPtr
52− , _nativeCallbacks_jsaddleJsData = jsaddleJsData
53− , _nativeCallbacks_jsaddleHtmlData = jsaddleHtmlData
54− }
47+ jsaddleJsPtr <- newCString $ unpack $ toStrict jsaddleJs
48+ jsaddleHtmlPtr <- newCString $ unpack $ toStrict indexHtml
49+ new $ NativeCallbacks
50+ { _nativeCallbacks_jsaddleStart = jsaddleStartPtr
51+ , _nativeCallbacks_jsaddleResult = jsaddleResultPtr
52+ , _nativeCallbacks_jsaddleJsData = jsaddleJsPtr
53+ , _nativeCallbacks_jsaddleHtmlData = jsaddleHtmlPtr
54+ }
5555
5656jsaddleJs :: ByteString
5757jsaddleJs = ghcjsHelpers <> "\
@@ -60,8 +60,7 @@ jsaddleJs = ghcjsHelpers <> "\
6060 \ return function(batch) {\n\
6161 \ " <> runBatch (\a -> "jsaddle.postMessage(JSON.stringify(" <> a <> "));") <> "\
6262 \ };\n\
63− \})();\n\
64− \\0"
63+ \})();\n"
6564
6665indexHtml :: ByteString
6766indexHtml =
@@ -72,4 +71,4 @@ indexHtml =
7271 \</head>\n\
7372 \<body>\n\
7473 \</body>\n\
75− \</html>\0"
74+ \</html>"