git.iko.soy/jsaddle
on master help sign in
provisional jsaddle c library binding
7cbadecDan Haraj
default.nix+1
compare with master
unifiedsplit
@@ -4,4 +4,5 @@ haskellPackages: {
4 jsaddle-wkwebview = haskellPackages.callPackage ./jsaddle-wkwebview {};
4 jsaddle-wkwebview = haskellPackages.callPackage ./jsaddle-wkwebview {};
5 jsaddle-webkit2gtk = haskellPackages.callPackage ./jsaddle-webkit2gtk {};
5 jsaddle-webkit2gtk = haskellPackages.callPackage ./jsaddle-webkit2gtk {};
6 jsaddle-webkitgtk = haskellPackages.callPackage ./jsaddle-webkitgtk {};
6 jsaddle-webkitgtk = haskellPackages.callPackage ./jsaddle-webkitgtk {};
7+ jsaddle-clib = haskellPackages.callPackage ./jsaddle-clib {};
7}
8}
jsaddle-clib/LICENSEnew file+21
@@ -0,0 +1,21 @@
1+Copyright (c) 2010-2012 Hamish Mackenzie, Victor Nazarov, Luite Stegeman
2+
3+Permission is hereby granted, free of charge, to any person obtaining
4+a copy of this software and associated documentation files (the
5+"Software"), to deal in the Software without restriction, including
6+without limitation the rights to use, copy, modify, merge, publish,
7+distribute, sublicense, and/or sell copies of the Software, and to
8+permit persons to whom the Software is furnished to do so, subject to
9+the following conditions:
10+
11+The above copyright notice and this permission notice shall be
12+included in all copies or substantial portions of the Software.
13+
14+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
15+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
16+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
17+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
18+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
19+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
20+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
21+
jsaddle-clib/Setup.lhsnew file+6
@@ -0,0 +1,6 @@
1+#!/usr/bin/runhaskell
2+> module Main where
3+> import Distribution.Simple
4+> main :: IO ()
5+> main = defaultMain
6+
jsaddle-clib/cbits/include/jsaddle.hnew file+11
@@ -0,0 +1,11 @@
1+#ifndef JSADDLE_H
2+#define JSADDLE_H
3+
4+typedef struct native_callbacks {
5+ void (* jsaddleStart) ();
6+ void (* jsaddleResult) (char *);
7+ char * jsaddleJsData;
8+ char * jsaddleHtmlData;
9+} native_callbacks;
10+
11+#endif
jsaddle-clib/default.nixnew file+9
@@ -0,0 +1,9 @@
1+{ mkDerivation, aeson, base, bytestring, jsaddle, stdenv }:
2+mkDerivation {
3+ pname = "jsaddle-clib";
4+ version = "0.8.2.0";
5+ src = ./.;
6+ libraryHaskellDepends = [ aeson base bytestring jsaddle ];
7+ description = "Interface for JavaScript that works with GHCJS and GHC";
8+ license = stdenv.lib.licenses.mit;
9+}
jsaddle-clib/jsaddle-clib.cabalnew file+37
@@ -0,0 +1,37 @@
1+name: jsaddle-clib
2+version: 0.8.2.0
3+cabal-version: >=1.10
4+build-type: Simple
5+license: MIT
6+license-file: LICENSE
7+maintainer: Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>
8+synopsis: Interface for JavaScript that works with GHCJS and GHC
9+description:
10+ This package provides an EDSL for calling JavaScript that
11+ can be used both from GHCJS and GHC.
12+category: Web, Javascript
13+author: Hamish Mackenzie
14+
15+source-repository head
16+ type: git
17+ location: https://github.com/ghcjs/jsaddle
18+
19+library
20+ exposed-modules:
21+ Language.Javascript.JSaddle.CLib
22+ Language.Javascript.JSaddle.CLib.Internal
23+ build-depends:
24+ aeson >=0.8.0.2 && <1.2,
25+ base <5,
26+ bytestring >=0.10.6.0 && <0.11,
27+ jsaddle >= 0.8.0.0 && <0.9
28+ default-language: Haskell2010
29+ hs-source-dirs: src
30+ Include-dirs: cbits/include
31+ Includes: jsaddle.h
32+ Install-includes: jsaddle.h
33+ ghc-options: -ferror-spans -Wall -Werror
34+ if impl(ghcjs)
35+ hs-source-dirs: src-ghcjs
36+ else
37+ hs-source-dirs: src-ghc
jsaddle-clib/src-ghc/Language/Javascript/JSaddle/CLib.hsnew file+75
@@ -0,0 +1,75 @@
1+{-# LANGUAGE ForeignFunctionInterface, OverloadedStrings #-}
2+module Language.Javascript.JSaddle.CLib
3+ ( jsaddleInit
4+ , NativeCallbacks (..)
5+ ) where
6+
7+import Control.Monad (void)
8+import Control.Concurrent (forkIO)
9+
10+import Data.Monoid ((<>))
11+import Data.ByteString (useAsCString, packCString)
12+import Data.ByteString.Unsafe (unsafeUseAsCString)
13+import Data.ByteString.Lazy (ByteString, toStrict, fromStrict)
14+import Data.Aeson (encode, decode)
15+
16+import Foreign.C.String (CString)
17+import Foreign.Ptr (FunPtr, Ptr)
18+import Foreign.Marshal.Utils (new)
19+
20+import Language.Javascript.JSaddle (JSM)
21+import Language.Javascript.JSaddle.Run (runJavaScript)
22+import Language.Javascript.JSaddle.Run.Files (initState, runBatch, ghcjsHelpers)
23+
24+import Language.Javascript.JSaddle.CLib.Internal
25+
26+foreign import ccall "dynamic"
27+ mkCallback :: FunPtr (CString -> IO ()) -> CString -> IO ()
28+
29+foreign import ccall "wrapper"
30+ wrapStartCallback :: IO () -> IO (FunPtr (IO ()))
31+
32+foreign import ccall "wrapper"
33+ wrapMessageCallback :: (CString -> IO ()) -> IO (FunPtr (CString -> IO ()))
34+
35+jsaddleInit :: JSM () -> FunPtr (CString -> IO ()) -> IO (Ptr NativeCallbacks)
36+jsaddleInit jsm evaluateJavascriptAsyncPtr = do
37+ let evaluateJavascriptAsync = mkCallback evaluateJavascriptAsyncPtr
38+ (processResult, start) <- runJavaScript (\batch ->
39+ useAsCString (toStrict $ "runJSaddleBatch(" <> encode batch <> ");") $
40+ evaluateJavascriptAsync) jsm
41+ jsaddleStartPtr <- wrapStartCallback $ void $ forkIO start
42+ jsaddleResultPtr <- wrapMessageCallback $ \s -> do
43+ result <- decode . fromStrict <$> packCString s
44+ case result of
45+ Nothing -> error $ "jsaddle message decode failed: " <> show result
46+ 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+ }
55+
56+jsaddleJs :: ByteString
57+jsaddleJs = ghcjsHelpers <> "\
58+ \runJSaddleBatch = (function() {\n\
59+ \ " <> initState <> "\n\
60+ \ return function(batch) {\n\
61+ \ " <> runBatch (\a -> "jsaddle.postMessage(JSON.stringify(" <> a <> "));") <> "\
62+ \ };\n\
63+ \})();\n\
64+ \\0"
65+
66+indexHtml :: ByteString
67+indexHtml =
68+ "<!DOCTYPE html>\n\
69+ \<html>\n\
70+ \<head>\n\
71+ \<title>JSaddle</title>\n\
72+ \</head>\n\
73+ \<body>\n\
74+ \</body>\n\
75+ \</html>\0"
jsaddle-clib/src-ghcjs/Language/Javascript/JSaddle/CLib.hsnew file+7
@@ -0,0 +1,7 @@
1+module Language.Javascript.JSaddle.CLib
2+ ( run
3+ ) where
4+
5+run :: IO () -> IO ()
6+run = id
7+{-# INLINE run #-}
jsaddle-clib/src/Language/Javascript/JSaddle/CLib/Internal.hscnew file+28
@@ -0,0 +1,28 @@
1+{-# LANGUAGE ForeignFunctionInterface #-}
2+module Language.Javascript.JSaddle.CLib.Internal where
3+
4+import Foreign
5+import Foreign.C
6+
7+#include "jsaddle.h"
8+
9+data NativeCallbacks = NativeCallbacks
10+ { _nativeCallbacks_jsaddleStart :: !(FunPtr (IO ())) -- void (jsaddleStart *)()
11+ , _nativeCallbacks_jsaddleResult :: !(FunPtr (CString -> IO ())) -- void (jsaddleResult *)(char *)
12+ , _nativeCallbacks_jsaddleJsData :: !CString -- char * jsaddleJsData
13+ , _nativeCallbacks_jsaddleHtmlData :: !CString -- char * jsaddleHtmlData
14+ }
15+
16+instance Storable NativeCallbacks where
17+ sizeOf _ = #{size native_callbacks}
18+ alignment _ = #{alignment native_callbacks}
19+ poke p nc = do
20+ #{poke native_callbacks, jsaddleStart} p $ _nativeCallbacks_jsaddleStart nc
21+ #{poke native_callbacks, jsaddleResult} p $ _nativeCallbacks_jsaddleResult nc
22+ #{poke native_callbacks, jsaddleJsData} p $ _nativeCallbacks_jsaddleJsData nc
23+ #{poke native_callbacks, jsaddleHtmlData} p $ _nativeCallbacks_jsaddleHtmlData nc
24+ peek p = NativeCallbacks
25+ <$> #{peek native_callbacks, jsaddleStart} p
26+ <*> #{peek native_callbacks, jsaddleResult} p
27+ <*> #{peek native_callbacks, jsaddleJsData} p
28+ <*> #{peek native_callbacks, jsaddleHtmlData} p