623c4e2 · jsaddle · git.iko.soy

git.iko.soy/jsaddle

on master help sign in

Sync callback support in jsaddle-clib

623c4e2Hamish Mackenzie9 years ago

jsaddle-clib/cbits/include/jsaddle.h+1

compare with master

unifiedsplit

@@ -4,6 +4,7 @@

4typedef struct native_callbacks {

5 void (* jsaddleStart) ();

6 void (* jsaddleResult) (char *);

7+ char * (* jsaddleSyncResult) (char *);

7 char * jsaddleJsData;

8 char * jsaddleJsData;

8 char * jsaddleHtmlData;

9 char * jsaddleHtmlData;

9} native_callbacks;

10} native_callbacks;

jsaddle-clib/jsaddle-clib.cabal+1−1

@@ -24,7 +24,7 @@ library

24 aeson >=0.8.0.2 && <1.3,

25 base <5,

26 bytestring >=0.10.6.0 && <0.11,

27− jsaddle >= 0.9.0.0 && <0.10

27+ jsaddle >= 0.9.0.0 && <0.10,

28 data-default,

29 text

30 default-language: Haskell2010

jsaddle-clib/src-ghc/Language/Javascript/JSaddle/CLib.hs+15−5

@@ -40,23 +40,32 @@ foreign import ccall safe "wrapper"

40foreign import ccall safe "wrapper"

41 wrapMessageCallback :: (CString -> IO ()) -> IO (FunPtr (CString -> IO ()))

43+foreign import ccall safe "wrapper"

44+ wrapSyncCallback :: (CString -> IO CString) -> IO (FunPtr (CString -> IO CString))

45+

43jsaddleInit :: JSM () -> FunPtr (CString -> IO ()) -> IO (Ptr NativeCallbacks)

46jsaddleInit :: JSM () -> FunPtr (CString -> IO ()) -> IO (Ptr NativeCallbacks)

44jsaddleInit jsm evaluateJavascriptAsyncPtr = do

47jsaddleInit jsm evaluateJavascriptAsyncPtr = do

45 let evaluateJavascriptAsync = mkCallback evaluateJavascriptAsyncPtr

48 let evaluateJavascriptAsync = mkCallback evaluateJavascriptAsyncPtr

46− (processResult, _, start) <- runJavaScript (\batch ->

49+ (processResult, processSyncResult, start) <- runJavaScript (\batch ->

47− useAsCString (toStrict $ "runJSaddleBatch(" <> encode batch <> ");") $

50+ useAsCString (toStrict $ "runJSaddleBatch(" <> encode batch <> ");")

48 evaluateJavascriptAsync) jsm

51 evaluateJavascriptAsync) jsm

49− jsaddleStartPtr <- wrapStartCallback $ void $ forkIO $ start

52+ jsaddleStartPtr <- wrapStartCallback $ void $ forkIO start

50 jsaddleResultPtr <- wrapMessageCallback $ \s -> do

53 jsaddleResultPtr <- wrapMessageCallback $ \s -> do

51 result <- decode . fromStrict <$> packCString s

54 result <- decode . fromStrict <$> packCString s

52 case result of

55 case result of

53 Nothing -> error $ "jsaddle message decode failed: " <> show result

56 Nothing -> error $ "jsaddle message decode failed: " <> show result

54 Just r -> processResult r

57 Just r -> processResult r

58+ jsaddleSyncResultPtr <- wrapSyncCallback $ \s -> do

59+ result <- decode . fromStrict <$> packCString s

60+ case result of

61+ Nothing -> error $ "jsaddle message decode failed: " <> show result

62+ Just r -> newCString =<< unpack . toStrict . encode <$> processSyncResult r

55 jsaddleJsPtr <- newCString $ unpack $ toStrict jsaddleJs

63 jsaddleJsPtr <- newCString $ unpack $ toStrict jsaddleJs

56 jsaddleHtmlPtr <- newCString $ unpack $ toStrict indexHtml

64 jsaddleHtmlPtr <- newCString $ unpack $ toStrict indexHtml

57− new $ NativeCallbacks

65+ new NativeCallbacks

