git.iko.soy/jsaddle
on master help sign in
make safer
56d7473Dan Haraj
jsaddle-clib/src-ghc/Language/Javascript/JSaddle/CLib.hs+16−17
compare with master
unifiedsplit
@@ -9,11 +9,11 @@ import Control.Concurrent (forkIO)
9
9
10import Data.Monoid ((<>))
10import Data.Monoid ((<>))
11import Data.ByteString (useAsCString, packCString)
11import Data.ByteString (useAsCString, packCString)
12−import Data.ByteString.Unsafe (unsafeUseAsCString)
13import Data.ByteString.Lazy (ByteString, toStrict, fromStrict)
12import Data.ByteString.Lazy (ByteString, toStrict, fromStrict)
13+import Data.ByteString.Char8 (unpack)
14import Data.Aeson (encode, decode)
14import Data.Aeson (encode, decode)
15
15
16−import Foreign.C.String (CString)
16+import Foreign.C.String (CString, newCString)
17import Foreign.Ptr (FunPtr, Ptr)
17import Foreign.Ptr (FunPtr, Ptr)
18import Foreign.Marshal.Utils (new)
18import Foreign.Marshal.Utils (new)
19
19
@@ -23,13 +23,13 @@ import Language.Javascript.JSaddle.Run.Files (initState, runBatch, ghcjsHelpers)
23
23
24import Language.Javascript.JSaddle.CLib.Internal
24import Language.Javascript.JSaddle.CLib.Internal
25
25
26−foreign import ccall "dynamic"
26+foreign import ccall safe "dynamic"
27 mkCallback :: FunPtr (CString -> IO ()) -> CString -> IO ()
27 mkCallback :: FunPtr (CString -> IO ()) -> CString -> IO ()
28
28
29−foreign import ccall "wrapper"
29+foreign import ccall safe "wrapper"
30 wrapStartCallback :: IO () -> IO (FunPtr (IO ()))
30 wrapStartCallback :: IO () -> IO (FunPtr (IO ()))
31
31
32−foreign import ccall "wrapper"
32+foreign import ccall safe "wrapper"
33 wrapMessageCallback :: (CString -> IO ()) -> IO (FunPtr (CString -> IO ()))
33 wrapMessageCallback :: (CString -> IO ()) -> IO (FunPtr (CString -> IO ()))
34
34
35jsaddleInit :: JSM () -> FunPtr (CString -> IO ()) -> IO (Ptr NativeCallbacks)
35jsaddleInit :: JSM () -> FunPtr (CString -> IO ()) -> IO (Ptr NativeCallbacks)
@@ -38,20 +38,20 @@ jsaddleInit jsm evaluateJavascriptAsyncPtr = do
38 (processResult, start) <- runJavaScript (\batch ->
38 (processResult, start) <- runJavaScript (\batch ->
39 useAsCString (toStrict $ "runJSaddleBatch(" <> encode batch <> ");") $
39 useAsCString (toStrict $ "runJSaddleBatch(" <> encode batch <> ");") $
40 evaluateJavascriptAsync) jsm
40 evaluateJavascriptAsync) jsm
41− jsaddleStartPtr <- wrapStartCallback $ void $ forkIO start
41+ jsaddleStartPtr <- wrapStartCallback $ void $ forkIO $ start
42 jsaddleResultPtr <- wrapMessageCallback $ \s -> do
42 jsaddleResultPtr <- wrapMessageCallback $ \s -> do
43 result <- decode . fromStrict <$> packCString s
43 result <- decode . fromStrict <$> packCString s
44 case result of
44 case result of
45 Nothing -> error $ "jsaddle message decode failed: " <> show result
45 Nothing -> error $ "jsaddle message decode failed: " <> show result
46 Just r -> processResult r
46 Just r -> processResult r
47− unsafeUseAsCString (toStrict jsaddleJs) $ \jsaddleJsData ->
47+ jsaddleJsPtr <- newCString $ unpack $ toStrict jsaddleJs
48− unsafeUseAsCString (toStrict indexHtml) $ \jsaddleHtmlData -> new $
48+ jsaddleHtmlPtr <- newCString $ unpack $ toStrict indexHtml
49− NativeCallbacks
49+ new $ NativeCallbacks
50− { _nativeCallbacks_jsaddleStart = jsaddleStartPtr
50+ { _nativeCallbacks_jsaddleStart = jsaddleStartPtr
51− , _nativeCallbacks_jsaddleResult = jsaddleResultPtr
51+ , _nativeCallbacks_jsaddleResult = jsaddleResultPtr
52− , _nativeCallbacks_jsaddleJsData = jsaddleJsData
52+ , _nativeCallbacks_jsaddleJsData = jsaddleJsPtr
53− , _nativeCallbacks_jsaddleHtmlData = jsaddleHtmlData
53+ , _nativeCallbacks_jsaddleHtmlData = jsaddleHtmlPtr
54− }
54+ }
55
55
56jsaddleJs :: ByteString
56jsaddleJs :: ByteString
57jsaddleJs = ghcjsHelpers <> "\
57jsaddleJs = ghcjsHelpers <> "\
@@ -60,8 +60,7 @@ jsaddleJs = ghcjsHelpers <> "\
60 \ return function(batch) {\n\
60 \ return function(batch) {\n\
61 \ " <> runBatch (\a -> "jsaddle.postMessage(JSON.stringify(" <> a <> "));") <> "\
61 \ " <> runBatch (\a -> "jsaddle.postMessage(JSON.stringify(" <> a <> "));") <> "\
62 \ };\n\
62 \ };\n\
63− \})();\n\
63+ \})();\n"
64− \\0"
65
64
66indexHtml :: ByteString
65indexHtml :: ByteString
67indexHtml =
66indexHtml =
@@ -72,4 +71,4 @@ indexHtml =
72 \</head>\n\
71 \</head>\n\
73 \<body>\n\
72 \<body>\n\
74 \</body>\n\
73 \</body>\n\
75− \</html>\0"
74+ \</html>"