packages feed

jsaddle-clib (empty) → 0.9.0.0

raw patch · 7 files changed

+319/−0 lines, 7 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, data-default, jsaddle, text

Files

+ LICENSE view
@@ -0,0 +1,21 @@+Copyright (c) 2010-2012 Hamish Mackenzie, Victor Nazarov, Luite Stegeman++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+
+ Setup.lhs view
@@ -0,0 +1,6 @@+#!/usr/bin/runhaskell +> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMain+
+ cbits/include/jsaddle.h view
@@ -0,0 +1,24 @@+#ifndef JSADDLE_H+#define JSADDLE_H++typedef struct native_callbacks {+  void (* jsaddleStart) ();+  void (* jsaddleResult) (char *);+  char * (* jsaddleSyncResult) (char *);+  char * jsaddleJsData;+  char * jsaddleHtmlData;+} native_callbacks;++typedef struct app_callbacks {+  void (* mainActivity_onCreate) ();+  void (* mainActivity_onStart) ();+  void (* mainActivity_onResume) ();+  void (* mainActivity_onPause) ();+  void (* mainActivity_onStop) ();+  void (* mainActivity_onDestroy) ();+  void (* mainActivity_onRestart) ();+  void (* mainActivity_onNewIntent) (char *, char *);+  void (* firebaseInstanceIdService_sendRegistrationToServer) (char *);+} app_callbacks;++#endif
+ jsaddle-clib.cabal view
@@ -0,0 +1,39 @@+name: jsaddle-clib+version: 0.9.0.0+cabal-version: >=1.10+build-type: Simple+license: MIT+license-file: LICENSE+maintainer: Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+synopsis: Interface for JavaScript that works with GHCJS and GHC+description:+    This package provides an EDSL for calling JavaScript that+    can be used both from GHCJS and GHC.+category: Web, Javascript+author: Hamish Mackenzie++source-repository head+    type: git+    location: https://github.com/ghcjs/jsaddle++library+    exposed-modules:+        Language.Javascript.JSaddle.CLib+        Language.Javascript.JSaddle.CLib.Internal+    build-depends:+        aeson >=0.8.0.2 && <1.3,+        base <5,+        bytestring >=0.10.6.0 && <0.11,+        jsaddle >= 0.9.0.0 && <0.10,+        data-default,+        text+    default-language: Haskell2010+    hs-source-dirs: src+    Include-dirs: cbits/include+    Includes: jsaddle.h+    Install-includes: jsaddle.h+    ghc-options: -ferror-spans -Wall+    if impl(ghcjs)+        hs-source-dirs: src-ghcjs+    else+        hs-source-dirs: src-ghc
+ src-ghc/Language/Javascript/JSaddle/CLib.hs view
@@ -0,0 +1,155 @@+{-# LANGUAGE ForeignFunctionInterface, OverloadedStrings #-}+module Language.Javascript.JSaddle.CLib+  ( jsaddleInit+  , NativeCallbacks (..)+  , AppCallbacks (..)+  , AppConfig (..)+  , pokeAppConfig+  , appConfigToAppCallbacks+  ) where++import Control.Monad (void)+import Control.Concurrent (forkIO)++import Data.Aeson (encode, decode)+import Data.ByteString (useAsCString, packCString)+import Data.ByteString.Char8 (unpack)+import Data.ByteString.Lazy (ByteString, toStrict, fromStrict)+import Data.Default (def, Default)+import Data.Monoid ((<>))+import Data.Text (Text)+import qualified Data.Text.Encoding as T++import Foreign.C.String (CString, newCString)+import Foreign.Ptr (FunPtr, Ptr)+import Foreign.Storable (poke)+import Foreign.Marshal.Utils (new)++import Language.Javascript.JSaddle (JSM)+import Language.Javascript.JSaddle.Run (runJavaScript)+import Language.Javascript.JSaddle.Run.Files (initState, runBatch, ghcjsHelpers)++import Language.Javascript.JSaddle.CLib.Internal++foreign import ccall safe "dynamic"+  mkCallback :: FunPtr (CString -> IO ()) -> CString -> IO ()++foreign import ccall safe "wrapper"+  wrapStartCallback :: IO () -> IO (FunPtr (IO ()))++foreign import ccall safe "wrapper"+  wrapMessageCallback :: (CString -> IO ()) -> IO (FunPtr (CString -> IO ()))++foreign import ccall safe "wrapper"+  wrapMessageCallback2 :: (CString -> CString -> IO ()) -> IO (FunPtr (CString -> CString -> IO ()))++foreign import ccall safe "wrapper"+  wrapSyncCallback :: (CString -> IO CString) -> IO (FunPtr (CString -> IO CString))++jsaddleInit :: JSM () -> FunPtr (CString -> IO ()) -> IO (Ptr NativeCallbacks)+jsaddleInit jsm evaluateJavascriptAsyncPtr = do+  let evaluateJavascriptAsync = mkCallback evaluateJavascriptAsyncPtr+  (processResult, processSyncResult, start) <- runJavaScript (\batch ->+    useAsCString (toStrict $ "runJSaddleBatch(" <> encode batch <> ");")+      evaluateJavascriptAsync) jsm+  jsaddleStartPtr <- wrapStartCallback $ void $ forkIO start+  jsaddleResultPtr <- wrapMessageCallback $ \s -> do+    result <- decode . fromStrict <$> packCString s+    case result of+      Nothing -> error $ "jsaddle message decode failed: " <> show result+      Just r -> processResult r+  jsaddleSyncResultPtr <- wrapSyncCallback $ \s -> do+    result <- decode . fromStrict <$> packCString s+    case result of+      Nothing -> error $ "jsaddle message decode failed: " <> show result+      Just r -> newCString =<< unpack . toStrict . encode <$> processSyncResult r+  jsaddleJsPtr <- newCString $ unpack $ toStrict jsaddleJs+  jsaddleHtmlPtr <- newCString $ unpack $ toStrict indexHtml+  new NativeCallbacks+    { _nativeCallbacks_jsaddleStart = jsaddleStartPtr+    , _nativeCallbacks_jsaddleResult = jsaddleResultPtr+    , _nativeCallbacks_jsaddleSyncResult = jsaddleSyncResultPtr+    , _nativeCallbacks_jsaddleJsData = jsaddleJsPtr+    , _nativeCallbacks_jsaddleHtmlData = jsaddleHtmlPtr+    }++data AppConfig = AppConfig+  { _appConfig_mainActivityOnCreate :: IO ()+  , _appConfig_mainActivityOnStart :: IO ()+  , _appConfig_mainActivityOnResume :: IO ()+  , _appConfig_mainActivityOnPause :: IO ()+  , _appConfig_mainActivityOnStop :: IO ()+  , _appConfig_mainActivityOnDestroy :: IO ()+  , _appConfig_mainActivityOnRestart :: IO ()+  , _appConfig_mainActivityOnNewIntent :: (Text -> Text -> IO ())+  , _appConfig_firebaseInstanceIdServiceSendRegistrationToServer :: Text -> IO ()+  }++instance Default AppConfig where+  def = AppConfig+    { _appConfig_mainActivityOnCreate = return ()+    , _appConfig_mainActivityOnStart = return ()+    , _appConfig_mainActivityOnResume = return ()+    , _appConfig_mainActivityOnPause = return ()+    , _appConfig_mainActivityOnStop = return ()+    , _appConfig_mainActivityOnDestroy = return ()+    , _appConfig_mainActivityOnRestart = return ()+    , _appConfig_mainActivityOnNewIntent = \_ _ -> return ()+    , _appConfig_firebaseInstanceIdServiceSendRegistrationToServer = \_ -> return ()+    }++appConfigToAppCallbacks :: AppConfig -> IO AppCallbacks+appConfigToAppCallbacks c = do+  create <- wrapStartCallback $ _appConfig_mainActivityOnCreate c+  start <- wrapStartCallback $ _appConfig_mainActivityOnStart c+  resume <- wrapStartCallback $ _appConfig_mainActivityOnResume c+  pause <- wrapStartCallback $ _appConfig_mainActivityOnPause c+  stop <- wrapStartCallback $ _appConfig_mainActivityOnStop c+  destroy <- wrapStartCallback $ _appConfig_mainActivityOnDestroy c+  restart <- wrapStartCallback $ _appConfig_mainActivityOnRestart c+  newIntent <- wrapMessageCallback2 $ \intentAction intentData -> do+    intentAction' <- fromUtf8CString intentAction+    intentData' <- fromUtf8CString intentData+    _appConfig_mainActivityOnNewIntent c intentAction' intentData'+  firebaseRegPtr <- wrapMessageCallback $ \token -> do+    token' <- fromUtf8CString token+    _appConfig_firebaseInstanceIdServiceSendRegistrationToServer c token'+  return $ AppCallbacks+    { _appCallbacks_mainActivity_onCreate = create+    , _appCallbacks_mainActivity_onStart = start+    , _appCallbacks_mainActivity_onResume = resume+    , _appCallbacks_mainActivity_onPause = pause+    , _appCallbacks_mainActivity_onStop = stop+    , _appCallbacks_mainActivity_onDestroy = destroy+    , _appCallbacks_mainActivity_onRestart = restart+    , _appCallbacks_mainActivity_onNewIntent = newIntent+    , _appCallbacks_firebaseInstanceIdService_sendRegistrationToServer = firebaseRegPtr+    }++fromUtf8CString :: CString -> IO Text+fromUtf8CString = fmap T.decodeUtf8 . packCString++pokeAppConfig :: Ptr AppCallbacks -> AppConfig -> IO ()+pokeAppConfig ptr cfg = poke ptr =<< appConfigToAppCallbacks cfg++jsaddleJs :: ByteString+jsaddleJs = ghcjsHelpers <> "\+    \runJSaddleBatch = (function() {\n\+    \ " <> initState <> "\n\+    \ return function(batch) {\n\+    \ " <> runBatch (\a -> "jsaddle.postMessage(JSON.stringify(" <> a <> "));")+              (Just (\a -> "JSON.parse(jsaddle.syncMessage(JSON.stringify(" <> a <> ")))")) <> "\+    \ };\n\+    \})();\n\+    \jsaddle.postReady();\n"++indexHtml :: ByteString+indexHtml =+    "<!DOCTYPE html>\n\+    \<html>\n\+    \<head>\n\+    \<title>JSaddle</title>\n\+    \</head>\n\+    \<body>\n\+    \</body>\n\+    \</html>"
+ src-ghcjs/Language/Javascript/JSaddle/CLib.hs view
@@ -0,0 +1,7 @@+module Language.Javascript.JSaddle.CLib+    ( run+    ) where++run :: IO () -> IO ()+run = id+{-# INLINE run #-}
+ src/Language/Javascript/JSaddle/CLib/Internal.hsc view
@@ -0,0 +1,67 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Language.Javascript.JSaddle.CLib.Internal where++import Foreign+import Foreign.C++#include "jsaddle.h"++data NativeCallbacks = NativeCallbacks+  { _nativeCallbacks_jsaddleStart :: !(FunPtr (IO ())) -- void (jsaddleStart *)()+  , _nativeCallbacks_jsaddleResult :: !(FunPtr (CString -> IO ())) -- void (jsaddleResult *)(char *)+  , _nativeCallbacks_jsaddleSyncResult :: !(FunPtr (CString -> IO CString)) -- char * (jsaddleSyncResult *)(char *)+  , _nativeCallbacks_jsaddleJsData :: !CString -- char * jsaddleJsData+  , _nativeCallbacks_jsaddleHtmlData :: !CString -- char * jsaddleHtmlData+  }++instance Storable NativeCallbacks where+  sizeOf _ = #{size native_callbacks}+  alignment _ = #{alignment native_callbacks}+  poke p nc = do+    #{poke native_callbacks, jsaddleStart} p $ _nativeCallbacks_jsaddleStart nc+    #{poke native_callbacks, jsaddleResult} p $ _nativeCallbacks_jsaddleResult nc+    #{poke native_callbacks, jsaddleSyncResult} p $ _nativeCallbacks_jsaddleSyncResult nc+    #{poke native_callbacks, jsaddleJsData} p $ _nativeCallbacks_jsaddleJsData nc+    #{poke native_callbacks, jsaddleHtmlData} p $ _nativeCallbacks_jsaddleHtmlData nc+  peek p = NativeCallbacks+    <$> #{peek native_callbacks, jsaddleStart} p+    <*> #{peek native_callbacks, jsaddleResult} p+    <*> #{peek native_callbacks, jsaddleSyncResult} p+    <*> #{peek native_callbacks, jsaddleJsData} p+    <*> #{peek native_callbacks, jsaddleHtmlData} p++data AppCallbacks = AppCallbacks+  { _appCallbacks_mainActivity_onCreate :: !(FunPtr (IO ()))+  , _appCallbacks_mainActivity_onStart :: !(FunPtr (IO ()))+  , _appCallbacks_mainActivity_onResume :: !(FunPtr (IO ()))+  , _appCallbacks_mainActivity_onPause :: !(FunPtr (IO ()))+  , _appCallbacks_mainActivity_onStop :: !(FunPtr (IO ()))+  , _appCallbacks_mainActivity_onDestroy :: !(FunPtr (IO ()))+  , _appCallbacks_mainActivity_onRestart :: !(FunPtr (IO ()))+  , _appCallbacks_mainActivity_onNewIntent :: !(FunPtr (CString -> CString -> IO ()))+  , _appCallbacks_firebaseInstanceIdService_sendRegistrationToServer :: !(FunPtr (CString -> IO ()))+  }++instance Storable AppCallbacks where+  sizeOf _ = #{size app_callbacks}+  alignment _ = #{alignment app_callbacks}+  poke p nc = do+    #{poke app_callbacks, mainActivity_onCreate} p $ _appCallbacks_mainActivity_onCreate nc+    #{poke app_callbacks, mainActivity_onStart} p $ _appCallbacks_mainActivity_onStart nc+    #{poke app_callbacks, mainActivity_onResume} p $ _appCallbacks_mainActivity_onResume nc+    #{poke app_callbacks, mainActivity_onPause} p $ _appCallbacks_mainActivity_onPause nc+    #{poke app_callbacks, mainActivity_onStop} p $ _appCallbacks_mainActivity_onStop nc+    #{poke app_callbacks, mainActivity_onDestroy} p $ _appCallbacks_mainActivity_onDestroy nc+    #{poke app_callbacks, mainActivity_onRestart} p $ _appCallbacks_mainActivity_onRestart nc+    #{poke app_callbacks, mainActivity_onNewIntent} p $ _appCallbacks_mainActivity_onNewIntent nc+    #{poke app_callbacks, firebaseInstanceIdService_sendRegistrationToServer} p $ _appCallbacks_firebaseInstanceIdService_sendRegistrationToServer nc+  peek p = AppCallbacks+    <$> #{peek app_callbacks, mainActivity_onCreate} p+    <*> #{peek app_callbacks, mainActivity_onStart} p+    <*> #{peek app_callbacks, mainActivity_onResume} p+    <*> #{peek app_callbacks, mainActivity_onPause} p+    <*> #{peek app_callbacks, mainActivity_onStop} p+    <*> #{peek app_callbacks, mainActivity_onDestroy} p+    <*> #{peek app_callbacks, mainActivity_onRestart} p+    <*> #{peek app_callbacks, mainActivity_onNewIntent} p+    <*> #{peek app_callbacks, firebaseInstanceIdService_sendRegistrationToServer} p