58 { _nativeCallbacks_jsaddleStart = jsaddleStartPtr

66 { _nativeCallbacks_jsaddleStart = jsaddleStartPtr

59 , _nativeCallbacks_jsaddleResult = jsaddleResultPtr

67 , _nativeCallbacks_jsaddleResult = jsaddleResultPtr

68+ , _nativeCallbacks_jsaddleSyncResult = jsaddleSyncResultPtr

60 , _nativeCallbacks_jsaddleJsData = jsaddleJsPtr

69 , _nativeCallbacks_jsaddleJsData = jsaddleJsPtr

61 , _nativeCallbacks_jsaddleHtmlData = jsaddleHtmlPtr

70 , _nativeCallbacks_jsaddleHtmlData = jsaddleHtmlPtr

62 }

71 }

@@ -115,7 +124,8 @@ jsaddleJs = ghcjsHelpers <> "\

115 \runJSaddleBatch = (function() {\n\

124 \runJSaddleBatch = (function() {\n\

116 \ " <> initState <> "\n\

125 \ " <> initState <> "\n\

117 \ return function(batch) {\n\

126 \ return function(batch) {\n\

118− \ " <> runBatch (\a -> "jsaddle.postMessage(JSON.stringify(" <> a <> "));") Nothing <> "\

127+ \ " <> runBatch (\a -> "jsaddle.postMessage(JSON.stringify(" <> a <> "));")

128+ (Just (\a -> "JSON.parse(jsaddle.syncMessage(JSON.stringify(" <> a <> ")))")) <> "\

119 \ };\n\

129 \ };\n\

120 \})();\n\

130 \})();\n\

121 \jsaddle.postReady();\n"

131 \jsaddle.postReady();\n"

jsaddle-clib/src/Language/Javascript/JSaddle/CLib/Internal.hsc+3

@@ -9,6 +9,7 @@ import Foreign.C

9data NativeCallbacks = NativeCallbacks

10 { _nativeCallbacks_jsaddleStart :: !(FunPtr (IO ())) -- void (jsaddleStart *)()

11 , _nativeCallbacks_jsaddleResult :: !(FunPtr (CString -> IO ())) -- void (jsaddleResult *)(char *)

12+ , _nativeCallbacks_jsaddleSyncResult :: !(FunPtr (CString -> IO CString)) -- char * (jsaddleSyncResult *)(char *)

12 , _nativeCallbacks_jsaddleJsData :: !CString -- char * jsaddleJsData

13 , _nativeCallbacks_jsaddleJsData :: !CString -- char * jsaddleJsData

13 , _nativeCallbacks_jsaddleHtmlData :: !CString -- char * jsaddleHtmlData

14 , _nativeCallbacks_jsaddleHtmlData :: !CString -- char * jsaddleHtmlData

14 }

15 }

@@ -19,11 +20,13 @@ instance Storable NativeCallbacks where

19 poke p nc = do

20 poke p nc = do

20 #{poke native_callbacks, jsaddleStart} p $ _nativeCallbacks_jsaddleStart nc

21 #{poke native_callbacks, jsaddleStart} p $ _nativeCallbacks_jsaddleStart nc

21 #{poke native_callbacks, jsaddleResult} p $ _nativeCallbacks_jsaddleResult nc

22 #{poke native_callbacks, jsaddleResult} p $ _nativeCallbacks_jsaddleResult nc

23+ #{poke native_callbacks, jsaddleSyncResult} p $ _nativeCallbacks_jsaddleSyncResult nc

22 #{poke native_callbacks, jsaddleJsData} p $ _nativeCallbacks_jsaddleJsData nc

24 #{poke native_callbacks, jsaddleJsData} p $ _nativeCallbacks_jsaddleJsData nc

23 #{poke native_callbacks, jsaddleHtmlData} p $ _nativeCallbacks_jsaddleHtmlData nc

25 #{poke native_callbacks, jsaddleHtmlData} p $ _nativeCallbacks_jsaddleHtmlData nc

24 peek p = NativeCallbacks

26 peek p = NativeCallbacks

25 <$> #{peek native_callbacks, jsaddleStart} p

27 <$> #{peek native_callbacks, jsaddleStart} p

26 <*> #{peek native_callbacks, jsaddleResult} p

28 <*> #{peek native_callbacks, jsaddleResult} p

29+ <*> #{peek native_callbacks, jsaddleSyncResult} p

27 <*> #{peek native_callbacks, jsaddleJsData} p

30 <*> #{peek native_callbacks, jsaddleJsData} p

28 <*> #{peek native_callbacks, jsaddleHtmlData} p

31 <*> #{peek native_callbacks, jsaddleHtmlData} p