git.iko.soy/jsaddle
on master help sign in
Split jsaddle-warp out and add jsaddle-wkwebview
b8db013Hamish Mackenzie
jsaddle/README.md → README.mdrenamed
compare with master
unifiedsplit

The content is the same.

cabal.project+2
@@ -2,6 +2,8 @@ flags: -overloaded-methods -overloaded-signals -overloaded-properties
2
2
3packages:
3packages:
4 jsaddle/
4 jsaddle/
5+ jsaddle-warp/
6+ jsaddle-wkwebview/
5
7
6package gi-atk
8package gi-atk
7 flags: -overloaded-methods -overloaded-signals -overloaded-properties
9 flags: -overloaded-methods -overloaded-signals -overloaded-properties
jsaddle-warp/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-warp/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-warp/jsaddle-warp.cabalnew file+67
@@ -0,0 +1,67 @@
1+name: jsaddle-warp
2+version: 0.6.0.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. When using GHC
12+ the application is run using Warp and WebSockets to
13+ drive a small JavaScipt helper.
14+category: Web, Javascript
15+author: Hamish Mackenzie
16+
17+source-repository head
18+ type: git
19+ location: https://github.com/ghcjs/jsaddle
20+
21+library
22+
23+ if !impl(ghcjs -any)
24+ exposed-modules:
25+ Language.Javascript.JSaddle.WebSockets
26+ build-depends:
27+ aeson >=0.8.0.2 && <1.1,
28+ containers >=0.5.6.2 && <0.6,
29+ http-types >=0.8.6 && <0.10,
30+ jsaddle >=0.6.0.0 && <0.7,
31+ stm >=2.4.4 && <2.5,
32+ text >=1.2.1.3 && <1.3,
33+ time >=1.5.0.1 && <1.7,
34+ transformers >=0.4.2.0 && <0.6,
35+ wai >=3.0.3.0 && <3.3,
36+ wai-websockets >=3.0.0.6 && <3.1,
37+ warp >=3.1.2 && <3.3,
38+ websockets >=0.9.5.0 && <0.10
39+ exposed-modules:
40+ Language.Javascript.JSaddle.Warp
41+ build-depends:
42+ base <5
43+ default-language: Haskell2010
44+ hs-source-dirs: src
45+ ghc-options: -ferror-spans -Wall
46+
47+test-suite test-tool
48+
49+ if !impl(ghcjs -any)
50+ build-depends:
51+ QuickCheck -any,
52+ bytestring -any,
53+ doctest >=0.10.1 && <0.12,
54+ filepath >=1.4.0.0 && <1.5,
55+ jsaddle -any,
56+ jsaddle-warp -any,
57+ lens -any,
58+ ref-tf -any,
59+ primitive -any,
60+ process >=1.2.3.0 && <1.5
61+ type: exitcode-stdio-1.0
62+ main-is: DocTest.hs
63+ build-depends:
64+ base -any
65+ default-language: Haskell2010
66+ hs-source-dirs: tests
67+ ghc-options: -ferror-spans -threaded
jsaddle/src/Language/Javascript/JSaddle/Test.hs → jsaddle-warp/src/Language/Javascript/JSaddle/Test.hsrenamed+1−1
@@ -31,7 +31,7 @@ import Control.Concurrent.MVar
31import System.IO.Unsafe (unsafePerformIO)
31import System.IO.Unsafe (unsafePerformIO)
32import Control.Concurrent (threadDelay, forkIO, ThreadId)
32import Control.Concurrent (threadDelay, forkIO, ThreadId)
33import Data.Text (Text)
33import Data.Text (Text)
34−import Language.Javascript.JSaddle.WebSockets (run)
34+import Language.Javascript.JSaddle.Warp (run)
35
35
36context :: MVar JSContextRef
36context :: MVar JSContextRef
37context = unsafePerformIO newEmptyMVar
37context = unsafePerformIO newEmptyMVar
jsaddle-warp/src/Language/Javascript/JSaddle/Warp.hsnew file+43
@@ -0,0 +1,43 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE LambdaCase #-}
3+{-# LANGUAGE OverloadedStrings #-}
4+-----------------------------------------------------------------------------
5+--
6+-- Module : Language.Javascript.JSaddle.WebSockets
7+-- Copyright : (c) Hamish Mackenzie
8+-- License : MIT
9+--
10+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>
11+--
12+-- |
13+--
14+-----------------------------------------------------------------------------
15+
16+module Language.Javascript.JSaddle.Warp (
17+ -- * Running JSM over WebSockets
18+ run
19+#ifndef ghcjs_HOST_OS
20+ , jsaddleOr
21+#endif
22+) where
23+
24+import Language.Javascript.JSaddle.Types (JSM)
25+#ifndef ghcjs_HOST_OS
26+import Network.Wai.Handler.Warp
27+ (defaultSettings, setTimeout, setPort, runSettings)
28+import Network.WebSockets (defaultConnectionOptions)
29+
30+import Language.Javascript.JSaddle.Run (syncPoint)
31+import Language.Javascript.JSaddle.WebSockets (jsaddleOr, jsaddleApp)
32+#endif
33+
34+-- | Run the given 'JSM' action as the main entry point. Either directly
35+-- in GHCJS or as a Warp server on the given port on GHC.
36+run :: Int -> JSM () -> IO ()
37+#ifdef ghcjs_HOST_OS
38+run _port = id
39+#else
40+run port f =
41+ runSettings (setPort port (setTimeout 3600 defaultSettings)) $
42+ jsaddleOr defaultConnectionOptions (f >> syncPoint) jsaddleApp
43+#endif
jsaddle-warp/src/Language/Javascript/JSaddle/WebSockets.hsnew file+72
@@ -0,0 +1,72 @@
1+{-# LANGUAGE LambdaCase #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+-----------------------------------------------------------------------------
4+--
5+-- Module : Language.Javascript.JSaddle.WebSockets
6+-- Copyright : (c) Hamish Mackenzie
7+-- License : MIT
8+--
9+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>
10+--
11+-- |
12+--
13+-----------------------------------------------------------------------------
14+
15+module Language.Javascript.JSaddle.WebSockets (
16+ -- * Running JSM over WebSockets
17+ jsaddleOr
18+ , jsaddleApp
19+) where
20+
21+import Control.Monad (forever)
22+import Control.Concurrent (forkIO)
23+
24+import Data.Monoid ((<>))
25+import Data.Aeson (encode, decode)
26+
27+import Network.Wai (Application)
28+import Network.WebSockets
29+ (ConnectionOptions(..), sendTextData, receiveDataMessage,
30+ acceptRequest, ServerApp)
31+import qualified Network.WebSockets as WS (DataMessage(..))
32+import Network.Wai.Handler.WebSockets (websocketsOr)
33+
34+import Language.Javascript.JSaddle.Types (JSM(..))
35+import qualified Network.Wai as W
36+ (responseLBS, requestMethod, Application, pathInfo)
37+import Data.Text (Text)
38+import qualified Network.HTTP.Types as H
39+ (status403, status200, status405)
40+import Language.Javascript.JSaddle.Run (runJavaScript)
41+import Language.Javascript.JSaddle.Run.Files (indexHtml, jsaddleJs)
42+
43+jsaddleOr :: ConnectionOptions -> JSM () -> Application -> Application
44+jsaddleOr opts entryPoint = websocketsOr opts wsApp
45+ where
46+ wsApp :: ServerApp
47+ wsApp pending_conn = do
48+ conn <- acceptRequest pending_conn
49+ (processResult, start) <- runJavaScript (sendTextData conn . encode) entryPoint
50+ _ <- forkIO . forever $
51+ receiveDataMessage conn >>= \case
52+ (WS.Text t) ->
53+ case decode t of
54+ Nothing -> error $ "jsaddle WebSocket decode failed : " <> show t
55+ Just r -> processResult r
56+ _ -> error "jsaddle WebSocket unexpected binary data"
57+ start
58+
59+jsaddleApp :: Application
60+jsaddleApp req = jsaddleAppPieces (W.pathInfo req) req
61+
62+jsaddleAppPieces :: [Text] -> W.Application
63+jsaddleAppPieces _ req sendResponse
64+ | W.requestMethod req `notElem` ["GET", "HEAD"] = sendResponse $ W.responseLBS
65+ H.status405
66+ [("Content-Type", "text/plain")]
67+ "Only GET or HEAD is supported"
68+jsaddleAppPieces [] _req sendResponse = sendResponse $ W.responseLBS H.status200 [("Content-Type", "text/html")] indexHtml
69+jsaddleAppPieces ["jsaddle.js"] _req sendResponse = sendResponse $ W.responseLBS H.status200 [("Content-Type", "application/javascript")] jsaddleJs
70+jsaddleAppPieces _rawPieces _req sendResponse = sendResponse $ W.responseLBS H.status403
71+ [ ("Content-Type", "text/plain")
72+ ] "Forbidden"
jsaddle/tests/DocTest.hs → jsaddle-warp/tests/DocTest.hsrenamed+28−25
@@ -6,26 +6,27 @@ module Main (
6 main
6 main
7) where
7) where
8
8
9−#ifndef ghcjs_HOST_OS
10import Test.DocTest
9import Test.DocTest
11import System.IO (stderr, BufferMode(..), stdout, hSetBuffering)
10import System.IO (stderr, BufferMode(..), stdout, hSetBuffering)
12import System.FilePath ((</>))
11import System.FilePath ((</>))
13−import System.Exit (exitWith, ExitCode(..))
12+import System.Exit (exitFailure, exitWith, ExitCode(..))
14−import System.Process (system)
13+import System.Process (readProcess, system)
15import Control.Concurrent (forkIO)
14import Control.Concurrent (forkIO)
16import Control.Monad (void)
15import Control.Monad (void)
17import Data.Monoid ((<>))
16import Data.Monoid ((<>))
18−import Paths_jsaddle (getDataDir)
17+import System.Environment (getArgs)
19−#endif
18+import Language.Javascript.JSaddle.Run.Files (jsaddleJs)
19+import qualified Data.ByteString.Lazy.Char8 as BS (unpack)
20
20
21main :: IO ()
21main :: IO ()
22main = do
22main = do
23−#ifdef ghcjs_HOST_OS
23+ jsaddlePath <- getArgs >>= \case
24− putStrLn "TODO find a way to run doctest tests with GHCJS"
24+ [arg] -> return arg
25−#else
25+ _ -> do
26+ putStrLn "Please give the path to the jsaddle package source"
27+ exitFailure
26 hSetBuffering stdout LineBuffering
28 hSetBuffering stdout LineBuffering
27 hSetBuffering stderr LineBuffering
29 hSetBuffering stderr LineBuffering
28− dataDir <- getDataDir
29 node <- system "nodejs --version" >>= \case
30 node <- system "nodejs --version" >>= \case
30 ExitSuccess -> return "nodejs"
31 ExitSuccess -> return "nodejs"
31 _ -> return "node"
32 _ -> return "node"
@@ -34,10 +35,9 @@ main = do
34 e -> do
35 e -> do
35 putStrLn "Node.js not found"
36 putStrLn "Node.js not found"
36 exitWith e
37 exitWith e
37− forkIO . void . system $ node <> " --harmony " <> dataDir </> "data/jsaddle.js"
38+ forkIO . void $ readProcess node ["--harmony"] (BS.unpack jsaddleJs) >>= putStr
38 doctest [
39 doctest [
39 "-hide-all-packages",
40 "-hide-all-packages",
40− "-package=template-haskell-" ++ VERSION_template_haskell,
41 "-package=base-" ++ VERSION_base,
41 "-package=base-" ++ VERSION_base,
42 "-package=lens-" ++ VERSION_lens,
42 "-package=lens-" ++ VERSION_lens,
43 "-package=text-" ++ VERSION_text,
43 "-package=text-" ++ VERSION_text,
@@ -57,17 +57,20 @@ main = do
57 "-package=process-" ++ VERSION_process,
57 "-package=process-" ++ VERSION_process,
58 "-package=filepath-" ++ VERSION_filepath,
58 "-package=filepath-" ++ VERSION_filepath,
59 "-package=ref-tf-" ++ VERSION_ref_tf,
59 "-package=ref-tf-" ++ VERSION_ref_tf,
60− "-isrc",
60+ "-i" <> jsaddlePath </> "jsaddle-warp/src",
61+ jsaddlePath </> "jsaddle-warp/src/Language/Javascript/JSaddle/Test.hs",
62+ "-i" <> jsaddlePath </> "jsaddle",
63+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle.hs",
61− "src/Language/Javascript/JSaddle/Arguments.hs",
64+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Arguments.hs",
62− "src/Language/Javascript/JSaddle/Classes.hs",
65+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Classes.hs",
63− "src/Language/Javascript/JSaddle/Evaluate.hs",
66+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Evaluate.hs",
64− "src/Language/Javascript/JSaddle/Exception.hs",
67+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Exception.hs",
65− "src/Language/Javascript/JSaddle/Monad.hs",
68+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Monad.hs",
66− "src/Language/Javascript/JSaddle/Native.hs",
69+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Native.hs",
67− "src/Language/Javascript/JSaddle/Object.hs",
70+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Object.hs",
68− "src/Language/Javascript/JSaddle/Properties.hs",
71+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Properties.hs",
72+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Run.hs",
73+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Run/Files.hs",
69− "src/Language/Javascript/JSaddle/String.hs",
74+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/String.hs",
70− "src/Language/Javascript/JSaddle/Test.hs",
71− "src/Language/Javascript/JSaddle/Types.hs",
75+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Types.hs",
72− "src/Language/Javascript/JSaddle/Value.hs" ]
76+ jsaddlePath </> "jsaddle/src/Language/Javascript/JSaddle/Value.hs" ]
73−#endif
jsaddle-wkwebview/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-wkwebview/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-wkwebview/cbits/WKWebView.mnew file+55
@@ -0,0 +1,55 @@
1+#include "HsFFI.h"
2+#import <Foundation/Foundation.h>
3+#import <WebKit/WebKit.h>
4+
5+extern void jsaddleStart(HsStablePtr);
6+extern void jsaddleResult(HsStablePtr, const char * _Nonnull result);
7+
8+@interface JSaddleHandler : NSObject<WKNavigationDelegate, WKScriptMessageHandler>
9+
10+@property (nonatomic, assign) HsStablePtr startHandler;
11+@property (nonatomic, assign) HsStablePtr resultHandler;
12+
13+- (instancetype)initHandler:(HsStablePtr)startHandler resultHandler:(HsStablePtr)resultHandler;
14+
15+@end
16+
17+@implementation JSaddleHandler
18+
19+- (instancetype)initHandler:(HsStablePtr)startHandler resultHandler:(HsStablePtr)resultHandler
20+{
21+ self = [super init];
22+ if (self) {
23+ _startHandler = startHandler;
24+ _resultHandler = resultHandler;
25+ }
26+ return self;
27+}
28+
29+- (void)webView:(WKWebView *)webView didFinishNavigation:(WKNavigation *)navigation
30+{
31+ jsaddleStart(self.startHandler);
32+}
33+
34+- (void)userContentController:(WKUserContentController *)userContentController didReceiveScriptMessage:(WKScriptMessage *)message
35+{
36+ NSString * s = (NSString *) message.body;
37+ jsaddleResult(self.resultHandler, [s UTF8String]);
38+}
39+
40+@end
41+
42+void addJSaddleHandler(WKWebView *webView, HsStablePtr startHandler, HsStablePtr resultHandler) {
43+ JSaddleHandler * handler = [[JSaddleHandler alloc] initHandler:startHandler resultHandler:resultHandler];
44+ [[[webView configuration] userContentController] addScriptMessageHandler:handler name:@"jsaddle"];
45+ webView.navigationDelegate = handler;
46+}
47+
48+void evaluateJavaScript(WKWebView *webView, const char * _Nonnull js) {
49+ [webView evaluateJavaScript:[NSString stringWithCString:js encoding:NSUTF8StringEncoding] completionHandler:NULL];
50+}
51+
52+void loadHTMLString(WKWebView *webView, const char * _Nonnull html) {
53+ [webView loadHTMLString:[NSString stringWithCString:html encoding:NSUTF8StringEncoding] baseURL:NULL];
54+}
55+
jsaddle-wkwebview/jsaddle-wkwebview.cabalnew file+33
@@ -0,0 +1,33 @@
1+name: jsaddle-wkwebview
2+version: 0.6.0.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. When using GHC
12+ the application is run using Warp and WebSockets to
13+ drive a small JavaScipt helper.
14+category: Web, Javascript
15+author: Hamish Mackenzie
16+
17+source-repository head
18+ type: git
19+ location: https://github.com/ghcjs/jsaddle
20+
21+library
22+ exposed-modules:
23+ Language.Javascript.JSaddle.WKWebView
24+ build-depends:
25+ aeson >=0.8.0.2 && <1.1,
26+ base <5,
27+ bytestring >=0.10.6.0 && <0.11,
28+ jsaddle >= 0.6.0.0 && <0.7
29+ default-language: Haskell2010
30+ hs-source-dirs: src
31+ ghc-options: -ferror-spans -Wall
32+ c-sources: cbits/WKWebView.m
33+
jsaddle-wkwebview/src/Language/Javascript/JSaddle/WKWebView.hsnew file+77
@@ -0,0 +1,77 @@
1+{-# LANGUAGE ForeignFunctionInterface, OverloadedStrings #-}
2+module Language.Javascript.JSaddle.WKWebView
3+ ( jsaddleMain
4+ , WKWebView(..)
5+ ) where
6+
7+import Control.Monad (void, join)
8+import Control.Concurrent (forkIO)
9+
10+import Data.Monoid ((<>))
11+import Data.ByteString (useAsCString, packCString)
12+import Data.ByteString.Lazy (ByteString, toStrict, fromStrict)
13+import Data.Aeson (encode, decode)
14+
15+import Foreign.C.String (CString)
16+import Foreign.Ptr (Ptr)
17+import Foreign.StablePtr (StablePtr, newStablePtr, deRefStablePtr)
18+
19+import Language.Javascript.JSaddle (Result, JSM)
20+import Language.Javascript.JSaddle.Run (runJavaScript)
21+import Language.Javascript.JSaddle.Run.Files (initState, runBatch)
22+
23+newtype WKWebView = WKWebView (Ptr WKWebView)
24+
25+foreign export ccall jsaddleStart :: StablePtr (IO ()) -> IO ()
26+foreign export ccall jsaddleResult :: StablePtr (Result -> IO ()) -> CString -> IO ()
27+foreign import ccall addJSaddleHandler :: WKWebView -> StablePtr (IO ()) -> StablePtr (Result -> IO ()) -> IO ()
28+foreign import ccall loadHTMLString :: WKWebView -> CString -> IO ()
29+foreign import ccall evaluateJavaScript :: WKWebView -> CString -> IO ()
30+
31+jsaddleMain :: JSM () -> WKWebView -> IO ()
32+jsaddleMain f webView = do
33+ (processResult, start) <- runJavaScript (\batch ->
34+ useAsCString (toStrict $ "runJSaddleBatch(" <> encode batch <> ");") $
35+ evaluateJavaScript webView)
36+ f
37+
38+ startHandler <- newStablePtr (void $ forkIO start)
39+ resultHandler <- newStablePtr processResult
40+ addJSaddleHandler webView startHandler resultHandler
41+
42+ useAsCString (toStrict indexHtml) $ loadHTMLString webView
43+ useAsCString (toStrict jsaddleJs) $ evaluateJavaScript webView
44+
45+jsaddleStart :: StablePtr (IO ()) -> IO ()
46+jsaddleStart ptrHandler = join (deRefStablePtr ptrHandler)
47+
48+jsaddleResult :: StablePtr (Result -> IO ()) -> CString -> IO ()
49+jsaddleResult ptrHandler s = do
50+ processResult <- deRefStablePtr ptrHandler
51+ result <- packCString s
52+ case decode (fromStrict result) of
53+ Nothing -> error $ "jsaddle WebSocket decode failed : " <> show result
54+ Just r -> processResult r
55+
56+jsaddleJs :: ByteString
57+jsaddleJs = "\
58+ \runJSaddleBatch = (function() {\n\
59+ \ " <> initState <> "\n\
60+ \ return function(batch) {\n\
61+ \ " <> runBatch (\a -> "window.webkit.messageHandlers.jsaddle.postMessage(JSON.stringify(" <> a <> "));") <> "\
62+ \ };\n\
63+ \})();\n\
64+ \"
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>"
76+
77+-- jsaddle
jsaddle/data/index.htmldeleted−9
@@ -1,9 +0,0 @@
1−<!DOCTYPE html>
2−<html>
3−<head>
4−<title>JSaddle</title>
5−</head>
6−<body>
7−</body>
8−<script src="jsaddle.js"></script>
9−</html>
jsaddle/data/jsaddle.jsdeleted−201
@@ -1,201 +0,0 @@
1−if(typeof global !== "undefined") {
2− global.window = global;
3− global.WebSocket = require('ws');
4−}
5−
6−var connect = function() {
7− var wsaddress =
8− typeof window.location === "undefined"
9− ? "ws://localhost:3709/"
10− : window.location.protocol.replace('http', 'ws')+"//"+window.location.hostname+(window.location.port?(":"+window.location.port):"");
11−
12− var ws = new WebSocket(wsaddress);
13−
14− ws.onopen = function(e) {
15− var jsaddle_values = new Map();
16− jsaddle_values.set(0, null);
17− jsaddle_values.set(1, undefined);
18− jsaddle_values.set(2, false);
19− jsaddle_values.set(3, true);
20− jsaddle_values.set(4, window);
21− var jsaddle_index = 100;
22−
23− ws.onmessage = function(e) {
24− var batch = JSON.parse(e.data);
25−
26− var processBatch = function(timestamp) {
27− try {
28− var nAsyncLength = batch[0].length;
29− for (var nAsync = 0; nAsync != nAsyncLength; nAsync++) {
30− var d = batch[0][nAsync];
31− switch (d.tag) {
32− case "FreeRef":
33− jsaddle_values.delete(d.contents);
34− break;
35− case "SetPropertyByName":
36− jsaddle_values.get(d.contents[0])[d.contents[1]]=jsaddle_values.get(d.contents[2]);
37− break;
38− case "SetPropertyAtIndex":
39− jsaddle_values.get(d.contents[0])[d.contents[1]]=jsaddle_values.get(d.contents[2]);
40− break;
41− case "EvaluateScript":
42− var n = d.contents[1];
43− jsaddle_values.set(n, eval(d.contents[0]));
44− break;
45− case "StringToValue":
46− var n = d.contents[1];
47− jsaddle_values.set(n, d.contents[0]);
48− break;
49− case "GetPropertyByName":
50− var n = d.contents[2];
51− jsaddle_values.set(n, jsaddle_values.get(d.contents[0])[d.contents[1]]);
52− break;
53− case "GetPropertyAtIndex":
54− var n = d.contents[2];
55− jsaddle_values.set(n, jsaddle_values.get(d.contents[0])[d.contents[1]]);
56− break;
57− case "NumberToValue":
58− var n = d.contents[1];
59− jsaddle_values.set(n, d.contents[0]);
60− break;
61− case "NewEmptyObject":
62− var n = d.contents;
63− jsaddle_values.set(n, {});
64− break;
65− case "NewCallback":
66− (function() {
67− var nFunction = d.contents;
68− jsaddle_values.set(nFunction, function() {
69− var nThis = ++jsaddle_index;
70− jsaddle_values.set(nThis, this);
71− var args = [];
72− for (var i = 0; i != arguments.length; i++) {
73− var nArg = ++jsaddle_index;
74− jsaddle_values.set(nArg, arguments[i]);
75− args[i] = nArg;
76− }
77− ws.send(JSON.stringify({"tag": "Callback", "contents": [nFunction, nThis, args]}));
78− })})();
79− break;
80− case "CallAsFunction":
81− var n = d.contents[3];
82− jsaddle_values.set(n,
83− jsaddle_values.get(d.contents[0]).apply(jsaddle_values.get(d.contents[1]),
84− d.contents[2].map(function(arg){return jsaddle_values.get(arg);})));
85− break;
86− case "CallAsConstructor":
87− var n = d.contents[2];
88− var r;
89− var f = jsaddle_values.get(d.contents[0]);
90− var a = d.contents[1].map(function(arg){return jsaddle_values.get(arg);});
91− switch(a.length) {
92− case 0 : r = new f(); break;
93− case 1 : r = new f(a[0]); break;
94− case 2 : r = new f(a[0],a[1]); break;
95− case 3 : r = new f(a[0],a[1],a[2]); break;
96− case 4 : r = new f(a[0],a[1],a[2],a[3]); break;
97− case 5 : r = new f(a[0],a[1],a[2],a[3],a[4]); break;
98− case 6 : r = new f(a[0],a[1],a[2],a[3],a[4],a[5]); break;
99− case 7 : r = new f(a[0],a[1],a[2],a[3],a[4],a[5],a[6]); break;
100− default:
101− var ret;
102− var temp = function() {
103− ret = f.apply(this, a);
104− };
105− temp.prototype = f.prototype;
106− var i = new temp();
107− if(ret instanceof Object)
108− r = ret;
109− else {
110− i.constructor = f;
111− r = i;
112− }
113− }
114− jsaddle_values.set(n, r);
115− break;
116− case "NewArray":
117− var n = d.contents[1];
118− jsaddle_values.set(n, d.contents[0].map(function(v){return jsaddle_values.get(v);}));
119− break;
120− case "SyncWithAnimationFrame":
121− var n = d.contents[0];
122− jsaddle_values.set(n, timestamp);
123− break;
124− default:
125− ws.send(JSON.stringify({"tag": "ProtocolError", "contents": e.data}));
126− return;
127− }
128− }
129− var d = batch[1];
130− switch (d.tag) {
131− case "ValueToString":
132− var val = jsaddle_values.get(d.contents);
133− var s = val === null ? "null" : val === undefined ? "undefined" : val.toString();
134− ws.send(JSON.stringify({"tag": "ValueToStringResult", "contents": s}));
135− break;
136− case "ValueToBool":
137− ws.send(JSON.stringify({"tag": "ValueToBoolResult", "contents": jsaddle_values.get(d.contents) ? true : false}));
138− break;
139− case "ValueToNumber":
140− ws.send(JSON.stringify({"tag": "ValueToNumberResult", "contents": Number(jsaddle_values.get(d.contents))}));
141− break;
142− case "ValueToJSON":
143− var s = jsaddle_values.get(d.contents) === undefined ? "" : JSON.stringify(jsaddle_values.get(d.contents));
144− ws.send(JSON.stringify({"tag": "ValueToJSONResult", "contents": s}));
145− break;
146− case "DeRefVal":
147− var n = d.contents;
148− var v = jsaddle_values.get(n);
149− var c = (v === null ) ? [0, ""] :
150− (v === undefined ) ? [1, ""] :
151− (v === false ) ? [2, ""] :
152− (v === true ) ? [3, ""] :
153− (typeof v === "number") ? [-1, v.toString()] :
154− (typeof v === "string") ? [-2, v]
155− : [n, ""];
156− ws.send(JSON.stringify({"tag": "DeRefValResult", "contents": c}));
157− break;
158− case "IsNull":
159− ws.send(JSON.stringify({"tag": "IsNullResult", "contents": jsaddle_values.get(d.contents) === null}));
160− break;
161− case "IsUndefined":
162− ws.send(JSON.stringify({"tag": "IsUndefinedResult", "contents": jsaddle_values.get(d.contents) === undefined}));
163− break;
164− case "InstanceOf":
165− ws.send(JSON.stringify({"tag": "InstanceOfResult", "contents": jsaddle_values.get(d.contents[0]) instanceof jsaddle_values.get(d.contents[1])}));
166− break;
167− case "StrictEqual":
168− ws.send(JSON.stringify({"tag": "StrictEqualResult", "contents": jsaddle_values.get(d.contents[0]) === jsaddle_values.get(d.contents[1])}));
169− break;
170− case "PropertyNames":
171− var result = [];
172− for (name in jsaddle_values.get(d.contents)) { result.push(name); }
173− ws.send(JSON.stringify({"tag": "PropertyNamesResult", "contents": result}));
174− break;
175− case "Sync":
176− ws.send(JSON.stringify({"tag": "SyncResult", "contents": []}));
177− break;
178− default:
179− ws.send(JSON.stringify({"tag": "ProtocolError", "contents": e.data}));
180− }
181− }
182− catch (err) {
183− var n = ++jsaddle_index;
184− jsaddle_values.set(n, err);
185− ws.send(JSON.stringify({"tag": "ThrowJSValue", "contents": n}));
186− }
187− };
188− if(batch[2]) {
189− window.requestAnimationFrame(processBatch);
190− }
191− else {
192− processBatch(window.performance ? window.performance.now() : null);
193− }
194− };
195− };
196− ws.onerror = function() {
197− setTimeout(connect, 1000);
198− };
199−}
200−
201−connect();
jsaddle/jsaddle.cabal+5−38
@@ -1,5 +1,5 @@
1name: jsaddle
1name: jsaddle
2−version: 0.5.2.0
2+version: 0.6.0.0
3cabal-version: >=1.10
3cabal-version: >=1.10
4build-type: Simple
4build-type: Simple
5license: MIT
5license: MIT
@@ -13,9 +13,6 @@ description:
13 drive a small JavaScipt helper.
13 drive a small JavaScipt helper.
14category: Web, Javascript
14category: Web, Javascript
15author: Hamish Mackenzie
15author: Hamish Mackenzie
16−data-files:
17− data/index.html
18− data/jsaddle.js
19
16
20source-repository head
17source-repository head
21 type: git
18 type: git
@@ -28,10 +25,6 @@ library
28 ghcjs-base -any,
25 ghcjs-base -any,
29 ghcjs-prim -any
26 ghcjs-prim -any
30 else
27 else
31− exposed-modules:
32− Language.Javascript.JSaddle.WebSockets
33− Language.Javascript.JSaddle.WebSockets.Files
34− Language.Javascript.JSaddle.Test
35 build-depends:
28 build-depends:
36 aeson >=0.8.0.2 && <1.1,
29 aeson >=0.8.0.2 && <1.1,
37 bytestring >=0.10.6.0 && <0.11,
30 bytestring >=0.10.6.0 && <0.11,
@@ -41,11 +34,7 @@ library
41 process >=1.2.3.0 && <1.5,
34 process >=1.2.3.0 && <1.5,
42 ref-tf >=0.4.0.1 && <0.5,
35 ref-tf >=0.4.0.1 && <0.5,
43 stm >=2.4.4 && <2.5,
36 stm >=2.4.4 && <2.5,
44− time >=1.5.0.1 && <1.7,
37+ time >=1.5.0.1 && <1.7
45− wai >=3.0.3.0 && <3.3,
46− wai-websockets >=3.0.0.6 && <3.1,
47− warp >=3.1.2 && <3.3,
48− websockets >=0.9.5.0 && <0.10
49 exposed-modules:
38 exposed-modules:
50 Language.Javascript.JSaddle
39 Language.Javascript.JSaddle
51 Language.Javascript.JSaddle.Arguments
40 Language.Javascript.JSaddle.Arguments
@@ -56,10 +45,11 @@ library
56 Language.Javascript.JSaddle.Native
45 Language.Javascript.JSaddle.Native
57 Language.Javascript.JSaddle.Object
46 Language.Javascript.JSaddle.Object
58 Language.Javascript.JSaddle.Properties
47 Language.Javascript.JSaddle.Properties
48+ Language.Javascript.JSaddle.Run
49+ Language.Javascript.JSaddle.Run.Files
59 Language.Javascript.JSaddle.String
50 Language.Javascript.JSaddle.String
60 Language.Javascript.JSaddle.Value
51 Language.Javascript.JSaddle.Value
61 Language.Javascript.JSaddle.Types
52 Language.Javascript.JSaddle.Types
62− Paths_jsaddle
63 build-depends:
53 build-depends:
64 base <5,
54 base <5,
65 lens >=3.8.5 && <4.16,
55 lens >=3.8.5 && <4.16,
@@ -69,29 +59,6 @@ library
69 transformers >=0.4.2.0 && <0.6
59 transformers >=0.4.2.0 && <0.6
70 default-language: Haskell2010
60 default-language: Haskell2010
71 hs-source-dirs: src
61 hs-source-dirs: src
72− ghc-options: -ferror-spans
62+ ghc-options: -ferror-spans -Wall
73
63
74−test-suite test-tool
75
64
76− if !impl(ghcjs -any)
77− build-depends:
78− QuickCheck -any,
79− bytestring >=0.10.6.0 && <0.11,
80− doctest >=0.10.1 && <0.12,
81− filepath >=1.4.0.0 && <1.5,
82− http-types >=0.8.6 && <0.10,
83− jsaddle -any,
84− process >=1.2.3.0 && <1.5,
85− text >=1.2.1.3 && <1.3,
86− vector >=0.10.12.3 && <0.12,
87− wai >=3.0.3.0 && <3.3,
88− wai-websockets >=3.0.0.6 && <3.1,
89− warp >=3.1.2 && <3.3,
90− websockets >=0.9.5.0 && <0.10
91− type: exitcode-stdio-1.0
92− main-is: DocTest.hs
93− build-depends:
94− base -any
95− default-language: Haskell2010
96− hs-source-dirs: tests
97− ghc-options: -ferror-spans -threaded
jsaddle/src/Language/Javascript/JSaddle/Evaluate.hs+1−1
@@ -29,7 +29,7 @@ import Language.Javascript.JSaddle.Types (JSString)
29#else
29#else
30import Language.Javascript.JSaddle.Native
30import Language.Javascript.JSaddle.Native
31 (withJSString)
31 (withJSString)
32−import Language.Javascript.JSaddle.WebSockets
32+import Language.Javascript.JSaddle.Run
33 (AsyncCommand(..), sendLazyCommand)
33 (AsyncCommand(..), sendLazyCommand)
34#endif
34#endif
35import Language.Javascript.JSaddle.Classes
35import Language.Javascript.JSaddle.Classes
jsaddle/src/Language/Javascript/JSaddle/Monad.hs+2−3
@@ -21,7 +21,6 @@ module Language.Javascript.JSaddle.Monad (
21
21
22 -- * Running JavaScript in a JavaScript context
22 -- * Running JavaScript in a JavaScript context
23 , askJSM
23 , askJSM
24− , run
25 , runJSM
24 , runJSM
26 , runJSaddle
25 , runJSaddle
27
26
@@ -36,12 +35,12 @@ module Language.Javascript.JSaddle.Monad (
36 , bracket
35 , bracket
37) where
36) where
38
37
39−import Prelude hiding (catch, read)
38+import Prelude hiding (read)
40import Control.Monad.Trans.Reader (runReaderT, ask, ReaderT(..))
39import Control.Monad.Trans.Reader (runReaderT, ask, ReaderT(..))
41import Control.Monad.IO.Class (MonadIO(..))
40import Control.Monad.IO.Class (MonadIO(..))
42import qualified Control.Exception as E (Exception, catch, bracket)
41import qualified Control.Exception as E (Exception, catch, bracket)
43import Language.Javascript.JSaddle.Types (JSM(..), MonadJSM, liftJSM, JSContextRef(..))
42import Language.Javascript.JSaddle.Types (JSM(..), MonadJSM, liftJSM, JSContextRef(..))
44−import Language.Javascript.JSaddle.WebSockets (run, syncPoint, syncAfter, waitForAnimationFrame, nextAnimationFrame)
43+import Language.Javascript.JSaddle.Run (syncPoint, syncAfter, waitForAnimationFrame, nextAnimationFrame)
45
44
46-- | Gets the JavaScript context from the monad
45-- | Gets the JavaScript context from the monad
47askJSM :: MonadJSM m => m JSContextRef
46askJSM :: MonadJSM m => m JSContextRef
jsaddle/src/Language/Javascript/JSaddle/Object.hs+6−6
@@ -109,7 +109,7 @@ import Data.Coerce (coerce)
109#else
109#else
110import Language.Javascript.JSaddle.Native
110import Language.Javascript.JSaddle.Native
111 (wrapJSString, withJSVals, withObject)
111 (wrapJSString, withJSVals, withObject)
112−import Language.Javascript.JSaddle.WebSockets
112+import Language.Javascript.JSaddle.Run
113 (Command(..), AsyncCommand(..), Result(..), sendCommand, sendLazyCommand)
113 (Command(..), AsyncCommand(..), Result(..), sendCommand, sendLazyCommand)
114#endif
114#endif
115import Language.Javascript.JSaddle.Value (valToObject)
115import Language.Javascript.JSaddle.Value (valToObject)
@@ -443,10 +443,10 @@ foreign import javascript unsafe "$r = function () { $1(this, arguments); }"
443 makeFunctionWithCallback :: Callback (JSVal -> JSVal -> IO ()) -> IO Object
443 makeFunctionWithCallback :: Callback (JSVal -> JSVal -> IO ()) -> IO Object
444#else
444#else
445function f = do
445function f = do
446− obj <- Object <$> sendLazyCommand NewCallback
446+ object <- Object <$> sendLazyCommand NewCallback
447 add <- addCallback <$> askJSM
447 add <- addCallback <$> askJSM
448− liftIO $ add obj f
448+ liftIO $ add object f
449− return $ Function obj
449+ return $ Function object
450#endif
450#endif
451
451
452freeFunction :: Function -> JSM ()
452freeFunction :: Function -> JSM ()
@@ -454,9 +454,9 @@ freeFunction :: Function -> JSM ()
454freeFunction (Function callback _) = liftIO $
454freeFunction (Function callback _) = liftIO $
455 releaseCallback callback
455 releaseCallback callback
456#else
456#else
457−freeFunction (Function obj) = do
457+freeFunction (Function object) = do
458 free <- freeCallback <$> askJSM
458 free <- freeCallback <$> askJSM
459− liftIO $ free obj
459+ liftIO $ free object
460#endif
460#endif
461
461
462instance ToJSVal Function where
462instance ToJSVal Function where
jsaddle/src/Language/Javascript/JSaddle/Properties.hs+3−4
@@ -31,14 +31,14 @@ module Language.Javascript.JSaddle.Properties (
31
31
32import Language.Javascript.JSaddle.Classes
32import Language.Javascript.JSaddle.Classes
33 (ToJSVal(..), ToJSString(..))
33 (ToJSVal(..), ToJSString(..))
34−import Language.Javascript.JSaddle.Monad (askJSM, JSM)
34+import Language.Javascript.JSaddle.Monad (JSM)
35import Language.Javascript.JSaddle.Types (Object(..))
35import Language.Javascript.JSaddle.Types (Object(..))
36#ifdef ghcjs_HOST_OS
36#ifdef ghcjs_HOST_OS
37import Language.Javascript.JSaddle.Types (JSString)
37import Language.Javascript.JSaddle.Types (JSString)
38#else
38#else
39import Language.Javascript.JSaddle.Native
39import Language.Javascript.JSaddle.Native
40 (withObject, withJSString, withToJSVal)
40 (withObject, withJSString, withToJSVal)
41−import Language.Javascript.JSaddle.WebSockets
41+import Language.Javascript.JSaddle.Run
42 (AsyncCommand(..), sendLazyCommand, sendAsyncCommand)
42 (AsyncCommand(..), sendLazyCommand, sendAsyncCommand)
43#endif
43#endif
44import Language.Javascript.JSaddle.Value (JSVal)
44import Language.Javascript.JSaddle.Value (JSVal)
@@ -108,8 +108,7 @@ objSetPropertyAtIndex this index val = do
108foreign import javascript unsafe "$2[$1]=$3"
108foreign import javascript unsafe "$2[$1]=$3"
109 js_trySetAtIndex :: Int -> Object -> JSVal -> IO ()
109 js_trySetAtIndex :: Int -> Object -> JSVal -> IO ()
110#else
110#else
111−objSetPropertyAtIndex this index val = do
111+objSetPropertyAtIndex this index val =
112− gctxt <- askJSM
113 withObject this $ \rthis ->
112 withObject this $ \rthis ->
114 withToJSVal val $ \rval ->
113 withToJSVal val $ \rval ->
115 sendAsyncCommand $ SetPropertyAtIndex rthis index rval
114 sendAsyncCommand $ SetPropertyAtIndex rthis index rval
jsaddle/src/Language/Javascript/JSaddle/WebSockets.hs → jsaddle/src/Language/Javascript/JSaddle/Run.hsrenamed+47−99
@@ -3,7 +3,7 @@
3{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE OverloadedStrings #-}
4-----------------------------------------------------------------------------
4-----------------------------------------------------------------------------
5--
5--
6−-- Module : Language.Javascript.JSaddle.WebSockets
6+-- Module : Language.Javascript.JSaddle.Run
7-- Copyright : (c) Hamish Mackenzie
7-- Copyright : (c) Hamish Mackenzie
8-- License : MIT
8-- License : MIT
9--
9--
@@ -13,16 +13,15 @@
13--
13--
14-----------------------------------------------------------------------------
14-----------------------------------------------------------------------------
15
15
16−module Language.Javascript.JSaddle.WebSockets (
16+module Language.Javascript.JSaddle.Run (
17− -- * Running JSM over WebSockets
17+ -- * Running JSM
18− run
18+ runJavaScript
19 , syncPoint
19 , syncPoint
20 , syncAfter
20 , syncAfter
21 , waitForAnimationFrame
21 , waitForAnimationFrame
22 , nextAnimationFrame
22 , nextAnimationFrame
23#ifndef ghcjs_HOST_OS
23#ifndef ghcjs_HOST_OS
24− , jsaddleOr
25− -- * Functions used to implement JSaddle over WebSockets
24+ -- * Functions used to implement JSaddle using JSON messaging
26 , AsyncCommand(..)
25 , AsyncCommand(..)
27 , Command(..)
26 , Command(..)
28 , Result(..)
27 , Result(..)
@@ -53,40 +52,13 @@ import Control.Concurrent.MVar
53import Data.Monoid ((<>))
52import Data.Monoid ((<>))
54import qualified Data.Text as T (unpack)
53import qualified Data.Text as T (unpack)
55import qualified Data.Map as M (lookup, delete, insert, empty)
54import qualified Data.Map as M (lookup, delete, insert, empty)
56−import Data.Aeson (encode, decode)
57import Data.Time.Clock (getCurrentTime,diffUTCTime)
55import Data.Time.Clock (getCurrentTime,diffUTCTime)
58
56
59−import Network.Wai (Application)
60−import Network.Wai.Handler.Warp
61− (defaultSettings, setTimeout, setPort, runSettings)
62−import Network.WebSockets
63− (ConnectionOptions(..), sendTextData, receiveDataMessage,
64− acceptRequest, defaultConnectionOptions, ServerApp)
65−import qualified Network.WebSockets as WS (DataMessage(..))
66−import Network.Wai.Handler.WebSockets (websocketsOr)
67−
68import Language.Javascript.JSaddle.Types
57import Language.Javascript.JSaddle.Types
69 (Command(..), AsyncCommand(..), Result(..), JSContextRef(..), JSVal(..),
58 (Command(..), AsyncCommand(..), Result(..), JSContextRef(..), JSVal(..),
70 Object(..), JSValueReceived(..), JSM(..), Batch(..), JSValueForSend(..))
59 Object(..), JSValueReceived(..), JSM(..), Batch(..), JSValueForSend(..))
71import Language.Javascript.JSaddle.Exception (JSException(..))
60import Language.Javascript.JSaddle.Exception (JSException(..))
72import Language.Javascript.JSaddle.Native (wrapJSVal)
61import Language.Javascript.JSaddle.Native (wrapJSVal)
73−import Language.Javascript.JSaddle.WebSockets.Files (indexHtml, jsaddleJs)
74−import qualified Network.Wai as W
75− (responseLBS, requestMethod, Application, pathInfo)
76−import Data.Text (Text)
77−import qualified Network.HTTP.Types as H
78− (status403, status200, status405)
79−#endif
80−
81−-- | Run the given 'JSM' action as the main entry point. Either directly
82−-- in GHCJS or as a Warp server on the given port on GHC.
83−run :: Int -> JSM () -> IO ()
84−#ifdef ghcjs_HOST_OS
85−run _port = id
86−#else
87−run port f =
88− runSettings (setPort port (setTimeout 3600 defaultSettings)) $
89− jsaddleOr defaultConnectionOptions (f >> syncPoint) jsaddleApp
90#endif
62#endif
91
63
92-- | Forces execution of pending asyncronous code
64-- | Forces execution of pending asyncronous code
@@ -154,58 +126,49 @@ sendAsyncCommand cmd = do
154 s <- doSendAsyncCommand <$> JSM ask
126 s <- doSendAsyncCommand <$> JSM ask
155 liftIO $ s cmd
127 liftIO $ s cmd
156
128
157−jsaddleOr :: ConnectionOptions -> JSM () -> Application -> Application
129+runJavaScript :: (Batch -> IO ()) -> JSM () -> IO (Result -> IO (), IO ())
158−jsaddleOr opts entryPoint = websocketsOr opts wsApp
130+runJavaScript sendBatch entryPoint = do
131+ startTime' <- getCurrentTime
132+ recvChan <- newTChanIO
133+ commandChan <- newTChanIO
134+ callbacks <- newTVarIO M.empty
135+ nextRef' <- newTVarIO 0
136+ let ctx = JSContextRef {
137+ startTime = startTime'
138+ , doSendCommand = \cmd -> do
139+ result <- newEmptyMVar
140+ atomically $ writeTChan commandChan (Right (cmd, result))
141+ takeMVar result >>= \case
142+ (ThrowJSValue (JSValueReceived v)) -> throwIO $ JSException (JSVal v)
143+ r -> return r
144+ , doSendAsyncCommand = atomically . writeTChan commandChan . Left
145+ , addCallback = \(Object (JSVal val)) cb -> atomically $ modifyTVar callbacks (M.insert val cb)
146+ , freeCallback = \(Object (JSVal val)) -> atomically $ modifyTVar callbacks (M.delete val)
147+ , nextRef = nextRef'
148+ }
149+ let processResult = \case
150+ (ProtocolError err) -> error $ "Protocol error : " <> T.unpack err
151+ (Callback f this a) -> do
152+ f'@(JSVal fNumber) <- runReaderT (unJSM $ wrapJSVal f) ctx
153+ this' <- runReaderT (unJSM $ wrapJSVal this) ctx
154+ args <- runReaderT (unJSM $ mapM wrapJSVal a) ctx
155+ (M.lookup fNumber <$> liftIO (readTVarIO callbacks)) >>= \case
156+ Nothing -> liftIO $ putStrLn "Callback called after it was freed"
157+ Just cb -> void . forkIO $ runReaderT (unJSM $ cb f' this' args) ctx
158+ m -> atomically $ writeTChan recvChan m
159+ _ <- forkIO . forever $ readBatch commandChan >>= \case
160+ (batch, Just resultMVar) -> do
161+ sendBatch batch
162+ atomically (readTChan recvChan) >>= putMVar resultMVar
163+ (batch, Nothing) -> do
164+ sendBatch batch
165+ atomically (readTChan recvChan) >>= \case
166+ SyncResult -> return ()
167+ ThrowJSValue e -> atomically (discardToSyncPoint commandChan) >>= (`putMVar` ThrowJSValue e)
168+ _ -> error "Unexpected result processing batch"
169+ return ()
170+ return (processResult, runReaderT (unJSM entryPoint) ctx)
159 where
171 where
160− wsApp :: ServerApp
161− wsApp pending_conn = do
162− startTime <- getCurrentTime
163− conn <- acceptRequest pending_conn
164− recvChan <- newTChanIO
165− commandChan <- newTChanIO
166− callbacks <- newTVarIO M.empty
167− nextRef <- newTVarIO 0
168− let ctx = JSContextRef {
169− startTime = startTime
170− , doSendCommand = \cmd -> do
171− result <- newEmptyMVar
172− atomically $ writeTChan commandChan (Right (cmd, result))
173− takeMVar result >>= \case
174− (ThrowJSValue (JSValueReceived v)) -> throwIO $ JSException (JSVal v)
175− result -> return result
176− , doSendAsyncCommand = atomically . writeTChan commandChan . Left
177− , addCallback = \(Object (JSVal val)) cb -> atomically $ modifyTVar callbacks (M.insert val cb)
178− , freeCallback = \(Object (JSVal val)) -> atomically $ modifyTVar callbacks (M.delete val)
179− , nextRef = nextRef
180− }
181− forkIO . forever $
182− receiveDataMessage conn >>= \case
183− (WS.Text t) ->
184− case decode t of
185− Nothing -> error $ "jsaddle WebSocket decode failed : " <> show t
186− Just (ProtocolError err) -> error $ "Protocol error : " <> T.unpack err
187− Just (Callback f this a) -> do
188− f'@(JSVal fNumber) <- runReaderT (unJSM $ wrapJSVal f) ctx
189− this' <- runReaderT (unJSM $ wrapJSVal this) ctx
190− args <- runReaderT (unJSM $ mapM wrapJSVal a) ctx
191− (M.lookup fNumber <$> liftIO (readTVarIO callbacks)) >>= \case
192− Nothing -> liftIO $ putStrLn "Callback called after it was freed"
193− Just cb -> void . forkIO $ runReaderT (unJSM $ cb f' this' args) ctx
194− Just m -> atomically $ writeTChan recvChan m
195− _ -> error "jsaddle WebSocket unexpected binary data"
196− forkIO . forever $ readBatch commandChan >>= \case
197− (batch, Just resultMVar) -> do
198− sendTextData conn $ encode batch
199− atomically (readTChan recvChan) >>= putMVar resultMVar
200− (batch, Nothing) -> do
201− sendTextData conn $ encode batch
202− atomically (readTChan recvChan) >>= \case
203− SyncResult -> return ()
204− ThrowJSValue e -> atomically (discardToSyncPoint commandChan) >>= (`putMVar` ThrowJSValue e)
205− _ -> error "Unexpected result processing batch"
206− return ()
207− runReaderT (unJSM entryPoint) ctx
208−
209 readBatch :: TChan (Either AsyncCommand (Command, MVar Result)) -> IO (Batch, Maybe (MVar Result))
172 readBatch :: TChan (Either AsyncCommand (Command, MVar Result)) -> IO (Batch, Maybe (MVar Result))
210 readBatch chan = do
173 readBatch chan = do
211 first <- atomically $ readTChan chan -- We want at least one command to send
174 first <- atomically $ readTChan chan -- We want at least one command to send
@@ -230,19 +193,4 @@ jsaddleOr opts entryPoint = websocketsOr opts wsApp
230 readTChan chan >>= \case
193 readTChan chan >>= \case
231 Right (_, resultMVar) -> return resultMVar
194 Right (_, resultMVar) -> return resultMVar
232 _ -> discardToSyncPoint chan
195 _ -> discardToSyncPoint chan
233−
234−jsaddleApp :: Application
235−jsaddleApp req = jsaddleAppPieces (W.pathInfo req) req
236−
237−jsaddleAppPieces :: [Text] -> W.Application
238−jsaddleAppPieces _ req sendResponse
239− | notElem (W.requestMethod req) ["GET", "HEAD"] = sendResponse $ W.responseLBS
240− H.status405
241− [("Content-Type", "text/plain")]
242− "Only GET or HEAD is supported"
243−jsaddleAppPieces [] req sendResponse = sendResponse $ W.responseLBS H.status200 [("Content-Type", "image/png")] indexHtml
244−jsaddleAppPieces ["jsaddle.js"] req sendResponse = sendResponse $ W.responseLBS H.status200 [("Content-Type", "image/png")] jsaddleJs
245−jsaddleAppPieces rawPieces req sendResponse = sendResponse $ W.responseLBS H.status403
246− [ ("Content-Type", "text/plain")
247− ] "Forbidden"
248#endif
196#endif
jsaddle/src/Language/Javascript/JSaddle/WebSockets/Files.hs → jsaddle/src/Language/Javascript/JSaddle/Run/Files.hsrenamed+51−38
@@ -11,12 +11,15 @@
11--
11--
12-----------------------------------------------------------------------------
12-----------------------------------------------------------------------------
13
13
14−module Language.Javascript.JSaddle.WebSockets.Files (
14+module Language.Javascript.JSaddle.Run.Files (
15 indexHtml
15 indexHtml
16 , jsaddleJs
16 , jsaddleJs
17+ , initState
18+ , runBatch
17) where
19) where
18
20
19import Data.ByteString.Lazy (ByteString)
21import Data.ByteString.Lazy (ByteString)
22+import Data.Monoid ((<>))
20
23
21indexHtml :: ByteString
24indexHtml :: ByteString
22indexHtml =
25indexHtml =
@@ -30,24 +33,8 @@ indexHtml =
30 \<script src=\"jsaddle.js\"></script>\n\
33 \<script src=\"jsaddle.js\"></script>\n\
31 \</html>"
34 \</html>"
32
35
33−-- Use this to generate this string for embedding
34−-- sed -e 's|\\|\\\\|g' -e 's|^| \\|' -e 's|$|\\n\\|' -e 's|"|\\"|g' data/jsaddle.js | pbcopy
35−jsaddleJs :: ByteString
36+initState :: ByteString
36−jsaddleJs = "\
37+initState = "\
37− \if(typeof global !== \"undefined\") {\n\
38− \ global.window = global;\n\
39− \ global.WebSocket = require('ws');\n\
40− \}\n\
41− \\n\
42− \var connect = function() {\n\
43− \ var wsaddress =\n\
44− \ typeof window.location === \"undefined\"\n\
45− \ ? \"ws://localhost:3709/\"\n\
46− \ : window.location.protocol.replace('http', 'ws')+\"//\"+window.location.hostname+(window.location.port?(\":\"+window.location.port):\"\");\n\
47− \\n\
48− \ var ws = new WebSocket(wsaddress);\n\
49− \\n\
50− \ ws.onopen = function(e) {\n\
51 \ var jsaddle_values = new Map();\n\
38 \ var jsaddle_values = new Map();\n\
52 \ jsaddle_values.set(0, null);\n\
39 \ jsaddle_values.set(0, null);\n\
53 \ jsaddle_values.set(1, undefined);\n\
40 \ jsaddle_values.set(1, undefined);\n\
@@ -55,10 +42,10 @@ jsaddleJs = "\
55 \ jsaddle_values.set(3, true);\n\
42 \ jsaddle_values.set(3, true);\n\
56 \ jsaddle_values.set(4, window);\n\
43 \ jsaddle_values.set(4, window);\n\
57 \ var jsaddle_index = 100;\n\
44 \ var jsaddle_index = 100;\n\
58− \\n\
45+ \"
59− \ ws.onmessage = function(e) {\n\
46+
60− \ var batch = JSON.parse(e.data);\n\
47+runBatch :: (ByteString -> ByteString) -> ByteString
61− \\n\
48+runBatch send = "\
62 \ var processBatch = function(timestamp) {\n\
49 \ var processBatch = function(timestamp) {\n\
63 \ try {\n\
50 \ try {\n\
64 \ var nAsyncLength = batch[0].length;\n\
51 \ var nAsyncLength = batch[0].length;\n\
@@ -110,7 +97,7 @@ jsaddleJs = "\
110 \ jsaddle_values.set(nArg, arguments[i]);\n\
97 \ jsaddle_values.set(nArg, arguments[i]);\n\
111 \ args[i] = nArg;\n\
98 \ args[i] = nArg;\n\
112 \ }\n\
99 \ }\n\
113− \ ws.send(JSON.stringify({\"tag\": \"Callback\", \"contents\": [nFunction, nThis, args]}));\n\
100+ \ " <> send "{\"tag\": \"Callback\", \"contents\": [nFunction, nThis, args]}" <> "\n\
114 \ })})();\n\
101 \ })})();\n\
115 \ break;\n\
102 \ break;\n\
116 \ case \"CallAsFunction\":\n\
103 \ case \"CallAsFunction\":\n\
@@ -158,7 +145,7 @@ jsaddleJs = "\
158 \ jsaddle_values.set(n, timestamp);\n\
145 \ jsaddle_values.set(n, timestamp);\n\
159 \ break;\n\
146 \ break;\n\
160 \ default:\n\
147 \ default:\n\
161− \ ws.send(JSON.stringify({\"tag\": \"ProtocolError\", \"contents\": e.data}));\n\
148+ \ " <> send "{\"tag\": \"ProtocolError\", \"contents\": e.data}" <> "\n\
162 \ return;\n\
149 \ return;\n\
163 \ }\n\
150 \ }\n\
164 \ }\n\
151 \ }\n\
@@ -167,17 +154,17 @@ jsaddleJs = "\
167 \ case \"ValueToString\":\n\
154 \ case \"ValueToString\":\n\
168 \ var val = jsaddle_values.get(d.contents);\n\
155 \ var val = jsaddle_values.get(d.contents);\n\
169 \ var s = val === null ? \"null\" : val === undefined ? \"undefined\" : val.toString();\n\
156 \ var s = val === null ? \"null\" : val === undefined ? \"undefined\" : val.toString();\n\
170− \ ws.send(JSON.stringify({\"tag\": \"ValueToStringResult\", \"contents\": s}));\n\
157+ \ " <> send "{\"tag\": \"ValueToStringResult\", \"contents\": s}" <> "\n\
171 \ break;\n\
158 \ break;\n\
172 \ case \"ValueToBool\":\n\
159 \ case \"ValueToBool\":\n\
173− \ ws.send(JSON.stringify({\"tag\": \"ValueToBoolResult\", \"contents\": jsaddle_values.get(d.contents) ? true : false}));\n\
160+ \ " <> send "{\"tag\": \"ValueToBoolResult\", \"contents\": jsaddle_values.get(d.contents) ? true : false}" <> "\n\
174 \ break;\n\
161 \ break;\n\
175 \ case \"ValueToNumber\":\n\
162 \ case \"ValueToNumber\":\n\
176− \ ws.send(JSON.stringify({\"tag\": \"ValueToNumberResult\", \"contents\": Number(jsaddle_values.get(d.contents))}));\n\
163+ \ " <> send "{\"tag\": \"ValueToNumberResult\", \"contents\": Number(jsaddle_values.get(d.contents))}" <> "\n\
177 \ break;\n\
164 \ break;\n\
178 \ case \"ValueToJSON\":\n\
165 \ case \"ValueToJSON\":\n\
179 \ var s = jsaddle_values.get(d.contents) === undefined ? \"\" : JSON.stringify(jsaddle_values.get(d.contents));\n\
166 \ var s = jsaddle_values.get(d.contents) === undefined ? \"\" : JSON.stringify(jsaddle_values.get(d.contents));\n\
180− \ ws.send(JSON.stringify({\"tag\": \"ValueToJSONResult\", \"contents\": s}));\n\
167+ \ " <> send "{\"tag\": \"ValueToJSONResult\", \"contents\": s}" <> "\n\
181 \ break;\n\
168 \ break;\n\
182 \ case \"DeRefVal\":\n\
169 \ case \"DeRefVal\":\n\
183 \ var n = d.contents;\n\
170 \ var n = d.contents;\n\
@@ -189,36 +176,36 @@ jsaddleJs = "\
189 \ (typeof v === \"number\") ? [-1, v.toString()] :\n\
176 \ (typeof v === \"number\") ? [-1, v.toString()] :\n\
190 \ (typeof v === \"string\") ? [-2, v]\n\
177 \ (typeof v === \"string\") ? [-2, v]\n\
191 \ : [n, \"\"];\n\
178 \ : [n, \"\"];\n\
192− \ ws.send(JSON.stringify({\"tag\": \"DeRefValResult\", \"contents\": c}));\n\
179+ \ " <> send "{\"tag\": \"DeRefValResult\", \"contents\": c}" <> "\n\
193 \ break;\n\
180 \ break;\n\
194 \ case \"IsNull\":\n\
181 \ case \"IsNull\":\n\
195− \ ws.send(JSON.stringify({\"tag\": \"IsNullResult\", \"contents\": jsaddle_values.get(d.contents) === null}));\n\
182+ \ " <> send "{\"tag\": \"IsNullResult\", \"contents\": jsaddle_values.get(d.contents) === null}" <> "\n\
196 \ break;\n\
183 \ break;\n\
197 \ case \"IsUndefined\":\n\
184 \ case \"IsUndefined\":\n\
198− \ ws.send(JSON.stringify({\"tag\": \"IsUndefinedResult\", \"contents\": jsaddle_values.get(d.contents) === undefined}));\n\
185+ \ " <> send "{\"tag\": \"IsUndefinedResult\", \"contents\": jsaddle_values.get(d.contents) === undefined}" <> "\n\
199 \ break;\n\
186 \ break;\n\
200 \ case \"InstanceOf\":\n\
187 \ case \"InstanceOf\":\n\
201− \ ws.send(JSON.stringify({\"tag\": \"InstanceOfResult\", \"contents\": jsaddle_values.get(d.contents[0]) instanceof jsaddle_values.get(d.contents[1])}));\n\
188+ \ " <> send "{\"tag\": \"InstanceOfResult\", \"contents\": jsaddle_values.get(d.contents[0]) instanceof jsaddle_values.get(d.contents[1])}" <> "\n\
202 \ break;\n\
189 \ break;\n\
203 \ case \"StrictEqual\":\n\
190 \ case \"StrictEqual\":\n\
204− \ ws.send(JSON.stringify({\"tag\": \"StrictEqualResult\", \"contents\": jsaddle_values.get(d.contents[0]) === jsaddle_values.get(d.contents[1])}));\n\
191+ \ " <> send "{\"tag\": \"StrictEqualResult\", \"contents\": jsaddle_values.get(d.contents[0]) === jsaddle_values.get(d.contents[1])}" <> "\n\
205 \ break;\n\
192 \ break;\n\
206 \ case \"PropertyNames\":\n\
193 \ case \"PropertyNames\":\n\
207 \ var result = [];\n\
194 \ var result = [];\n\
208 \ for (name in jsaddle_values.get(d.contents)) { result.push(name); }\n\
195 \ for (name in jsaddle_values.get(d.contents)) { result.push(name); }\n\
209− \ ws.send(JSON.stringify({\"tag\": \"PropertyNamesResult\", \"contents\": result}));\n\
196+ \ " <> send "{\"tag\": \"PropertyNamesResult\", \"contents\": result}" <> "\n\
210 \ break;\n\
197 \ break;\n\
211 \ case \"Sync\":\n\
198 \ case \"Sync\":\n\
212− \ ws.send(JSON.stringify({\"tag\": \"SyncResult\", \"contents\": []}));\n\
199+ \ " <> send "{\"tag\": \"SyncResult\", \"contents\": []}" <> "\n\
213 \ break;\n\
200 \ break;\n\
214 \ default:\n\
201 \ default:\n\
215− \ ws.send(JSON.stringify({\"tag\": \"ProtocolError\", \"contents\": e.data}));\n\
202+ \ " <> send "{\"tag\": \"ProtocolError\", \"contents\": e.data}" <> "\n\
216 \ }\n\
203 \ }\n\
217 \ }\n\
204 \ }\n\
218 \ catch (err) {\n\
205 \ catch (err) {\n\
219 \ var n = ++jsaddle_index;\n\
206 \ var n = ++jsaddle_index;\n\
220 \ jsaddle_values.set(n, err);\n\
207 \ jsaddle_values.set(n, err);\n\
221− \ ws.send(JSON.stringify({\"tag\": \"ThrowJSValue\", \"contents\": n}));\n\
208+ \ " <> send "{\"tag\": \"ThrowJSValue\", \"contents\": n}" <> "\n\
222 \ }\n\
209 \ }\n\
223 \ };\n\
210 \ };\n\
224 \ if(batch[2]) {\n\
211 \ if(batch[2]) {\n\
@@ -227,6 +214,32 @@ jsaddleJs = "\
227 \ else {\n\
214 \ else {\n\
228 \ processBatch(window.performance ? window.performance.now() : null);\n\
215 \ processBatch(window.performance ? window.performance.now() : null);\n\
229 \ }\n\
216 \ }\n\
217+ \"
218+
219+-- Use this to generate this string for embedding
220+-- sed -e 's|\\|\\\\|g' -e 's|^| \\|' -e 's|$|\\n\\|' -e 's|"|\\"|g' data/jsaddle.js | pbcopy
221+jsaddleJs :: ByteString
222+jsaddleJs = "\
223+ \if(typeof global !== \"undefined\") {\n\
224+ \ global.window = global;\n\
225+ \ global.WebSocket = require('ws');\n\
226+ \}\n\
227+ \\n\
228+ \var connect = function() {\n\
229+ \ var wsaddress =\n\
230+ \ typeof window.location === \"undefined\"\n\
231+ \ ? \"ws://localhost:3709/\"\n\
232+ \ : window.location.protocol.replace('http', 'ws')+\"//\"+window.location.hostname+(window.location.port?(\":\"+window.location.port):\"\");\n\
233+ \\n\
234+ \ var ws = new WebSocket(wsaddress);\n\
235+ \\n\
236+ \ ws.onopen = function(e) {\n\
237+ \ " <> initState <> "\
238+ \\n\
239+ \ ws.onmessage = function(e) {\n\
240+ \ var batch = JSON.parse(e.data);\n\
241+ \\n\
242+ \ " <> runBatch (\a -> "ws.send(JSON.stringify(" <> a <> "));") <> "\
230 \ };\n\
243 \ };\n\
231 \ };\n\
244 \ };\n\
232 \ ws.onerror = function() {\n\
245 \ ws.onerror = function() {\n\
jsaddle/src/Language/Javascript/JSaddle/Value.hs+4−5
@@ -70,8 +70,6 @@ module Language.Javascript.JSaddle.Value (
70 , instanceOf
70 , instanceOf
71) where
71) where
72
72
73−import Control.Applicative
74−import Prelude hiding (catch)
75import Language.Javascript.JSaddle.Types
73import Language.Javascript.JSaddle.Types
76 (Object(..), JSString(..), JSVal(..))
74 (Object(..), JSString(..), JSVal(..))
77#ifdef ghcjs_HOST_OS
75#ifdef ghcjs_HOST_OS
@@ -87,7 +85,7 @@ import Data.JSString.Text (textToJSString)
87import Language.Javascript.JSaddle.Native
85import Language.Javascript.JSaddle.Native
88 (wrapJSString, withJSVal, withObject, withJSString,
86 (wrapJSString, withJSVal, withObject, withJSString,
89 withToJSVal)
87 withToJSVal)
90−import Language.Javascript.JSaddle.WebSockets
88+import Language.Javascript.JSaddle.Run
91 (Command(..), AsyncCommand(..), Result(..), sendCommand,
89 (Command(..), AsyncCommand(..), Result(..), sendCommand,
92 sendLazyCommand)
90 sendLazyCommand)
93#endif
91#endif
@@ -165,8 +163,8 @@ valToBool value =
165 (JSVal 1) -> return False -- undefined
163 (JSVal 1) -> return False -- undefined
166 (JSVal 2) -> return False -- false
164 (JSVal 2) -> return False -- false
167 (JSVal 3) -> return True -- true
165 (JSVal 3) -> return True -- true
168− val ->
166+ v ->
169− withJSVal val $ \rval -> do
167+ withJSVal v $ \rval -> do
170 ValueToBoolResult result <- sendCommand (ValueToBool rval)
168 ValueToBoolResult result <- sendCommand (ValueToBool rval)
171 return result
169 return result
172#endif
170#endif
@@ -570,6 +568,7 @@ deRefVal value = do
570 DeRefValResult (-1) s -> return $ ValNumber (read (T.unpack s))
568 DeRefValResult (-1) s -> return $ ValNumber (read (T.unpack s))
571 DeRefValResult (-2) s -> return $ ValString s
569 DeRefValResult (-2) s -> return $ ValString s
572 DeRefValResult ref _ -> return $ ValObject (Object (JSVal ref))
570 DeRefValResult ref _ -> return $ ValObject (Object (JSVal ref))
571+ _ -> error "Unexpected result dereferencing JSaddle value"
573#endif
572#endif
574
573
575-- | Make a JavaScript value out of a 'JSValue' ADT.
574-- | Make a JavaScript value out of a 'JSValue' ADT.
travis/build.sh+3−3
@@ -4,7 +4,7 @@ echo $PATH
4export LC_ALL=C.UTF-8
4export LC_ALL=C.UTF-8
5GHCVER=`ghc --numeric-version`
5GHCVER=`ghc --numeric-version`
6
6
7−JSADDLE_VERSION=`head -n2 jsaddle.cabal | tail -n1 | sed 's/[^0-9.]//g'`
7+JSADDLE_WARP_VERSION=`head -n2 jsaddle-warp/jsaddle-warp.cabal | tail -n1 | sed 's/[^0-9.]//g'`
8
8
9if [[ -d .cabal && -d .ghc ]]; then
9if [[ -d .cabal && -d .ghc ]]; then
10 cp -a .cabal .ghc /root
10 cp -a .cabal .ghc /root
@@ -13,8 +13,8 @@ fi
13npm install ws
13npm install ws
14
14
15cabal update
15cabal update
16−cabal new-build 'jsaddle:lib:jsaddle' 'jsaddle:test:test-tool'
16+cabal new-build 'jsaddle-warp:lib:jsaddle-warp' 'jsaddle-warp:test:test-tool'
17−GHC_PACKAGE_PATH=/opt/ghc/$GHCVER/lib/ghc-$GHCVER/package.conf.d:~/.cabal/store/ghc-$GHCVER/package.db:./dist-newstyle/packagedb/ghc-$GHCVER jsaddle_datadir=`pwd` ./dist-newstyle/build/jsaddle-$JSADDLE_VERSION/build/test-tool/test-tool
17+GHC_PACKAGE_PATH=/opt/ghc/$GHCVER/lib/ghc-$GHCVER/package.conf.d:~/.cabal/store/ghc-$GHCVER/package.db:./dist-newstyle/packagedb/ghc-$GHCVER jsaddle_datadir=`pwd` ./dist-newstyle/build/jsaddle-warp-$JSADDLE_WARP_VERSION/build/test-tool/test-tool .
18
18
19# update the cache
19# update the cache
20rm -rf .cabal
20rm -rf .cabal