master..a28f95d · jsaddle

.travis.yml+24−40

since splitsnapshots

unifiedsplit

@@ -1,47 +1,31 @@

1−language: nix

1+sudo: required

2−nix: 2.2.2

2+services:

3+ - docker

3

4

4−jobs:

5+cache:

5− include:

6+ directories:

6− - stage: Build

7+ - .cabal

7− env: OS=linux GHCVER=ghc865

8+ - .ghc

8− - stage: Build

9− env: OS=linux GHCVER=ghc881

10− - env: OS=macos GHCVER=ghc865

11− os: osx

12− # Fix OSX, see https://travis-ci.community/t/cannot-use-nix-support-on-osx/2927

13− language: generic

14− before_install:

15− - curl https://nixos.org/nix/install | sh

16− - source /Users/travis/.nix-profile/etc/profile.d/nix.sh

17− - env: OS=macos GHCVER=ghc881

18− os: osx

19− # Fix OSX, see https://travis-ci.community/t/cannot-use-nix-support-on-osx/2927

20− language: generic

21− before_install:

22− - curl https://nixos.org/nix/install | sh

23− - source /Users/travis/.nix-profile/etc/profile.d/nix.sh

24

9

25−install:

10+env:

26−- sudo mkdir -p /etc/nix

11+# - CABALVER=1.24 GHCVER=7.10.3 OSVER=xenial

27−- echo "substituters = https://cache.nixos.org https://hydra.iohk.io" | sudo tee -a /etc/nix/nix.conf > /dev/null

12+ - CABALVER=1.24 GHCVER=8.0.1 OSVER=xenial

28−- echo "trusted-public-keys = cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY= hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ=" | sudo tee -a /etc/nix/nix.conf > /dev/null

13+ - CABALVER=1.24 GHCVER=8.0.2 OSVER=xenial

14+ - CABALVER=1.24 GHCVER=7.10.3 OSVER=trusty

15+ - CABALVER=1.24 GHCVER=8.0.1 OSVER=trusty

16+ - CABALVER=1.24 GHCVER=8.0.2 OSVER=trusty

29

17

30−script:

18+before_install:

31−- nix-build --argstr haskellCompiler $GHCVER -A hsPkgs.jsaddle.components.library

19+ - docker build -t ghc -f travis/$OSVER.Dockerfile travis

32−- nix-build --argstr haskellCompiler $GHCVER -A hsPkgs.jsaddle-warp.components.library

33−- nix-build --argstr haskellCompiler $GHCVER -A hsPkgs.jsaddle-clib.components.library

34−- |

35− if [ "$OS" == "macos" ]; then

36− nix-build --argstr haskellCompiler $GHCVER -A hsPkgs.jsaddle-wkwebview.components.library

37− fi

38−# TODO try to find how to get working webkitgtk with nix on macOS

39−- |

40− if [ "$OS" != "macos" ]; then

41− nix-build --argstr haskellCompiler $GHCVER -A hsPkgs.jsaddle-webkit2gtk.components.library

42− fi

43

20

21+script:

22+ - docker run -v `pwd`:/build ghc

23+ sh -x -c "

24+ apt-get install -y cabal-install-$CABALVER ghc-$GHCVER &&

25+ export PATH=\$HOME/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:/opt/alex/3.1.7/bin:/opt/happy/1.19.5/bin:\$PATH &&

26+ ./travis/build.sh"

44notifications:

27notifications:

45 irc:

28 irc:

46 channels: "irc.freenode.net#ghcjs"

29 channels: "irc.freenode.net#ghcjs"

30+ skip_join: true

47− email: true

31+ email: true

README.md+9−9

@@ -80,7 +80,7 @@ main = run 3708 $ do

80 appendChild newParagraph text

81 appendChild body (Just newParagraph)

82 return ()

83−

83+

84 -- Make an exit button

85 exitMVar <- liftIO newEmptyMVar

86 Just exit <- createElement doc (Just "span")

@@ -111,8 +111,8 @@ There are a number of different JSaddle runners to choose from

111* [jsaddle-clib](https://hackage.haskell.org/package/jsaddle-clib) - C interface used to run JSaddle on Android using JNI.

112

113In all of these cases a web control or browser of some sort is used. An

114−[HTML file](./jsaddle/src/Language/Javascript/JSaddle/Run/Files.hs#L24)

114+[HTML file](https://github.com/ghcjs/jsaddle/blob/master/data/index.html)

115−and a [small JavaScript command interpreter](./jsaddle/src/Language/Javascript/JSaddle/Run/Files.hs#L340)

115+and a [small JavaScript command interpreter](https://github.com/ghcjs/jsaddle/blob/master/data/jsaddle.js)

116are loaded into it. Then the native GHC compiled JSaddle code runs. In order to interact with the browser

117it sends commands to the JavaScript command interpreter. The mechanism for sending the commands differs

118for the different runners, but they are always combined into batches and encoded in JSON.

@@ -123,7 +123,7 @@ JavaScript thread until the Haskell callback completes) or asynchronous.

123### Why use a JavaScript command interpreter?

124

125Older versions of JSaddle relied on the WebKit1 interface to WebKitGTK and JavaScriptCore that is only supported in older versions of

126−WebKitGTK. With the newer WebKit2 interface this level of access is only available to WebKit Extensions.

126+WebKitGTK. With the newer WekKit2 interface this level of access is only available to WebKit Extensions.

127The general advice for people migrating from WebKit1 to WebKit2 seems to be to use JavaScript.

128

129As a bonus we have been able to support a number of different platforms with the JavaScript command interpreter and it should

@@ -137,8 +137,8 @@ The first five keys `[0..4]` are

137these values. Both the Haskell code and `jsaddle.js` can allocate new `JSVal` keys. The Haskell code allocates negative

138keys and `jsaddle.js` allocates positive keys to avoid clashing.

139

140−The haskell code will not know the value to go with the key, but it will include it in commands to the server

140+The haskell code will not know the value of the to go with the key, but it will include it in commands to the server

141−that are sort of "hey call this function and put the result in the map with this key"). This allows for the

141+that are sort of "hey call this function and and put the result in the map with this key"). This allows for the

142lazy execution of the JSaddle code.

143

144A finalizer is added on the Haskell code and an asynchronous `FreeJSVal` command is automatically sent to `jsaddle.js`

@@ -146,7 +146,7 @@ when the JSVal is no longer reachable. The `jsaddle.js` code then deletes the k

146

147### JSStrings

148

149−These are haskell `Text` type and so reside on the native side of the WebSocket. If you want to avoid transferring large string values over the WebSocket use `toJSVal` to convert it to a `JSVal`.

149+These are haskell `Text` type and so reside on the native side of the WebSocket. If you want to make avoid transferring large string values over the WebSocket use `toJSVal` to conevt it to a `JSVal`.

150

151### Lazy Execution

152

@@ -178,7 +178,7 @@ force all the pending asynchronous commands to be executed.

178It uses a handful of JS FFI calls to execute JavaScript functions indirectly. This indirection will be small compared to the overhead of the WebSockets approach (used when JSaddle is compiled with GHC), but it will be significant compared to hand crafted JS FFI calls.

179

180For the best performance you may want to write both JS FFI and JSaddle wrappers

181−for your JavaScript code. This is the approach taken by `ghcjs-dom`.

181+For your JavaScript code. This is the approach taken by `ghcjs-dom`.

182

183For instance here is `getElementById` from the `ghcjs-dom-jsffi` (used by `ghcjs-dom` when compiled with GHCJS)

184

@@ -213,7 +213,7 @@ JSaddle does not support exceptions well. When compiled with GHCJS an exception

213at the point the exception is thrown.

214

215When using GHC the Haskell executions will probably continue for a while before the exception is received at all by the Haskell code

216−(because the lazy execution of the JS code). The exception will be thrown when the next synchronous command is executed.

216+(because the lazy execution of the JS code). The exception will be thrown when the the next synchronous command is executed.

217When it reaches the synchronous command a haskell type JSException will be thrown (this may not be the thread that initiated the

218command that caused the exception). You can use `syncPoint` and `syncAfter` to force the exception to be thrown.

219There are `JSM` versions of `catch` and `bracket` that also include a `syncPoint` call.

cabal.project+35−3

@@ -1,10 +1,42 @@

1+flags: -overloaded-methods -overloaded-signals -overloaded-properties

2+

1packages:

3packages:

2 jsaddle/

4 jsaddle/

3 jsaddle-warp/

5 jsaddle-warp/

4 jsaddle-wkwebview/

6 jsaddle-wkwebview/

7+-- jsaddle-webkitgtk/

5 jsaddle-webkit2gtk/

8 jsaddle-webkit2gtk/

6 jsaddle-clib/

9 jsaddle-clib/

7

10

8−constraints: haskell-gi-overloading == 0.0

11+package gi-atk

9−

12+ flags: -overloaded-methods -overloaded-signals -overloaded-properties

10−allow-newer: websockets:random, splitmix:time, *:time, *:unix, *:process, stm:base

13+package gi-cairo

14+ flags: -overloaded-methods -overloaded-signals -overloaded-properties

15+package gi-gdk

16+ flags: -overloaded-methods -overloaded-signals -overloaded-properties

17+package gi-gdkpixbuf

18+ flags: -overloaded-methods -overloaded-signals -overloaded-properties

19+package gi-gio

20+ flags: -overloaded-methods -overloaded-signals -overloaded-properties

21+package gi-glib

22+ flags: -overloaded-methods -overloaded-signals -overloaded-properties

23+package gi-gobject

24+ flags: -overloaded-methods -overloaded-signals -overloaded-properties

25+package gi-gtk

26+ flags: -overloaded-methods -overloaded-signals -overloaded-properties

27+package gi-gtk-hs

28+ flags: -overloaded-methods -overloaded-signals -overloaded-properties

29+package gi-gtkosxapplication

30+ flags: -overloaded-methods -overloaded-signals -overloaded-properties

31+package gi-gtksource

32+ flags: -overloaded-methods -overloaded-signals -overloaded-properties

33+package gi-javascriptcore

34+ flags: -overloaded-methods -overloaded-signals -overloaded-properties

35+package gi-pango

36+ flags: -overloaded-methods -overloaded-signals -overloaded-properties

37+package gi-soup

38+ flags: -overloaded-methods -overloaded-signals -overloaded-properties

39+package gi-webkit

40+ flags: -overloaded-methods -overloaded-signals -overloaded-properties

41+package gi-webkit2

42+ flags: -overloaded-methods -overloaded-signals -overloaded-properties

default.nixnew file+8

@@ -0,0 +1,8 @@

1+haskellPackages: {

2+ jsaddle = haskellPackages.callPackage ./jsaddle {};

3+ jsaddle-warp = haskellPackages.callPackage ./jsaddle-warp {};

4+ jsaddle-wkwebview = haskellPackages.callPackage ./jsaddle-wkwebview {};

5+ jsaddle-webkit2gtk = haskellPackages.callPackage ./jsaddle-webkit2gtk {};

6+ jsaddle-webkitgtk = haskellPackages.callPackage ./jsaddle-webkitgtk {};

7+ jsaddle-clib = haskellPackages.callPackage ./jsaddle-clib {};

8+}

jsaddle-clib/default.nixnew file+9

@@ -0,0 +1,9 @@

1+{ mkDerivation, aeson, base, bytestring, data-default, jsaddle, stdenv, text }:

2+mkDerivation {

3+ pname = "jsaddle-clib";

4+ version = "0.9.0.0";

5+ src = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [ ".git" "dist" ])) ./.;

6+ libraryHaskellDepends = [ aeson base bytestring data-default jsaddle text ];

7+ description = "Interface for JavaScript that works with GHCJS and GHC";

8+ license = stdenv.lib.licenses.mit;

9+}

jsaddle-clib/jsaddle-clib.cabal+3−4

@@ -1,5 +1,5 @@

1name: jsaddle-clib

2−version: 0.9.8.0

2+version: 0.9.0.0

3cabal-version: >=1.10

4build-type: Simple

5license: MIT

@@ -21,9 +21,8 @@ library

21 Language.Javascript.JSaddle.CLib

22 Language.Javascript.JSaddle.CLib.Internal

23 build-depends:

24− aeson >=0.8.0.2 && <1.6,

24+ aeson >=0.8.0.2 && <1.3,

25 base <5,

26− base-compat >=0.9.0 && <0.12,

27 bytestring >=0.10.6.0 && <0.11,

26 bytestring >=0.10.6.0 && <0.11,

28 jsaddle >= 0.9.0.0 && <0.10,

27 jsaddle >= 0.9.0.0 && <0.10,

29 data-default,

28 data-default,

@@ -33,7 +32,7 @@ library

33 Include-dirs: cbits/include

32 Include-dirs: cbits/include

34 Includes: jsaddle.h

33 Includes: jsaddle.h

35 Install-includes: jsaddle.h

34 Install-includes: jsaddle.h

36− ghc-options: -ferror-spans -Wall

35+ ghc-options: -ferror-spans -Wall -Werror

37 if impl(ghcjs)

36 if impl(ghcjs)

38 hs-source-dirs: src-ghcjs

37 hs-source-dirs: src-ghcjs

39 else

38 else

jsaddle-clib/src-ghc/Language/Javascript/JSaddle/CLib.hs+1−3

@@ -8,9 +8,6 @@ module Language.Javascript.JSaddle.CLib

8 , appConfigToAppCallbacks

9 ) where

10

11−import Prelude ()

12−import Prelude.Compat

13−

14import Control.Monad (void)

11import Control.Monad (void)

15import Control.Concurrent (forkIO)

12import Control.Concurrent (forkIO)

16

13

@@ -19,6 +16,7 @@ import Data.ByteString (useAsCString, packCString)

19import Data.ByteString.Char8 (unpack)

16import Data.ByteString.Char8 (unpack)

20import Data.ByteString.Lazy (ByteString, toStrict, fromStrict)

17import Data.ByteString.Lazy (ByteString, toStrict, fromStrict)

21import Data.Default (def, Default)

18import Data.Default (def, Default)

19+import Data.Monoid ((<>))

22import Data.Text (Text)

20import Data.Text (Text)

23import qualified Data.Text.Encoding as T

21import qualified Data.Text.Encoding as T

24

22

jsaddle-warp/default.nixnew file+25

@@ -0,0 +1,25 @@

1+{ mkDerivation, aeson, base, bytestring, containers, deepseq

2+, doctest, filepath, foreign-store, ghc-prim, http-types, jsaddle

3+, lens, network, primitive, process, QuickCheck, ref-tf, stdenv

4+, stm, text, time, transformers, uuid, uuid-types, wai

5+, wai-websockets, warp, webdriver, websockets

6+}:

7+mkDerivation {

8+ pname = "jsaddle-warp";

9+ version = "0.9.4.0";

10+ src = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [ ".git" "dist" ])) ./.;

11+ libraryHaskellDepends = [

12+ aeson base bytestring containers foreign-store http-types jsaddle

13+ stm text time transformers uuid uuid-types wai wai-websockets warp

14+ websockets

15+ ];

16+ testHaskellDepends = [

17+ aeson base bytestring containers deepseq doctest filepath ghc-prim

18+ http-types jsaddle lens network primitive process QuickCheck ref-tf

19+ stm text time transformers wai wai-websockets warp webdriver

20+ websockets

21+ ];

22+ testTarget = "--test-option=${jsaddle.src}";

23+ description = "Interface for JavaScript that works with GHCJS and GHC";

24+ license = stdenv.lib.licenses.mit;

25+}

jsaddle-warp/jsaddle-warp.cabal+10−16

@@ -1,5 +1,5 @@

1name: jsaddle-warp

2−version: 0.9.8.0

2+version: 0.9.5.0

3cabal-version: >=1.10

4build-type: Simple

5license: MIT

@@ -10,7 +10,7 @@ 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 JavaScript helper.

13+ drive a small JavaScipt helper.

14category: Web, Javascript

15author: Hamish Mackenzie

16

@@ -24,22 +24,20 @@ library

24 if !impl(ghcjs -any)

25 exposed-modules:

26 Language.Javascript.JSaddle.WebSockets

27− other-modules:

28− Language.Javascript.JSaddle.WebSockets.Compat

29 build-depends:

27 build-depends:

30− aeson >=0.8.0.2 && <1.6,

28+ aeson >=0.8.0.2 && <1.3,

31 bytestring >=0.10.6.0 && <0.11,

29 bytestring >=0.10.6.0 && <0.11,

32− containers >=0.5.6.2 && <0.7,

30+ containers >=0.5.6.2 && <0.6,

33 foreign-store >=0.2 && <0.3,

31 foreign-store >=0.2 && <0.3,

34− http-types >=0.8.6 && <0.13,

32+ http-types >=0.8.6 && <0.12,

35 jsaddle >=0.9.4.0 && <0.10,

33 jsaddle >=0.9.4.0 && <0.10,

36− stm >=2.4.4 && <2.6,

34+ stm >=2.4.4 && <2.5,

37 text >=1.2.1.3 && <1.3,

35 text >=1.2.1.3 && <1.3,

38− time >=1.5.0.1 && <1.11,

36+ time >=1.5.0.1 && <1.9,

39 transformers >=0.4.2.0 && <0.6,

37 transformers >=0.4.2.0 && <0.6,

40 wai >=3.0.3.0 && <3.3,

38 wai >=3.0.3.0 && <3.3,

41 wai-websockets >=3.0.0.6 && <3.1,

39 wai-websockets >=3.0.0.6 && <3.1,

42− warp >=3.1.2 && <3.4,

40+ warp >=3.1.2 && <3.3,

43 websockets >=0.9.5.0 && <0.13

41 websockets >=0.9.5.0 && <0.13

44 exposed-modules:

42 exposed-modules:

45 Language.Javascript.JSaddle.Warp

43 Language.Javascript.JSaddle.Warp

@@ -59,10 +57,8 @@ test-suite test-tool

59 bytestring -any,

57 bytestring -any,

60 containers -any,

58 containers -any,

61 deepseq -any,

59 deepseq -any,

62− doctest >=0.10.1 && <0.19,

60+ doctest >=0.10.1 && <0.12,

63− exceptions -any,

64 filepath >=1.4.0.0 && <1.5,

61 filepath >=1.4.0.0 && <1.5,

65− foreign-store -any,

66 ghc-prim -any,

62 ghc-prim -any,

67 http-types -any,

63 http-types -any,

68 jsaddle -any,

64 jsaddle -any,

@@ -72,16 +68,14 @@ test-suite test-tool

72 ref-tf -any,

68 ref-tf -any,

73 primitive -any,

69 primitive -any,

74 process >=1.2.3.0 && <1.7,

70 process >=1.2.3.0 && <1.7,

75− random -any,

76 stm -any,

71 stm -any,

77 text -any,

72 text -any,

78 time -any,

73 time -any,

79 transformers -any,

74 transformers -any,

80− unliftio-core -any,

81 wai -any,

75 wai -any,

82 wai-websockets -any,

76 wai-websockets -any,

83 warp -any,

77 warp -any,

84− webdriver >=0.8.4 && <0.10,

78+ webdriver >=0.8.4 && <0.9,

85 websockets -any

79 websockets -any

86 type: exitcode-stdio-1.0

80 type: exitcode-stdio-1.0

87 main-is: DocTest.hs

81 main-is: DocTest.hs

jsaddle-warp/src/Language/Javascript/JSaddle/Test.hs+12−13

@@ -17,22 +17,21 @@ module Language.Javascript.JSaddle.Test (

17 , listWindowProperties

18) where

19

20−import Prelude hiding((!!), catch)

21import Control.Applicative

20import Control.Applicative

22−import Control.Concurrent (threadDelay, forkIO, ThreadId)

21+import Prelude hiding((!!), catch)

23−import Control.Concurrent.MVar

24− (tryTakeMVar, putMVar, takeMVar, newEmptyMVar, MVar)

25−import Control.Lens.Getter ((^.))

26−import Control.Monad (forever, forM)

27−import Control.Monad.IO.Class (MonadIO(..))

28import Control.Monad.Trans.Reader (runReaderT)

22import Control.Monad.Trans.Reader (runReaderT)

23+import Language.Javascript.JSaddle

24+import qualified Data.Text as T

25+import Control.Monad.IO.Class (MonadIO(..))

26+import Control.Monad (forever, forM)

27+import Control.Lens.Getter ((^.))

29import Data.Monoid ((<>))

28import Data.Monoid ((<>))

29+import Control.Concurrent.MVar

30+ (tryTakeMVar, putMVar, takeMVar, newEmptyMVar, MVar)

31+import System.IO.Unsafe (unsafePerformIO)

32+import Control.Concurrent (threadDelay, forkIO, ThreadId)

30import Data.Text (Text)

33import Data.Text (Text)

31−import qualified Data.Text as T

32−import Language.Javascript.JSaddle

33import Language.Javascript.JSaddle.Warp (run)

34import Language.Javascript.JSaddle.Warp (run)

34−import System.IO.Unsafe (unsafePerformIO)

35−import System.Timeout (timeout)

36

35

37context :: MVar JSContextRef

36context :: MVar JSContextRef

38context = unsafePerformIO newEmptyMVar

37context = unsafePerformIO newEmptyMVar

@@ -53,12 +52,12 @@ startServer =

53

52

54-- >>> testJSaddle $ ((global ^. js "console" . js "log") # ["Hello"])

53-- >>> testJSaddle $ ((global ^. js "console" . js "log") # ["Hello"])

55testJSaddle :: ToJSVal val => JSM val -> IO ()

54testJSaddle :: ToJSVal val => JSM val -> IO ()

56−testJSaddle f = timeout 10000000 (do

55+testJSaddle f = do

57 startServer

56 startServer

58 c <- takeMVar context

57 c <- takeMVar context

59 runReaderT (unJSM $ (f >>= valToText >>= liftIO . putStrLn . T.unpack)

58 runReaderT (unJSM $ (f >>= valToText >>= liftIO . putStrLn . T.unpack)

60 `catch` \ (JSException e) -> valToText e >>= liftIO . putStrLn . T.unpack) c

59 `catch` \ (JSException e) -> valToText e >>= liftIO . putStrLn . T.unpack) c

61− putMVar context c) >>= maybe (putStrLn "testJSaddle timed out") return

60+ putMVar context c

62

61

63debugLog :: String -> IO ()

62debugLog :: String -> IO ()

64debugLog _ = return ()

63debugLog _ = return ()

jsaddle-warp/src/Language/Javascript/JSaddle/WebSockets.hs+32−78

@@ -19,13 +19,9 @@ module Language.Javascript.JSaddle.WebSockets (

19 jsaddleOr

20 , jsaddleApp

21 , jsaddleWithAppOr

22− , jsaddleAppWithJs

23− , jsaddleAppWithJsOr

24 , jsaddleAppPartial

22 , jsaddleAppPartial

25 , jsaddleJs

23 , jsaddleJs

26− , jsaddleJs'

27 , debug

24 , debug

28− , debugOr

29 , debugWrapper

25 , debugWrapper

30) where

26) where

31

27

@@ -60,57 +56,44 @@ import qualified Data.Map as M (empty, insert, lookup)

60import Data.IORef

56import Data.IORef

61 (readIORef, newIORef, atomicModifyIORef')

57 (readIORef, newIORef, atomicModifyIORef')

62import Data.ByteString.Lazy (ByteString)

58import Data.ByteString.Lazy (ByteString)

63−import qualified Data.ByteString.Lazy as LBS

64− (toStrict, stripPrefix)

65import Control.Concurrent.MVar

59import Control.Concurrent.MVar

66 (tryTakeMVar, MVar, tryPutMVar, modifyMVar_, putMVar, takeMVar,

60 (tryTakeMVar, MVar, tryPutMVar, modifyMVar_, putMVar, takeMVar,

67 readMVar, newMVar, newEmptyMVar, modifyMVar)

61 readMVar, newMVar, newEmptyMVar, modifyMVar)

68import Network.Wai.Handler.Warp

62import Network.Wai.Handler.Warp

69 (defaultSettings, setTimeout, setPort, runSettings)

63 (defaultSettings, setTimeout, setPort, runSettings)

70−import Foreign.Store (readStore, lookupStore, writeStore, Store(..))

64+import Foreign.Store (newStore, readStore, lookupStore)

71import Language.Javascript.JSaddle (askJSM)

65import Language.Javascript.JSaddle (askJSM)

72import Control.Monad.IO.Class (MonadIO(..))

66import Control.Monad.IO.Class (MonadIO(..))

73

67

74import Language.Javascript.JSaddle.WebSockets.Compat (getTextMessageByteString)

68import Language.Javascript.JSaddle.WebSockets.Compat (getTextMessageByteString)

75−import qualified Data.Text.Encoding as T (decodeUtf8)

76

69

77jsaddleOr :: ConnectionOptions -> JSM () -> Application -> IO Application

70jsaddleOr :: ConnectionOptions -> JSM () -> Application -> IO Application

78jsaddleOr opts entryPoint otherApp = do

71jsaddleOr opts entryPoint otherApp = do

79 syncHandlers <- newIORef M.empty

72 syncHandlers <- newIORef M.empty

80− asyncHandlers <- newIORef M.empty

81 let wsApp :: ServerApp

73 let wsApp :: ServerApp

82 wsApp pending_conn = do

74 wsApp pending_conn = do

83 conn <- acceptRequest pending_conn

75 conn <- acceptRequest pending_conn

84− initMsg <- receiveDataMessage conn

85− case getTextMessageByteString initMsg of

86− Just "" -> do

87− rec (processResult, processSyncResult, start) <- runJavaScript (sendTextData conn . encode) $ do

76+ rec (processResult, processSyncResult, start) <- runJavaScript (sendTextData conn . encode) $ do

88− syncKey <- T.pack . show . contextId <$> askJSM

77+ syncKey <- T.pack . show . contextId <$> askJSM

89− liftIO $ atomicModifyIORef' syncHandlers (\m -> (M.insert syncKey processSyncResult m, ()))

78+ liftIO $ atomicModifyIORef' syncHandlers (\m -> (M.insert syncKey processSyncResult m, ()))

90− liftIO $ atomicModifyIORef' asyncHandlers (\m -> (M.insert syncKey processResult m, ()))

91− liftIO $ sendTextData conn (encode syncKey)

79+ liftIO $ sendTextData conn (encode syncKey)

92− entryPoint

80+ entryPoint

93− start

94− waitTillClosed conn

95− Just syncKey ->

96− M.lookup (T.decodeUtf8 $ LBS.toStrict syncKey) <$> readIORef syncHandlers >>= \case

97− Nothing -> error "jsaddle missing sync message handler"

98− Just processResult ->

99− forever $

81+ _ <- forkIO . forever $

100− receiveDataMessage conn >>= \msg -> case getTextMessageByteString msg of

82+ receiveDataMessage conn >>= \msg -> case getTextMessageByteString msg of

101− Just t ->

83+ Just t ->

102− case decode t of

84+ case decode t of

103− Nothing -> error $ "jsaddle Results decode failed : " <> show t

85+ Nothing -> error $ "jsaddle Results decode failed : " <> show t

104− Just r -> processResult r

86+ Just r -> processResult r

105− _ -> error "jsaddle WebSocket unexpected binary data"

87+ _ -> error "jsaddle WebSocket unexpected binary data"

106− _ -> error "jsaddle WebSocket unexpected binary data"

88+ start

89+ waitTillClosed conn

107

90

108 -- Based on Network.WebSocket.forkPingThread

91 -- Based on Network.WebSocket.forkPingThread

109 waitTillClosed conn = ignore `handle` go 1

92 waitTillClosed conn = ignore `handle` go 1

110 where

93 where

111 go :: Int -> IO ()

94 go :: Int -> IO ()

112 go i = do

95 go i = do

113− threadDelay (10 * 1000 * 1000)

96+ threadDelay (1 * 1000 * 1000)

114 sendPing conn (T.pack $ show i)

97 sendPing conn (T.pack $ show i)

115 go (i + 1)

98 go (i + 1)

116

99

@@ -143,14 +126,9 @@ jsaddleApp = jsaddleAppWithJs $ jsaddleJs False

143

126

144jsaddleAppWithJs :: ByteString -> Application

127jsaddleAppWithJs :: ByteString -> Application

145jsaddleAppWithJs js req sendResponse =

128jsaddleAppWithJs js req sendResponse =

146− jsaddleAppWithJsOr js

129+ fromMaybe

147− (\_ _ -> sendResponse $ W.responseLBS H.status403 [("Content-Type", "text/plain")] "Forbidden")

130+ (sendResponse $ W.responseLBS H.status403 [("Content-Type", "text/plain")] "Forbidden")

148− req sendResponse

149−

150−jsaddleAppWithJsOr :: ByteString -> Application -> Application

151−jsaddleAppWithJsOr js otherApp req sendResponse =

152− fromMaybe (otherApp req sendResponse)

153− (jsaddleAppPartialWithJs js req sendResponse)

131+ (jsaddleAppPartialWithJs js req sendResponse)

154

132

155jsaddleWithAppOr :: ConnectionOptions -> JSM () -> Application -> IO Application

133jsaddleWithAppOr :: ConnectionOptions -> JSM () -> Application -> IO Application

156jsaddleWithAppOr opts entryPoint otherApp = jsaddleOr opts entryPoint $ \req sendResponse ->

134jsaddleWithAppOr opts entryPoint otherApp = jsaddleOr opts entryPoint $ \req sendResponse ->

@@ -169,49 +147,32 @@ jsaddleAppPartialWithJs js req sendResponse = case (W.requestMethod req, W.pathI

169 ("GET", ["jsaddle.js"]) -> Just $ sendResponse $ W.responseLBS H.status200 [("Content-Type", "application/javascript")] js

147 ("GET", ["jsaddle.js"]) -> Just $ sendResponse $ W.responseLBS H.status200 [("Content-Type", "application/javascript")] js

170 _ -> Nothing

148 _ -> Nothing

171

149

172−jsaddleJs :: Bool -> ByteString

173−jsaddleJs = jsaddleJs' Nothing

174−

175-- Use this to generate this string for embedding

150-- Use this to generate this string for embedding

176-- sed -e 's|\\|\\\\|g' -e 's|^| \\|' -e 's|$|\\n\\|' -e 's|"|\\"|g' data/jsaddle.js | pbcopy

151-- sed -e 's|\\|\\\\|g' -e 's|^| \\|' -e 's|$|\\n\\|' -e 's|"|\\"|g' data/jsaddle.js | pbcopy

177−jsaddleJs' :: Maybe ByteString -> Bool -> ByteString

152+jsaddleJs :: Bool -> ByteString

178−jsaddleJs' jsaddleUri refreshOnLoad = "\

153+jsaddleJs refreshOnLoad = "\

179− \if(typeof global !== \"undefined\" && typeof require === \"function\") {\n\

154+ \if(typeof global !== \"undefined\") {\n\

180 \ global.window = global;\n\

155 \ global.window = global;\n\

181 \ global.WebSocket = require('ws');\n\

156 \ global.WebSocket = require('ws');\n\

182 \}\n\

157 \}\n\

183 \\n\

158 \\n\

184 \var connect = function() {\n\

159 \var connect = function() {\n\

185− \ var wsaddress = "

186− <> maybe "window.location.protocol.replace('http', 'ws')+\"//\"+window.location.hostname+(window.location.port?(\":\"+window.location.port):\"\")"

160+ \ var wsaddress = window.location.protocol.replace('http', 'ws')+\"//\"+window.location.hostname+(window.location.port?(\":\"+window.location.port):\"\");\n\

187− (\ s -> "\"ws" <> s <> "\"")

188− (jsaddleUri >>= LBS.stripPrefix "http")

189− <> ";\n\

190 \\n\

161 \\n\

191− \ var ws0 = new WebSocket(wsaddress);\n\

162+ \ var ws = new WebSocket(wsaddress);\n\

192 \ var syncKey = \"\";\n\

163 \ var syncKey = \"\";\n\

193 \\n\

164 \\n\

194− \ ws0.onopen = function(e) {\n\

165+ \ ws.onopen = function(e) {\n\

195− \ ws0.send(\"\");\n\

196− \ var initialResults = [];\n\

197− \ var ws = {send: function(m) {initialResults.push(m);}};\n\

198 \ " <> initState <> "\n\

166 \ " <> initState <> "\n\

199 \\n\

167 \\n\

200− \ ws0.onmessage = function(e) {\n\

168+ \ ws.onmessage = function(e) {\n\

201 \ var batch = JSON.parse(e.data);\n\

169 \ var batch = JSON.parse(e.data);\n\

202 \ if(inCallback > 0) {\n\

170 \ if(inCallback > 0) {\n\

203 \ asyncBatch = batch;\n\

171 \ asyncBatch = batch;\n\

204 \ return;\n\

172 \ return;\n\

205 \ }\n\

173 \ }\n\

206 \ if(typeof batch === \"string\") {\n\

174 \ if(typeof batch === \"string\") {\n\

207− \ syncKey = batch;\n\

175+ \ syncKey = batch;\n" <>

208− \ var ws1 = new WebSocket(wsaddress);\n\

209− \ ws1.onopen = function(e) {\n\

210− \ ws1.send(syncKey);\n\

211− \ initialResults.forEach(function(m){ ws1.send(m); });\n\

212− \ initialResults = null;\n\

213− \ ws = ws1;\n\

214− \ }\n" <>

215 (if refreshOnLoad

176 (if refreshOnLoad

216 then " var xhr = new XMLHttpRequest();\n\

177 then " var xhr = new XMLHttpRequest();\n\

217 \ xhr.open('POST', '/reload/'+syncKey, true);\n\

178 \ xhr.open('POST', '/reload/'+syncKey, true);\n\

@@ -227,13 +188,13 @@ jsaddleJs' jsaddleUri refreshOnLoad = "\

227 \ " <> runBatch (\a -> "ws.send(JSON.stringify(" <> a <> "));")

188 \ " <> runBatch (\a -> "ws.send(JSON.stringify(" <> a <> "));")

228 (Just (\a -> "(function(){\n\

189 (Just (\a -> "(function(){\n\

229 \ var xhr = new XMLHttpRequest();\n\

190 \ var xhr = new XMLHttpRequest();\n\

230− \ xhr.open('POST', '" <> fromMaybe "" jsaddleUri <> "/sync/'+syncKey, false);\n\

191+ \ xhr.open('POST', '/sync/'+syncKey, false);\n\

231 \ xhr.setRequestHeader(\"Content-type\", \"application/json\");\n\

192 \ xhr.setRequestHeader(\"Content-type\", \"application/json\");\n\

232 \ xhr.send(JSON.stringify(" <> a <> "));\n\

193 \ xhr.send(JSON.stringify(" <> a <> "));\n\

233 \ return JSON.parse(xhr.response);})()")) <> "\

194 \ return JSON.parse(xhr.response);})()")) <> "\

234 \ };\n\

195 \ };\n\

235 \ };\n\

196 \ };\n\

236− \ ws0.onerror = function() {\n\

197+ \ ws.onerror = function() {\n\

237 \ setTimeout(connect, 1000);\n\

198 \ setTimeout(connect, 1000);\n\

238 \ };\n\

199 \ };\n\

239 \}\n\

200 \}\n\

@@ -252,13 +213,6 @@ debug port f = do

252 jsaddleOr defaultConnectionOptions (registerContext >> f >> syncPoint) (withRefresh $ jsaddleAppWithJs $ jsaddleJs True)

213 jsaddleOr defaultConnectionOptions (registerContext >> f >> syncPoint) (withRefresh $ jsaddleAppWithJs $ jsaddleJs True)

253 putStrLn $ "<a href=\"http://localhost:" <> show port <> "\">run</a>"

214 putStrLn $ "<a href=\"http://localhost:" <> show port <> "\">run</a>"

254

215

255−debugOr :: Int -> JSM () -> Application -> IO ()

256−debugOr port f b = do

257− debugWrapper $ \withRefresh registerContext ->

258− runSettings (setPort port (setTimeout 3600 defaultSettings)) =<<

259− jsaddleOr defaultConnectionOptions (registerContext >> f >> syncPoint) (withRefresh $ jsaddleAppWithJsOr (jsaddleJs True) b)

260− putStrLn $ "<a href=\"http://localhost:" <> show port <> "\">run</a>"

261−

262refreshMiddleware :: ((Response -> IO ResponseReceived) -> IO ResponseReceived) -> Middleware

216refreshMiddleware :: ((Response -> IO ResponseReceived) -> IO ResponseReceived) -> Middleware

263refreshMiddleware refresh otherApp req sendResponse = case (W.requestMethod req, W.pathInfo req) of

217refreshMiddleware refresh otherApp req sendResponse = case (W.requestMethod req, W.pathInfo req) of

264 ("POST", ["reload", _syncKey]) -> refresh sendResponse

218 ("POST", ["reload", _syncKey]) -> refresh sendResponse

@@ -307,13 +261,13 @@ debugWrapper run = do

307 start' <- takeMVar mvar

261 start' <- takeMVar mvar

308 n <- stop

262 n <- stop

309 start' n >>= restarter mvar

263 start' n >>= restarter mvar

310− lookupStore storeId >>= \case

264+ lookupStore shutdown_0 >>= \case

311 Nothing -> do

265 Nothing -> do

312 restartMVar <- newMVar start

266 restartMVar <- newMVar start

313 void . forkIO $ restarter restartMVar (return 0)

267 void . forkIO $ restarter restartMVar (return 0)

314− void $ writeStore (Store storeId) restartMVar

268+ void $ newStore restartMVar

315 Just shutdownStore -> do

269 Just shutdownStore -> do

316 restartMVar :: MVar (Int -> IO (IO Int)) <- readStore shutdownStore

270 restartMVar :: MVar (Int -> IO (IO Int)) <- readStore shutdownStore

317 void $ tryTakeMVar restartMVar

271 void $ tryTakeMVar restartMVar

318 putMVar restartMVar start

272 putMVar restartMVar start

319− where storeId = 354

273+ where shutdown_0 = 0

jsaddle-warp/tests/DocTest.hs+7−20

@@ -11,17 +11,18 @@ import System.IO (stderr, BufferMode(..), stdout, hSetBuffering)

11import System.FilePath ((</>))

12import System.Exit (exitFailure, exitWith, ExitCode(..))

13import System.Process (readProcess, system)

14−import Control.Concurrent

14+import Control.Concurrent (forkIO)

15− (takeMVar, newEmptyMVar, forkIO, threadDelay, putMVar)

16import Control.Monad (void)

15import Control.Monad (void)

17import Control.Monad.IO.Class (MonadIO(..))

16import Control.Monad.IO.Class (MonadIO(..))

18import Data.Monoid ((<>))

17import Data.Monoid ((<>))

19import System.Environment (getArgs)

18import System.Environment (getArgs)

19+import Language.Javascript.JSaddle.Run.Files (jsaddleJs)

20+import qualified Data.ByteString.Lazy.Char8 as BS (unpack)

20import Test.WebDriver (runSession, defaultConfig, openPage, closeSession)

21import Test.WebDriver (runSession, defaultConfig, openPage, closeSession)

21

22

22main :: IO ()

23main :: IO ()

23main = do

24main = do

24− putStrLn "Testing JSaddle"

25+ putStrLn "Hello"

25 jsaddlePath <- getArgs >>= \case

26 jsaddlePath <- getArgs >>= \case

26 [arg] -> return arg

27 [arg] -> return arg

27 _ -> do

28 _ -> do

@@ -29,18 +30,14 @@ main = do

29 exitFailure

30 exitFailure

30 hSetBuffering stdout LineBuffering

31 hSetBuffering stdout LineBuffering

31 hSetBuffering stderr LineBuffering

32 hSetBuffering stderr LineBuffering

32− putStrLn "Checking for phantomjs"

33 node <- system "phantomjs --version" >>= \case

34 ExitSuccess -> return ()

35 e -> do

36 putStrLn "phantomjs not found"

37 exitWith e

38− putStrLn "Starting phantomjs"

39− forkIO . void $ readProcess "phantomjs" ["--webdriver=4444"] "" >>= putStr

38+ forkIO . void $ readProcess "phantomjs" ["--webdriver=4444"] (BS.unpack jsaddleJs) >>= putStr

40− threadDelay 5000000

39+ runSession defaultConfig $ do

41− putStrLn "Running Tests"

40+ openPage "http://localhost:3709"

42− done <- newEmptyMVar

43− forkIO $ do

44 liftIO $ doctest [

41 liftIO $ doctest [

45 "-hide-all-packages",

42 "-hide-all-packages",

46 "-package=base-" ++ VERSION_base,

43 "-package=base-" ++ VERSION_base,

@@ -64,10 +61,6 @@ main = do

64 "-package=ref-tf-" ++ VERSION_ref_tf,

61 "-package=ref-tf-" ++ VERSION_ref_tf,

65 "-package=deepseq-" ++ VERSION_deepseq,

62 "-package=deepseq-" ++ VERSION_deepseq,

66 "-package=ghc-prim-" ++ VERSION_ghc_prim,

63 "-package=ghc-prim-" ++ VERSION_ghc_prim,

67− "-package=exceptions-" ++ VERSION_exceptions,

68− "-package=unliftio-core-" ++ VERSION_unliftio_core,

69− "-package=random-" ++ VERSION_random,

70− "-package=foreign-store-" ++ VERSION_foreign_store,

71 "-i" <> "src",

64 "-i" <> "src",

72 "-i" <> "src-ghc",

65 "-i" <> "src-ghc",

73 "src/Language/Javascript/JSaddle/Test.hs",

66 "src/Language/Javascript/JSaddle/Test.hs",

@@ -90,7 +83,6 @@ main = do

90 jsaddlePath </> "src/Language/Javascript/JSaddle/Arguments.hs",

83 jsaddlePath </> "src/Language/Javascript/JSaddle/Arguments.hs",

91 jsaddlePath </> "src/Language/Javascript/JSaddle/Classes.hs",

84 jsaddlePath </> "src/Language/Javascript/JSaddle/Classes.hs",

92 jsaddlePath </> "src/Language/Javascript/JSaddle/Classes/Internal.hs",

85 jsaddlePath </> "src/Language/Javascript/JSaddle/Classes/Internal.hs",

93− jsaddlePath </> "src/Language/Javascript/JSaddle/Debug.hs",

94 jsaddlePath </> "src/Language/Javascript/JSaddle/Evaluate.hs",

86 jsaddlePath </> "src/Language/Javascript/JSaddle/Evaluate.hs",

95 jsaddlePath </> "src/Language/Javascript/JSaddle/Exception.hs",

87 jsaddlePath </> "src/Language/Javascript/JSaddle/Exception.hs",

96 jsaddlePath </> "src/Language/Javascript/JSaddle/Monad.hs",

88 jsaddlePath </> "src/Language/Javascript/JSaddle/Monad.hs",

@@ -104,9 +96,4 @@ main = do

104 jsaddlePath </> "src/Language/Javascript/JSaddle/String.hs",

96 jsaddlePath </> "src/Language/Javascript/JSaddle/String.hs",

105 jsaddlePath </> "src/Language/Javascript/JSaddle/Types.hs",

97 jsaddlePath </> "src/Language/Javascript/JSaddle/Types.hs",

106 jsaddlePath </> "src/Language/Javascript/JSaddle/Value.hs" ]

98 jsaddlePath </> "src/Language/Javascript/JSaddle/Value.hs" ]

107− putMVar done ()

108− threadDelay 5000000

109− runSession defaultConfig $ do

110− openPage "http://127.0.0.1:3709"

111− liftIO $ takeMVar done

112 closeSession

99 closeSession

jsaddle-webkit2gtk/default.nixnew file+16

@@ -0,0 +1,16 @@

1+{ mkDerivation, aeson, base, bytestring, directory, gi-gio, gi-glib

2+, gi-gtk, gi-javascriptcore, gi-webkit2, haskell-gi-base, jsaddle

3+, stdenv, text, unix, webkit2gtk3-javascriptcore

4+}:

5+mkDerivation {

6+ pname = "jsaddle-webkit2gtk";

7+ version = "0.9.4.0";

8+ src = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [ ".git" "dist" ])) ./.;

9+ libraryHaskellDepends = [

10+ aeson base bytestring directory gi-gio gi-glib gi-gtk

11+ gi-javascriptcore gi-webkit2 haskell-gi-base jsaddle text unix

12+ webkit2gtk3-javascriptcore

13+ ];

14+ description = "Interface for JavaScript that works with GHCJS and GHC";

15+ license = stdenv.lib.licenses.mit;

16+}

jsaddle-webkit2gtk/jsaddle-webkit2gtk.cabal+4−4

@@ -1,5 +1,5 @@

1name: jsaddle-webkit2gtk

2−version: 0.9.8.0

2+version: 0.9.4.0

3cabal-version: >=1.10

4build-type: Simple

5license: MIT

@@ -26,7 +26,7 @@ library

26 base <5

27 if !impl(ghcjs -any)

28 build-depends:

29− aeson >=0.8.0.2 && <1.6,

29+ aeson >=0.8.0.2 && <1.3,

30 base <5,

31 bytestring >=0.10.6.0 && <0.11,

32 directory >=1.0.0.2 && <1.4,

@@ -35,8 +35,8 @@ library

35 gi-gtk >=3.0.17 && <3.1,

36 gi-webkit2 >=4.0.14 && <4.1,

37 gi-javascriptcore >=4.0.14 && <4.1,

38− haskell-gi-base >=0.20 && <0.26,

38+ haskell-gi-base >=0.20 && <0.22,

39− haskell-gi-overloading >=0.0 && < 2.0,

39+ haskell-gi-overloading ==0.0.*,

40 jsaddle >=0.9.4.0 && <0.10,

41 text >=1.2.1.3 && <1.3,

42 webkit2gtk3-javascriptcore >=0.14.0.0 && <0.15

jsaddle-webkit2gtk/src/Language/Javascript/JSaddle/WebKitGTK.hs+37−16

@@ -43,24 +43,29 @@ import Data.Monoid ((<>))

43import Data.ByteString.Lazy (toStrict, fromStrict)

44import qualified Data.ByteString.Lazy as LB (ByteString)

45import Data.Aeson (encode, decode)

46+import Data.Text (Text)

46import qualified Data.Text as T (pack)

47import qualified Data.Text as T (pack)

48+import Data.Text.Foreign (fromPtr)

47import Data.Text.Encoding (decodeUtf8, encodeUtf8)

49import Data.Text.Encoding (decodeUtf8, encodeUtf8)

48

50

51+import Foreign.Ptr (castPtr, nullPtr)

52+

49import Data.GI.Base.BasicTypes (GObject)

53import Data.GI.Base.BasicTypes (GObject)

50import Data.GI.Base.Signals

54import Data.GI.Base.Signals

51 (connectSignalFunPtr, SignalConnectMode(..), SignalConnectMode,

55 (connectSignalFunPtr, SignalConnectMode(..), SignalConnectMode,

52 SignalHandlerId)

56 SignalHandlerId)

57+import Data.GI.Base.ManagedPtr (withManagedPtr)

53

58

54import GI.GLib (timeoutAdd, idleAdd, pattern PRIORITY_HIGH, pattern PRIORITY_DEFAULT)

59import GI.GLib (timeoutAdd, idleAdd, pattern PRIORITY_HIGH, pattern PRIORITY_DEFAULT)

55import qualified GI.Gtk as Gtk (main, init)

60import qualified GI.Gtk as Gtk (main, init)

56import GI.Gtk

61import GI.Gtk

57 (windowSetPosition, windowSetDefaultSize, windowNew,

62 (windowSetPosition, windowSetDefaultSize, windowNew,

58− scrolledWindowNew, Adjustment, containerAdd,

63+ scrolledWindowNew, noAdjustment, containerAdd,

59 WindowType(..), WindowPosition(..), widgetDestroy,

64 WindowType(..), WindowPosition(..), widgetDestroy,

60 widgetGetToplevel, widgetShowAll, onWidgetDestroy,

65 widgetGetToplevel, widgetShowAll, onWidgetDestroy,

61 mainQuit)

66 mainQuit)

62−import GI.Gio (Cancellable)

67+import GI.Gio (noCancellable)

63−import GI.JavaScriptCore (valueToString)

68+import GI.JavaScriptCore (Value(..), GlobalContext(..))

64import GI.WebKit2

69import GI.WebKit2

65 (scriptDialogPromptSetText, scriptDialogPromptGetDefaultText,

70 (scriptDialogPromptSetText, scriptDialogPromptGetDefaultText,

66 scriptDialogGetMessage, scriptDialogGetDialogType,

71 scriptDialogGetMessage, scriptDialogGetDialogType,

@@ -69,7 +74,7 @@ import GI.WebKit2

69 setSettingsEnableJavascript, webViewNewWithUserContentManager,

74 setSettingsEnableJavascript, webViewNewWithUserContentManager,

70 userContentManagerNew,

75 userContentManagerNew,

71 userContentManagerRegisterScriptMessageHandler,

76 userContentManagerRegisterScriptMessageHandler,

72− javascriptResultGetJsValue,

77+ javascriptResultGetValue, javascriptResultGetGlobalContext,

73 webViewGetUserContentManager,

78 webViewGetUserContentManager,

74 mk_UserContentManagerScriptMessageReceivedCallback,

79 mk_UserContentManagerScriptMessageReceivedCallback,

75 wrap_UserContentManagerScriptMessageReceivedCallback,

80 wrap_UserContentManagerScriptMessageReceivedCallback,

@@ -78,16 +83,17 @@ import GI.WebKit2

78 onWebViewLoadChanged, setSettingsEnableDeveloperExtras,

83 onWebViewLoadChanged, setSettingsEnableDeveloperExtras,

79 webViewSetSettings, webViewGetSettings, ScriptDialogType(..))

84 webViewSetSettings, webViewGetSettings, ScriptDialogType(..))

80

85

86+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase

87+ (JSValueRef, JSContextRef)

88+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSStringRef

89+ (jsstringgetcharactersptr, jsstringgetlength, jsstringrelease)

90+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef

91+ (jsvaluetostringcopy)

92+

81import Language.Javascript.JSaddle (JSM, Results, Batch)

93import Language.Javascript.JSaddle (JSM, Results, Batch)

82import Language.Javascript.JSaddle.Run (runJavaScript)

94import Language.Javascript.JSaddle.Run (runJavaScript)

83import Language.Javascript.JSaddle.Run.Files (initState, runBatch, ghcjsHelpers)

95import Language.Javascript.JSaddle.Run.Files (initState, runBatch, ghcjsHelpers)

84

96

85−noAdjustment :: Maybe Adjustment

86−noAdjustment = Nothing

87−

88−noCancellable :: Maybe Cancellable

89−noCancellable = Nothing

90−

91quitWebView :: WebView -> IO ()

97quitWebView :: WebView -> IO ()

92quitWebView wv = postGUIAsync $ do w <- widgetGetToplevel wv --TODO: Shouldn't this be postGUISync?

98quitWebView wv = postGUIAsync $ do w <- widgetGetToplevel wv --TODO: Shouldn't this be postGUISync?

93 widgetDestroy w

99 widgetDestroy w

@@ -103,6 +109,21 @@ postGUIAsync :: IO () -> IO ()

103postGUIAsync action =

109postGUIAsync action =

104 void . idleAdd PRIORITY_DEFAULT $ action >> return False

110 void . idleAdd PRIORITY_DEFAULT $ action >> return False

105

111

112+withJSContextRef :: GlobalContext -> (JSContextRef -> IO a) -> IO a

113+withJSContextRef (GlobalContext ctx) f = withManagedPtr ctx (f . castPtr)

114+

115+withJSValueRef :: Value -> (JSValueRef -> IO a) -> IO a

116+withJSValueRef (Value ptr) f = withManagedPtr ptr (f . castPtr)

117+

118+valueToText :: JSContextRef -> JSValueRef -> IO Text

119+valueToText ctxRef s = do

120+ jsstring <- jsvaluetostringcopy ctxRef s nullPtr

121+ l <- jsstringgetlength jsstring

122+ p <- jsstringgetcharactersptr jsstring

123+ result <- fromPtr (castPtr p) (fromIntegral l)

124+ jsstringrelease jsstring

125+ return result

126+

106run :: JSM () -> IO ()

127run :: JSM () -> IO ()

107run main = do

128run main = do

108 _ <- Gtk.init Nothing

129 _ <- Gtk.init Nothing

@@ -127,7 +148,7 @@ run main = do

127 void . onWebViewLoadChanged webView $ \case

148 void . onWebViewLoadChanged webView $ \case

128 LoadEventFinished -> runInWebView main webView

149 LoadEventFinished -> runInWebView main webView

129 _ -> return ()

150 _ -> return ()

130− webViewLoadHtml webView "" . Just $ "file://" <> T.pack pwd <> "/index.html"

151+ webViewLoadHtml webView "" . Just $ "file://" <> T.pack pwd <> "/"

131 installQuitHandler webView

152 installQuitHandler webView

132 Gtk.main

153 Gtk.main

133

154

@@ -151,16 +172,16 @@ connectUserContentManagerScriptMessageReceived obj cb after = liftIO $ do

151 let cb' = wrap_UserContentManagerScriptMessageReceivedCallback cb

172 let cb' = wrap_UserContentManagerScriptMessageReceivedCallback cb

152 cb'' <- mk_UserContentManagerScriptMessageReceivedCallback cb'

173 cb'' <- mk_UserContentManagerScriptMessageReceivedCallback cb'

153 connectSignalFunPtr obj "script-message-received::jsaddle" cb'' after

174 connectSignalFunPtr obj "script-message-received::jsaddle" cb'' after

154−#if MIN_VERSION_haskell_gi_base(0,23,0)

155− Nothing

156−#endif

157

175

158addJSaddleHandler :: WebView -> (Results -> IO ()) -> (Results -> IO Batch) -> IO ()

176addJSaddleHandler :: WebView -> (Results -> IO ()) -> (Results -> IO Batch) -> IO ()

159addJSaddleHandler webView processResult syncResults = do

177addJSaddleHandler webView processResult syncResults = do

160 manager <- webViewGetUserContentManager webView

178 manager <- webViewGetUserContentManager webView

161 _ <- onUserContentManagerScriptMessageReceived manager $ \result -> do

179 _ <- onUserContentManagerScriptMessageReceived manager $ \result -> do

162− arg <- javascriptResultGetJsValue result

180+ ctx <- javascriptResultGetGlobalContext result

163− bs <- encodeUtf8 <$> valueToString arg

181+ arg <- javascriptResultGetValue result

182+ bs <- withJSContextRef ctx $ \ctxRef ->

183+ withJSValueRef arg $ \argRef ->

184+ encodeUtf8 <$> valueToText ctxRef argRef

164 mapM_ processResult (decode (fromStrict bs))

185 mapM_ processResult (decode (fromStrict bs))

165 _ <- onWebViewScriptDialog webView $ \dialog ->

186 _ <- onWebViewScriptDialog webView $ \dialog ->

166 scriptDialogGetDialogType dialog >>= \case

187 scriptDialogGetDialogType dialog >>= \case

jsaddle-webkitgtk/default.nixnew file+16

@@ -0,0 +1,16 @@

1+{ mkDerivation, aeson, base, bytestring, directory, gi-glib, gi-gtk

2+, gi-javascriptcore, gi-webkit, haskell-gi-base, jsaddle, stdenv

3+, text, unix, webkitgtk3-javascriptcore

4+}:

5+mkDerivation {

6+ pname = "jsaddle-webkitgtk";

7+ version = "0.9.0.0";

8+ src = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [ ".git" "dist" ])) ./.;

9+ libraryHaskellDepends = [

10+ aeson base bytestring directory gi-glib gi-gtk gi-javascriptcore

11+ gi-webkit haskell-gi-base jsaddle text unix

12+ webkitgtk3-javascriptcore

13+ ];

14+ description = "Interface for JavaScript that works with GHCJS and GHC";

15+ license = stdenv.lib.licenses.mit;

16+}

jsaddle-wkwebview/cbits-cocoa/AppDelegate.m+2−57

@@ -2,9 +2,6 @@

2#import <Cocoa/Cocoa.h>

3#import <WebKit/WebKit.h>

4

5−extern void callIO(HsStablePtr);

6−extern bool callWithCStringReturningBool(const char * _Nonnull, HsStablePtr);

7−extern void callWithCString(const char * _Nonnull, HsStablePtr);

8extern void callWithWebView(WKWebView *, HsStablePtr);

5extern void callWithWebView(WKWebView *, HsStablePtr);

9

6

10@interface AppDelegate : NSObject <NSApplicationDelegate>

7@interface AppDelegate : NSObject <NSApplicationDelegate>

@@ -14,12 +11,6 @@ extern void callWithWebView(WKWebView *, HsStablePtr);

14- (instancetype)initApp:(HsStablePtr)handler progName:(NSString *)progName;

11- (instancetype)initApp:(HsStablePtr)handler progName:(NSString *)progName;

15@end

12@end

16

13

17−HsStablePtr global_willFinishLaunchingWithOptions = 0;

18−HsStablePtr global_didFinishLaunchingWithOptions = 0;

19−HsStablePtr global_applicationUniversalLink = 0;

20−HsStablePtr global_applicationOpenFile = 0;

21−uint64_t global_developerExtrasEnabled = 1;

22−

23@implementation AppDelegate

14@implementation AppDelegate

24

15

25- (void)applicationWillTerminate:(NSNotification *)aNotification {

16- (void)applicationWillTerminate:(NSNotification *)aNotification {

@@ -40,39 +31,18 @@ uint64_t global_developerExtrasEnabled = 1;

40 return self;

31 return self;

41}

32}

42

33

43−-(BOOL)application:(NSApplication *)sender openFile:(NSString *)filename {

44− bool b = callWithCStringReturningBool([filename UTF8String], global_applicationOpenFile);

45− return b ? YES : NO;

46−}

47−

48-(void)applicationWillFinishLaunching:(NSNotification *)notification {

34-(void)applicationWillFinishLaunching:(NSNotification *)notification {

49 WKWebViewConfiguration *theConfiguration = [[WKWebViewConfiguration alloc] init];

35 WKWebViewConfiguration *theConfiguration = [[WKWebViewConfiguration alloc] init];

50− if (global_developerExtrasEnabled) {

51− [theConfiguration.preferences setValue:@YES forKey:@"developerExtrasEnabled"];

36+ [theConfiguration.preferences setValue:@YES forKey:@"developerExtrasEnabled"];

52− }

53 WKWebView *webView = [[WKWebView alloc] initWithFrame: [_window.contentView frame] configuration:theConfiguration];

37 WKWebView *webView = [[WKWebView alloc] initWithFrame: [_window.contentView frame] configuration:theConfiguration];

54 [_window setContentView:webView];

38 [_window setContentView:webView];

55 callWithWebView(webView, _handler);

39 callWithWebView(webView, _handler);

56− callIO(global_willFinishLaunchingWithOptions);

57− // Listen to URL events

58− NSAppleEventManager *manager = [NSAppleEventManager sharedAppleEventManager];

59− [manager

60− setEventHandler:self

61− andSelector:@selector(applicationUniversalLink:)

62− forEventClass:kInternetEventClass

63− andEventID:kAEGetURL];

64−}

65−

66−- (void)applicationUniversalLink:(NSAppleEventDescriptor *)event {

67− NSString *url = [[event paramDescriptorForKeyword:keyDirectObject] stringValue];

68− callWithCString([url UTF8String], global_applicationUniversalLink);

69}

40}

70

41

71-(void)applicationDidFinishLaunching:(NSNotification *)notification {

42-(void)applicationDidFinishLaunching:(NSNotification *)notification {

72 [_window orderFrontRegardless];

43 [_window orderFrontRegardless];

73 [_window center];

44 [_window center];

74 [NSApp activateIgnoringOtherApps:YES];

45 [NSApp activateIgnoringOtherApps:YES];

75− callIO(global_didFinishLaunchingWithOptions);

76}

46}

77

47

78-(BOOL) applicationShouldTerminateAfterLastWindowClosed:(NSApplication *)app {

48-(BOOL) applicationShouldTerminateAfterLastWindowClosed:(NSApplication *)app {

@@ -81,33 +51,8 @@ uint64_t global_developerExtrasEnabled = 1;

81

51

82@end

52@end

83

53

84−void runInWKWebView(HsStablePtr handler,

54+void runInWKWebView(HsStablePtr handler, const char * _Nonnull progName) {

85− const char * _Nonnull progName,

86− HsStablePtr hs_willFinishLaunchingWithOptions,

87− HsStablePtr hs_didFinishLaunchingWithOptions,

88− HsStablePtr hs_applicationDidBecomeActive,

89− HsStablePtr hs_applicationWillResignActive,

90− HsStablePtr hs_applicationDidEnterBackground,

91− HsStablePtr hs_applicationWillEnterForeground,

92− HsStablePtr hs_applicationWillTerminate,

93− HsStablePtr hs_applicationSignificantTimeChange,

94− HsStablePtr hs_applicationUniversalLink,

95− const uint64_t hs_requestAuthorizationWithOptions,

96− const uint64_t hs_requestAuthorizationOptionBadge,

97− const uint64_t hs_requestAuthorizationOptionSound,

98− const uint64_t hs_requestAuthorizationOptionAlert,

99− const uint64_t hs_requestAuthorizationOptionCarPlay,

100− const uint64_t hs_registerForRemoteNotifications,

101− HsStablePtr hs_didRegisterForRemoteNotificationsWithDeviceToken,

102− HsStablePtr hs_didFailToRegisterForRemoteNotificationsWithError,

103− const uint64_t hs_developerExtrasEnabled,

104− HsStablePtr hs_applicationOpenFile) {

105 @autoreleasepool {

55 @autoreleasepool {

106− global_willFinishLaunchingWithOptions = hs_willFinishLaunchingWithOptions;

107− global_didFinishLaunchingWithOptions = hs_didFinishLaunchingWithOptions;

108− global_applicationUniversalLink = hs_applicationUniversalLink;

109− global_applicationOpenFile = hs_applicationOpenFile;

110− global_developerExtrasEnabled = hs_developerExtrasEnabled;

111 NSApplication *application = [NSApplication sharedApplication];

56 NSApplication *application = [NSApplication sharedApplication];

112 AppDelegate *appDelegate = [[AppDelegate alloc] initApp:handler progName:[NSString stringWithCString:progName encoding:NSUTF8StringEncoding]];

57 AppDelegate *appDelegate = [[AppDelegate alloc] initApp:handler progName:[NSString stringWithCString:progName encoding:NSUTF8StringEncoding]];

113 [application setDelegate:appDelegate];

58 [application setDelegate:appDelegate];

jsaddle-wkwebview/cbits-uikit/AppDelegate.m+1−2

@@ -170,8 +170,7 @@ void runInWKWebView(HsStablePtr handler,

170 const uint64_t hs_requestAuthorizationOptionCarPlay,

171 const uint64_t hs_registerForRemoteNotifications,

172 HsStablePtr hs_didRegisterForRemoteNotificationsWithDeviceToken,

173− HsStablePtr hs_didFailToRegisterForRemoteNotificationsWithError,

173+ HsStablePtr hs_didFailToRegisterForRemoteNotificationsWithError) {

174− const uint64_t hs_developerExtrasEnabled) {

175 @autoreleasepool {

174 @autoreleasepool {

176 globalHandler = handler;

175 globalHandler = handler;

177 global_willFinishLaunchingWithOptions = hs_willFinishLaunchingWithOptions;

176 global_willFinishLaunchingWithOptions = hs_willFinishLaunchingWithOptions;

jsaddle-wkwebview/cbits/WKWebView.m+10−8

@@ -61,9 +61,9 @@ extern void jsaddleSyncResult(HsStablePtr, JSaddleHandler *, const char * _Nonnu

61

62 if(!navigationAction.targetFrame && ![url.scheme isEqualToString:@"file"]) {

63 if(openApp(url))

64− decisionHandler(WKNavigationActionPolicyCancel);

64+ decisionHandler(WKNavigationActionPolicyCancel);

65− else

65+ else

66− decisionHandler(WKNavigationActionPolicyAllow);

66+ decisionHandler(WKNavigationActionPolicyAllow);

67 }

68 else

69 decisionHandler(WKNavigationActionPolicyAllow);

@@ -95,11 +95,10 @@ void completeSync(JSaddleHandler *handler, const char * _Nonnull s) {

95 handler.completionHandler = NULL;

96}

97

98−void loadHTMLStringWithBaseURL(WKWebView *webView, const char * _Nonnull html, const char * _Nonnull url) {

98+void loadHTMLString(WKWebView *webView, const char * _Nonnull html) {

99− NSString *htmlString = [NSString stringWithCString:html encoding:NSUTF8StringEncoding];

99+ NSString *htmlString = [NSString stringWithCString:html encoding:NSUTF8StringEncoding];

100− NSURL *baseURL = [NSURL URLWithString:[[NSString alloc] initWithCString:url encoding:NSUTF8StringEncoding]];

101− dispatch_async(dispatch_get_main_queue(), ^{

100+ dispatch_async(dispatch_get_main_queue(), ^{

102− [webView loadHTMLString:htmlString baseURL:baseURL];

101+ [webView loadHTMLString:htmlString baseURL:NULL];

103 });

102 });

104}

103}

105

104

@@ -122,3 +121,6 @@ void loadBundleFile(WKWebView *webView, const char * _Nonnull file, const char *

122 }

121 }

123 }

122 }

124}

123}

124+

125+

126+

jsaddle-wkwebview/default.nix+21−14

@@ -1,14 +1,21 @@

1−{ filterSource ? (x: x) }:

1+{ mkDerivation, stdenv, aeson, base, bytestring, jsaddle, data-default

2−self: super:

2+, buildPackages, hostPlatform

3−let

3+}:

4− pkgs = self.callPackage ({pkgs}: pkgs) {};

4+

5− inherit (pkgs) lib;

5+mkDerivation {

6−in

6+ pname = "jsaddle-wkwebview";

7−with pkgs.haskell.lib;

7+ version = "0.9.4.0";

8−overrideCabal (self.callCabal2nix "jsaddle-wkwebview" (filterSource ./.) {}) (drv: {

8+ src = ./.;

9− libraryFrameworkDepends = (drv.libraryFrameworkDepends or []) ++

9+ libraryHaskellDepends = [ aeson base bytestring jsaddle data-default ];

10− (if pkgs.stdenv.hostPlatform.useiOSPrebuilt then [

10+ libraryDarwinFrameworkDepends = with buildPackages; if hostPlatform.useiOSCross or false then [

11− "${pkgs.buildPackages.darwin.xcode}/Contents/Developer/Platforms/${pkgs.stdenv.hostPlatform.xcodePlatform}.platform/Developer/SDKs/${pkgs.stdenv.hostPlatform.xcodePlatform}.sdk/System"

11+ (assert osx_sdk != null; osx_sdk)

12+ ] else [

13+ darwin.libobjc

14+ darwin.apple_sdk.libs.xpc

15+ darwin.apple_sdk.frameworks.Foundation

12− ] else (with pkgs.buildPackages.darwin.apple_sdk.frameworks; [ Cocoa WebKit ]));

16+ darwin.apple_sdk.frameworks.Cocoa

13− buildDepends = lib.optional (!pkgs.stdenv.hostPlatform.useiOSPrebuilt) [ pkgs.buildPackages.darwin.cf-private ];

17+ darwin.apple_sdk.frameworks.WebKit

18+ ];

19+ description = "Interface for JavaScript that works with GHCJS and GHC";

20+ license = stdenv.lib.licenses.mit;

14−})

21+}

jsaddle-wkwebview/jsaddle-wkwebview.cabal+11−18

@@ -1,5 +1,5 @@

1name: jsaddle-wkwebview

2−version: 0.9.8.0

2+version: 0.9.4.0

3cabal-version: >=1.10

4build-type: Simple

5license: MIT

@@ -25,31 +25,24 @@ source-repository head

25library

26 exposed-modules:

27 Language.Javascript.JSaddle.WKWebView

28+ Language.Javascript.JSaddle.WKWebView.Internal

28 build-depends:

29 build-depends:

30+ aeson >=0.8.0.2 && <1.3,

29− base <5

31+ base <5,

32+ bytestring >=0.10.6.0 && <0.11,

33+ jsaddle >= 0.9.4.0 && <0.10,

34+ data-default,

35+ containers

30 default-language: Haskell2010

36 default-language: Haskell2010

31 hs-source-dirs: src

37 hs-source-dirs: src

38+ frameworks: Foundation, WebKit

32 ghc-options: -ferror-spans -Wall

39 ghc-options: -ferror-spans -Wall

33− if os(linux)

40+ c-sources:

34− buildable: False

41+ cbits/WKWebView.m

35 if impl(ghcjs)

42 if impl(ghcjs)

36 hs-source-dirs: src-ghcjs

43 hs-source-dirs: src-ghcjs

37 else

44 else

38− frameworks: Foundation, WebKit

39− build-depends:

40− aeson >=0.8.0.2 && <1.6,

41− bytestring >=0.10.6.0 && <0.11,

42− directory,

43− jsaddle >= 0.9.4.0 && <0.10,

44− text,

45− data-default,

46− containers

47− exposed-modules:

48− Language.Javascript.JSaddle.WKWebView.Internal

49 hs-source-dirs: src-ghc

45 hs-source-dirs: src-ghc

50− c-sources:

51− cbits/WKWebView.m

52− cc-options: -Wno-everything

53 if os(ios)

46 if os(ios)

54 frameworks: UIKit, UserNotifications

47 frameworks: UIKit, UserNotifications

55 if flag(include-app-delegate)

48 if flag(include-app-delegate)

jsaddle-wkwebview/src-ghc/Language/Javascript/JSaddle/WKWebView.hs+18−55

@@ -1,12 +1,9 @@

1module Language.Javascript.JSaddle.WKWebView

2 ( jsaddleMain

3− , jsaddleMainHTMLWithBaseURL

4 , jsaddleMainFile

3 , jsaddleMainFile

5 , WKWebView(..)

4 , WKWebView(..)

6 , run

5 , run

7− , run'

8 , runWithAppConfig

6 , runWithAppConfig

9− , runHTMLWithBaseURL

10 , runFile

7 , runFile

11 , mainBundleResourcePath

8 , mainBundleResourcePath

12 , ApplicationState (..)

9 , ApplicationState (..)

@@ -21,11 +18,10 @@ import Data.Set (Set)

21import qualified Data.Set as Set

18import qualified Data.Set as Set

22import Data.Word

19import Data.Word

23import Foreign.Marshal.Utils (fromBool)

20import Foreign.Marshal.Utils (fromBool)

24−import Language.Javascript.JSaddle.WKWebView.Internal

21+import Language.Javascript.JSaddle.WKWebView.Internal (jsaddleMain, jsaddleMainFile, WKWebView(..), mainBundleResourcePath)

25− (jsaddleMain, jsaddleMainHTMLWithBaseURL, jsaddleMainFile, WKWebView(..), mainBundleResourcePath)

26import System.Environment (getProgName)

22import System.Environment (getProgName)

27import Foreign.C.String (CString, withCString)

23import Foreign.C.String (CString, withCString)

28−import Foreign.C.Types (CBool, CInt)

24+import Foreign.C.Types (CInt)

29import Foreign.StablePtr (StablePtr, newStablePtr)

25import Foreign.StablePtr (StablePtr, newStablePtr)

30import Language.Javascript.JSaddle (JSM)

26import Language.Javascript.JSaddle (JSM)

31

27

@@ -50,8 +46,6 @@ foreign import ccall runInWKWebView

50 -> Word64 -- registerForRemoteNotifications

46 -> Word64 -- registerForRemoteNotifications

51 -> StablePtr (CString -> IO ()) -- didRegisterForRemoteNotificationsWithDeviceToken

47 -> StablePtr (CString -> IO ()) -- didRegisterForRemoteNotificationsWithDeviceToken

52 -> StablePtr (CString -> IO ()) -- didFailToRegisterForRemoteNotificationsWithError

48 -> StablePtr (CString -> IO ()) -- didFailToRegisterForRemoteNotificationsWithError

53− -> Word64 -- developerExtrasEnabled

54− -> StablePtr (CString -> IO CBool) -- applicationOpenFile

55 -> IO ()

49 -> IO ()

56

50

57data AppDelegateConfig = AppDelegateConfig

51data AppDelegateConfig = AppDelegateConfig

@@ -64,25 +58,8 @@ data AppDelegateConfig = AppDelegateConfig

64 , _appDelegateConfig_applicationWillTerminate :: IO ()

58 , _appDelegateConfig_applicationWillTerminate :: IO ()

65 , _appDelegateConfig_applicationSignificantTimeChange :: IO ()

59 , _appDelegateConfig_applicationSignificantTimeChange :: IO ()

66 , _appDelegateConfig_applicationUniversalLink :: CString -> IO ()

60 , _appDelegateConfig_applicationUniversalLink :: CString -> IO ()

67− -- ^ Called when the app is launched from a URL. 'CString' contains the URL.

68− --

69− -- The Core Foundation plist key CFBundleURLTypes controls which URL schemes

70− -- the app should respond to.

71 , _appDelegateConfig_applicationDidReceiveRemoteNotification :: ApplicationState -> CString -> IO ()

61 , _appDelegateConfig_applicationDidReceiveRemoteNotification :: ApplicationState -> CString -> IO ()

72− -- ^ Called when the application receives a remote notification.

73− -- 'ApplicationState' is the current state of the app.

74− -- The 'CString' JSON-encoded user info contained in the notification.

75− -- For more information see https://developer.apple.com/documentation/uikit/uiapplicationdelegate/1623117-application?language=objc

76 , _appDelegateConfig_appDelegateNotificationConfig :: AppDelegateNotificationConfig

62 , _appDelegateConfig_appDelegateNotificationConfig :: AppDelegateNotificationConfig

77− , _appDelegateConfig_developerExtrasEnabled :: Bool

78− -- ^ Allow devtools in the app. Defaults to 'True'

79− , _appDelegateConfig_applicationOpenFile :: CString -> IO Bool

80− -- ^ Called when the app is launched by opening a file. 'CString' contains

81− -- the file path. Return value is 'True' if the file was successfully

82− -- opened. Defaults to ignoring the file and returning 'False'.

83− --

84− -- The Core Foundation plist key CFBundleDocumentTypes controls which file

85− -- types should be associated with the app.

86 }

63 }

87

64

88instance Default AppDelegateConfig where

65instance Default AppDelegateConfig where

@@ -98,8 +75,6 @@ instance Default AppDelegateConfig where

98 , _appDelegateConfig_applicationUniversalLink = \_ -> return ()

75 , _appDelegateConfig_applicationUniversalLink = \_ -> return ()

99 , _appDelegateConfig_applicationDidReceiveRemoteNotification = \_ _ -> return ()

76 , _appDelegateConfig_applicationDidReceiveRemoteNotification = \_ _ -> return ()

100 , _appDelegateConfig_appDelegateNotificationConfig = def

77 , _appDelegateConfig_appDelegateNotificationConfig = def

101− , _appDelegateConfig_developerExtrasEnabled = True

102− , _appDelegateConfig_applicationOpenFile = \_ -> return False

103 }

78 }

104

79

105data AuthorizationOption = AuthorizationOption_Badge

80data AuthorizationOption = AuthorizationOption_Badge

@@ -132,38 +107,29 @@ instance Default AppDelegateNotificationConfig where

132

107

133-- | Run JSaddle in a WKWebView

108-- | Run JSaddle in a WKWebView

134run :: JSM () -> IO ()

109run :: JSM () -> IO ()

135−run f = run' def (jsaddleMain f)

110+run = run' Nothing def

136

111

137-- | Run JSaddle in a WKWebView

112-- | Run JSaddle in a WKWebView

138runWithAppConfig :: AppDelegateConfig -> JSM () -> IO ()

113runWithAppConfig :: AppDelegateConfig -> JSM () -> IO ()

139−runWithAppConfig cfg = run' cfg . jsaddleMain

114+runWithAppConfig = run' Nothing

140

115

141-- | Run JSaddle in a WKWebView first loading the specified file

116-- | Run JSaddle in a WKWebView first loading the specified file

142-- from the mainBundle (relative to the resourcePath).

117-- from the mainBundle (relative to the resourcePath).

143−runFile

144− :: ByteString -- ^ The file to navigate to.

118+runFile :: ByteString -- ^ The file to navigate to.

145− -> ByteString -- ^ The path to allow read access to.

119+ -> ByteString -- ^ The path to allow read access to.

146− -> AppDelegateConfig

120+ -> AppDelegateConfig

147− -> JSM ()

121+ -> JSM ()

148− -> IO ()

122+ -> IO ()

149−runFile url allowing cfg = run' cfg . jsaddleMainFile url allowing

123+runFile url allowing = run' $ Just (url, allowing)

150−

124+

151−-- | Run JSaddle in a WKWebView first loading the specified html

152−-- as though it came from the specified URL

153−-- (calls WKWebKit function loadHTMLString).

154−runHTMLWithBaseURL

155− :: ByteString -- ^ HTML to load.

125+run' :: Maybe (ByteString, ByteString)

156− -> ByteString -- ^ pretend it came from this URL.

157− -> AppDelegateConfig

158− -> JSM ()

159− -> IO ()

160−runHTMLWithBaseURL url allowing cfg = run' cfg . jsaddleMainHTMLWithBaseURL url allowing

161−

162−run' :: AppDelegateConfig

126+ -> AppDelegateConfig

163− -> (WKWebView -> IO ())

127+ -> JSM ()

164 -> IO ()

128 -> IO ()

165−run' cfg main = do

129+run' mUrl cfg f = do

166− handler <- newStablePtr main

130+ handler <- case mUrl of

131+ Just (url, allowing) -> newStablePtr (jsaddleMainFile url allowing f)

132+ Nothing -> newStablePtr (jsaddleMain f)

167 progName <- getProgName

133 progName <- getProgName

168

134

169 -- AppDelegate callbacks

135 -- AppDelegate callbacks

@@ -183,7 +149,6 @@ run' cfg main = do

183 2 -> ApplicationState_Background

149 2 -> ApplicationState_Background

184 _ -> ApplicationState_Unknown n

150 _ -> ApplicationState_Unknown n

185 _appDelegateConfig_applicationDidReceiveRemoteNotification cfg appState s

151 _appDelegateConfig_applicationDidReceiveRemoteNotification cfg appState s

186− applicationOpenFile <- newStablePtr $ fmap fromBool . _appDelegateConfig_applicationOpenFile cfg

187

152

188 -- AppDelegate notification configuration

153 -- AppDelegate notification configuration

189 let ncfg = _appDelegateConfig_appDelegateNotificationConfig cfg

154 let ncfg = _appDelegateConfig_appDelegateNotificationConfig cfg

@@ -215,5 +180,3 @@ run' cfg main = do

215 (fromBool registerForRemoteNotifications)

180 (fromBool registerForRemoteNotifications)

216 didRegisterForRemoteNotificationsWithDeviceToken

181 didRegisterForRemoteNotificationsWithDeviceToken

217 didFailToRegisterForRemoteNotificationsWithError

182 didFailToRegisterForRemoteNotificationsWithError

218− (fromBool $ _appDelegateConfig_developerExtrasEnabled cfg)

219− applicationOpenFile

jsaddle-wkwebview/src/Language/Javascript/JSaddle/WKWebView/Internal.hs+5−29

@@ -1,7 +1,6 @@

1{-# LANGUAGE ForeignFunctionInterface, OverloadedStrings #-}

2module Language.Javascript.JSaddle.WKWebView.Internal

3 ( jsaddleMain

4− , jsaddleMainHTMLWithBaseURL

5 , jsaddleMainFile

4 , jsaddleMainFile

6 , WKWebView(..)

5 , WKWebView(..)

7 , mainBundleResourcePath

6 , mainBundleResourcePath

@@ -16,11 +15,9 @@ import Data.ByteString (useAsCString, packCString)

16import qualified Data.ByteString as BS (ByteString)

15import qualified Data.ByteString as BS (ByteString)

17import Data.ByteString.Lazy (ByteString, toStrict, fromStrict)

16import Data.ByteString.Lazy (ByteString, toStrict, fromStrict)

18import Data.Aeson (encode, decode)

17import Data.Aeson (encode, decode)

19−import qualified Data.Text as T (pack)

20−import Data.Text.Encoding (encodeUtf8)

21

18

22import Foreign.C.String (CString)

19import Foreign.C.String (CString)

23−import Foreign.C.Types (CBool(..), CInt(..))

20+import Foreign.C.Types (CInt(..))

24import Foreign.Ptr (Ptr, nullPtr)

21import Foreign.Ptr (Ptr, nullPtr)

25import Foreign.StablePtr (StablePtr, newStablePtr, deRefStablePtr)

22import Foreign.StablePtr (StablePtr, newStablePtr, deRefStablePtr)

26

23

@@ -28,8 +25,6 @@ import Language.Javascript.JSaddle (Results, Batch, JSM)

28import Language.Javascript.JSaddle.Run (runJavaScript)

25import Language.Javascript.JSaddle.Run (runJavaScript)

29import Language.Javascript.JSaddle.Run.Files (initState, runBatch, ghcjsHelpers)

26import Language.Javascript.JSaddle.Run.Files (initState, runBatch, ghcjsHelpers)

30

27

31−import System.Directory (getCurrentDirectory)

32−

33newtype WKWebView = WKWebView (Ptr WKWebView)

28newtype WKWebView = WKWebView (Ptr WKWebView)

34newtype JSaddleHandler = JSaddleHandler (Ptr JSaddleHandler)

29newtype JSaddleHandler = JSaddleHandler (Ptr JSaddleHandler)

35

30

@@ -39,10 +34,9 @@ foreign export ccall jsaddleSyncResult :: StablePtr (Results -> IO Batch) -> JSa

39foreign export ccall callWithWebView :: WKWebView -> StablePtr (WKWebView -> IO ()) -> IO ()

34foreign export ccall callWithWebView :: WKWebView -> StablePtr (WKWebView -> IO ()) -> IO ()

40foreign export ccall callWithCIntCString :: CInt -> CString -> StablePtr (CInt -> CString -> IO ()) -> IO ()

35foreign export ccall callWithCIntCString :: CInt -> CString -> StablePtr (CInt -> CString -> IO ()) -> IO ()

41foreign export ccall callWithCString :: CString -> StablePtr (CString -> IO ()) -> IO ()

36foreign export ccall callWithCString :: CString -> StablePtr (CString -> IO ()) -> IO ()

42−foreign export ccall callWithCStringReturningBool :: CString -> StablePtr (CString -> IO CBool) -> IO CBool

43foreign export ccall callIO :: StablePtr (IO ()) -> IO ()

37foreign export ccall callIO :: StablePtr (IO ()) -> IO ()

44foreign import ccall addJSaddleHandler :: WKWebView -> StablePtr (IO ()) -> StablePtr (Results -> IO ()) -> StablePtr (Results -> IO Batch) -> IO ()

38foreign import ccall addJSaddleHandler :: WKWebView -> StablePtr (IO ()) -> StablePtr (Results -> IO ()) -> StablePtr (Results -> IO Batch) -> IO ()

45−foreign import ccall loadHTMLStringWithBaseURL :: WKWebView -> CString -> CString -> IO ()

39+foreign import ccall loadHTMLString :: WKWebView -> CString -> IO ()

46foreign import ccall loadBundleFile :: WKWebView -> CString -> CString -> IO ()

40foreign import ccall loadBundleFile :: WKWebView -> CString -> CString -> IO ()

47foreign import ccall evaluateJavaScript :: WKWebView -> CString -> IO ()

41foreign import ccall evaluateJavaScript :: WKWebView -> CString -> IO ()

48foreign import ccall completeSync :: JSaddleHandler -> CString -> IO ()

42foreign import ccall completeSync :: JSaddleHandler -> CString -> IO ()

@@ -50,23 +44,9 @@ foreign import ccall mainBundleResourcePathC :: IO CString

50

44

51-- | Run JSaddle in WKWebView

45-- | Run JSaddle in WKWebView

52jsaddleMain :: JSM () -> WKWebView -> IO ()

46jsaddleMain :: JSM () -> WKWebView -> IO ()

53−jsaddleMain f webView = do

47+jsaddleMain f webView =

54− pwd <- getCurrentDirectory

55− let baseURL = encodeUtf8 $ "file://" <> T.pack pwd <> "/index.html"

56− jsaddleMainHTMLWithBaseURL (toStrict indexHtml) baseURL f webView

57−

58−-- | Run JSaddle in WKWebView with initial html and base url

59−jsaddleMainHTMLWithBaseURL

60− :: BS.ByteString -- ^ HTML

61− -> BS.ByteString -- ^ Base URL

62− -> JSM ()

63− -> WKWebView

64− -> IO ()

65−jsaddleMainHTMLWithBaseURL initialHTML baseURL f webView =

66 jsaddleMain' f webView $

48 jsaddleMain' f webView $

67− useAsCString baseURL $ \url ->

49+ useAsCString (toStrict indexHtml) $ loadHTMLString webView

68− useAsCString initialHTML $ \html ->

69− loadHTMLStringWithBaseURL webView html url

70

50

71-- | Run JSaddle in a WKWebView first loading the specified file

51-- | Run JSaddle in a WKWebView first loading the specified file

72-- from the mainBundle (relative to the resourcePath).

52-- from the mainBundle (relative to the resourcePath).

@@ -134,11 +114,6 @@ callWithCIntCString n s fptr = do

134 f <- deRefStablePtr fptr

114 f <- deRefStablePtr fptr

135 f n s

115 f n s

136

116

137−callWithCStringReturningBool :: CString -> StablePtr (CString -> IO CBool) -> IO CBool

138−callWithCStringReturningBool c fptr = do

139− f <- deRefStablePtr fptr

140− f c

141−

142callIO :: StablePtr (IO ()) -> IO ()

117callIO :: StablePtr (IO ()) -> IO ()

143callIO ptr = do

118callIO ptr = do

144 f <- deRefStablePtr ptr

119 f <- deRefStablePtr ptr

@@ -172,3 +147,4 @@ mainBundleResourcePath = do

172 if bs == nullPtr

147 if bs == nullPtr

173 then return Nothing

148 then return Nothing

174 else Just <$> packCString bs

149 else Just <$> packCString bs

150+

jsaddle/default.nixnew file+23

@@ -0,0 +1,23 @@

1+{ mkDerivation, aeson, attoparsec, base, base64-bytestring

2+, bytestring, containers, deepseq, filepath, ghc-prim, http-types

3+, lens, primitive, process, random, ref-tf, scientific, stdenv, stm

4+, text, time, transformers, unordered-containers, unliftio-core

5+, vector, exceptions, ghcjs-base, ghcjs-prim, ghc

6+}:

7+mkDerivation {

8+ pname = "jsaddle";

9+ version = "0.9.4.0";

10+ src = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [ ".git" "dist" ])) ./.;

11+ libraryHaskellDepends = [

12+ aeson base base64-bytestring bytestring exceptions lens primitive

13+ text transformers

14+ ] ++ (if ghc.isGhcjs or false then [

15+ ghcjs-base ghcjs-prim

16+ ] else [

17+ attoparsec containers deepseq filepath ghc-prim http-types process

18+ random ref-tf scientific stm time unordered-containers vector

19+ unliftio-core

20+ ]);

21+ description = "Interface for JavaScript that works with GHCJS and GHC";

22+ license = stdenv.lib.licenses.mit;

23+}

jsaddle/jsaddle.cabal+16−15

@@ -1,5 +1,5 @@

1name: jsaddle

2−version: 0.9.8.0

2+version: 0.9.4.0

3cabal-version: >=1.10

4build-type: Simple

5license: MIT

@@ -10,7 +10,7 @@ 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 JavaScript helper.

13+ drive a small JavaScipt helper.

14category: Web, Javascript

15author: Hamish Mackenzie

16

@@ -36,20 +36,20 @@ library

36 else

37 build-depends:

38 attoparsec >=0.11 && <0.14,

39− containers >=0.5.6.2 && <0.7,

39+ containers >=0.5.6.2 && <0.6,

40 deepseq >=1.3 && < 1.5,

41 filepath >=1.4.0.0 && <1.5,

42 ghc-prim,

43− http-types >=0.8.6 && <0.13,

43+ http-types >=0.8.6 && <0.12,

44 process >=1.2.3.0 && <1.7,

45− random >= 1.1 && < 1.3,

45+ random >= 1.1 && < 1.2,

46 ref-tf >=0.4.0.1 && <0.5,

47 scientific >=0.3 && <0.4,

48− stm >=2.4.4 && <2.6,

48+ stm >=2.4.4 && <2.5,

49− time >=1.5.0.1 && <1.11,

49+ time >=1.5.0.1 && <1.9,

50 unordered-containers >=0.2 && <0.3,

51 vector >=0.10 && <0.13,

52− unliftio-core >=0.1 && < 0.3

52+ unliftio-core >=0.1 && < 0.2

53 exposed-modules:

54 Data.JSString

55 Data.JSString.Internal

@@ -107,14 +107,13 @@ library

107 Language.Javascript.JSaddle.Value

108 Language.Javascript.JSaddle.Types

109 build-depends:

110− aeson >=0.11.3.0 && <1.6,

110+ aeson >=0.8.0.2 && <1.3,

111− base >=4.9 && <5,

111+ base <5,

112− base-compat >=0.9.0 && <0.12,

113− base64-bytestring >=1.0.0.1 && <1.2,

112+ base64-bytestring >=1.0.0.1 && <1.1,

114 bytestring >=0.10.6.0 && <0.11,

113 bytestring >=0.10.6.0 && <0.11,

115− exceptions >=0.8 && <0.11,

114+ exceptions >=0.8 && <0.9,

116− lens >=3.8.5 && <5.1,

115+ lens >=3.8.5 && <4.16,

117− primitive >=0.6.1.0 && <0.8,

116+ primitive >=0.6.1.0 && <0.7,

118 text >=1.2.1.3 && <1.3,

117 text >=1.2.1.3 && <1.3,

119 transformers >=0.4.2.0 && <0.6

118 transformers >=0.4.2.0 && <0.6

120 default-language: Haskell2010

119 default-language: Haskell2010

@@ -124,3 +123,5 @@ library

124 cpp-options: -DCHECK_UNCHECKED

123 cpp-options: -DCHECK_UNCHECKED

125 if flag(call-stacks) || flag(check-unchecked)

124 if flag(call-stacks) || flag(check-unchecked)

126 cpp-options: -DJSADDLE_HAS_CALL_STACK

125 cpp-options: -DJSADDLE_HAS_CALL_STACK

126+

127+

jsaddle/src-ghc/Data/JSString/Internal/Type.hs+1−2

@@ -38,11 +38,10 @@ import Data.Aeson (ToJSON(..), FromJSON(..))

38import Data.Data (Data)

39-- import Data.Text.Internal.Unsafe.Char (ord)

40import Data.Typeable (Typeable)

41−import Data.Semigroup (Semigroup)

42import GHC.Exts (Char(..), ord#, andI#, (/=#), isTrue#)

41import GHC.Exts (Char(..), ord#, andI#, (/=#), isTrue#)

43

42

44-- | A wrapper around a JavaScript string

43-- | A wrapper around a JavaScript string

45−newtype JSString = JSString Text deriving(Show, Read, IsString, Semigroup, Monoid, Ord, Eq, Data, ToJSON, FromJSON, Typeable)

44+newtype JSString = JSString Text deriving(Show, Read, IsString, Monoid, Ord, Eq, Data, ToJSON, FromJSON, Typeable)

46

45

47instance NFData JSString where rnf !_ = ()

46instance NFData JSString where rnf !_ = ()

48

47

jsaddle/src-ghc/JavaScript/Array.hs+2−2

@@ -48,7 +48,7 @@ import Language.Javascript.JSaddle.Types

48 (JSM, JSVal, SomeJSArray(..), JSArray,

49 MutableJSArray, GHCJSPure(..))

50import Control.Lens.Operators ((^.))

51−import Language.Javascript.JSaddle.Object (js2, js0, (<##), js1, js)

51+import Language.Javascript.JSaddle.Object (js2, js0, (##), js1, js)

52import Language.Javascript.JSaddle.Value (valToNumber)

53import JavaScript.Array.Internal (create, fromList, fromListIO, toList, toListIO, index, read, push)

54

@@ -69,7 +69,7 @@ append (SomeJSArray x) (SomeJSArray y) = SomeJSArray <$> x ^. js1 "concat" y

69{-# INLINE append #-}

70

71write :: Int -> JSVal -> MutableJSArray -> JSM ()

72−write n e (SomeJSArray x) = void $ (x <## n) e

72+write n e (SomeJSArray x) = void $ (x ## n) e

73{-# INLINE write #-}

74

75pop :: MutableJSArray -> JSM JSVal

jsaddle/src/Language/Javascript/JSaddle.hs+5−5

@@ -9,7 +9,7 @@

9-- | This package provides an EDSL for calling JavaScript that

10-- can be used both from GHCJS and GHC. When using GHC

11-- the application is run using Warp and WebSockets to

12−-- drive a small JavaScript helper.

12+-- drive a small JavaScipt helper.

13-----------------------------------------------------------------------------

14

15module Language.Javascript.JSaddle (

@@ -35,10 +35,10 @@ module Language.Javascript.JSaddle (

35 --

36 -- Where it makes sense code examples are given in two forms. One

37 -- that uses 'eval' to run a purely JavaScript version and one that

38− -- uses more of the JSaddle EDSL feature being demonstrated.

38+ -- uses more of the JSaddle EDSL feature being demonstated.

39

40 -- * Calling Haskell from JavaScript

41− -- | You can call back into Haskell from JavaScript using 'fun' to

41+ -- | You can call back into haskell from JavaScript using 'fun' to

42 -- convert a Haskell function in the JSM monad into a javascript

43 -- value.

44

@@ -52,8 +52,8 @@ module Language.Javascript.JSaddle (

52 -- and the server will run the Haskell code. The JSaddle parts will

53 -- be executed by sending commands back to the browser.

54

55− -- Although the JavaScript code is executed in the strict order

55+ -- Although the code JavaScript code is executed in the the strict order

56− -- set out by the EDSL it is done asynchronously to the Haskell code.

56+ -- set out by the EDSL it done asynchonously to the Haskell code.

57 -- This improves the performance by reducing the number of round trips

58 -- needed between the Haskell and JavaScript code.

59

jsaddle/src/Language/Javascript/JSaddle/Evaluate.hs+1−1

@@ -50,7 +50,7 @@ eval :: (ToJSString script)

50 -> JSM JSVal

51#ifdef ghcjs_HOST_OS

52eval script = liftIO $ js_eval (toJSString script)

53−foreign import javascript safe "$r = eval($1);"

53+foreign import javascript unsafe "$r = eval($1);"

54 js_eval :: JSString -> IO JSVal

55#else

56eval = evaluateScript . toJSString

jsaddle/src/Language/Javascript/JSaddle/Object.hs+6−5

@@ -526,11 +526,12 @@ array args = do

526 Object . coerce <$> fromListIO rargs

527

528-- | JavaScript's global object

529+global :: Object

529#ifdef ghcjs_HOST_OS

530#ifdef ghcjs_HOST_OS

531+global = js_window

530−foreign import javascript unsafe "$r = globalThis"

532+foreign import javascript unsafe "$r = window"

531− global :: Object

533+ js_window :: Object

532#else

534#else

533−global :: Object

534global = Object . JSVal . unsafePerformIO $ newIORef 4

535global = Object . JSVal . unsafePerformIO $ newIORef 4

535#endif

536#endif

536

537

@@ -556,7 +557,7 @@ objCallAsFunction :: MakeArgs args

556objCallAsFunction f this args = do

557objCallAsFunction f this args = do

557 rargs <- makeArgs args >>= liftIO . Array.fromListIO

558 rargs <- makeArgs args >>= liftIO . Array.fromListIO

558 liftIO $ js_apply f this rargs

559 liftIO $ js_apply f this rargs

559−foreign import javascript safe "$r = $1.apply($2, $3)"

560+foreign import javascript unsafe "$r = $1.apply($2, $3)"

560 js_apply :: Object -> Object -> MutableJSArray -> IO JSVal

561 js_apply :: Object -> Object -> MutableJSArray -> IO JSVal

561#else

562#else

562objCallAsFunction f this args = do

563objCallAsFunction f this args = do

@@ -576,7 +577,7 @@ objCallAsConstructor :: MakeArgs args

576objCallAsConstructor f args = do

577objCallAsConstructor f args = do

577 rargs <- makeArgs args >>= liftIO . Array.fromListIO

578 rargs <- makeArgs args >>= liftIO . Array.fromListIO

578 liftIO $ js_new f rargs

579 liftIO $ js_new f rargs

579−foreign import javascript safe "\

580+foreign import javascript unsafe "\

580 switch($2.length) {\

581 switch($2.length) {\

581 case 0 : $r = new $1(); break;\

582 case 0 : $r = new $1(); break;\

582 case 1 : $r = new $1($2[0]); break;\

583 case 1 : $r = new $1($2[0]); break;\

jsaddle/src/Language/Javascript/JSaddle/Run.hs+3−17

@@ -73,23 +73,10 @@ import Language.Javascript.JSaddle.Types

73 Object(..), JSValueReceived(..), JSM(..), Batch(..), JSValueForSend(..), syncPoint, syncAfter, sendCommand)

74import Language.Javascript.JSaddle.Exception (JSException(..))

75import Control.DeepSeq (force, deepseq)

76−#if MIN_VERSION_base(4,11,0)

77−import GHC.Stats (getRTSStatsEnabled, getRTSStats, RTSStats(..), gcdetails_live_bytes, gc)

78−#else

79import GHC.Stats (getGCStatsEnabled, getGCStats, GCStats(..))

76import GHC.Stats (getGCStatsEnabled, getGCStats, GCStats(..))

80−#endif

81import Data.Foldable (forM_)

77import Data.Foldable (forM_)

82#endif

78#endif

83

79

84−#ifndef ghcjs_HOST_OS

85−#if MIN_VERSION_base(4,11,0)

86−currentBytesUsed = gcdetails_live_bytes . gc

87−#else

88−getRTSStatsEnabled = getGCStatsEnabled

89−getRTSStats = getGCStats

90−#endif

91−#endif

92−

93-- | Enable (or disable) JSaddle logging

80-- | Enable (or disable) JSaddle logging

94enableLogging :: Bool -> JSM ()

81enableLogging :: Bool -> JSM ()

95#ifdef ghcjs_HOST_OS

82#ifdef ghcjs_HOST_OS

@@ -206,8 +193,8 @@ runJavaScript sendBatch entryPoint = do

206 logInfo s =

193 logInfo s =

207 readIORef loggingEnabled >>= \case

194 readIORef loggingEnabled >>= \case

208 True -> do

195 True -> do

209− currentBytesUsedStr <- getRTSStatsEnabled >>= \case

196+ currentBytesUsedStr <- getGCStatsEnabled >>= \case

210− True -> show . currentBytesUsed <$> getRTSStats

197+ True -> show . currentBytesUsed <$> getGCStats

211 False -> return "??"

198 False -> return "??"

212 cbCount <- M.size <$> readTVarIO callbacks

199 cbCount <- M.size <$> readTVarIO callbacks

213 putStrLn . s $ "M " <> currentBytesUsedStr <> " CB " <> show cbCount <> " "

200 putStrLn . s $ "M " <> currentBytesUsedStr <> " CB " <> show cbCount <> " "

@@ -227,11 +214,10 @@ runJavaScript sendBatch entryPoint = do

227 zipWithM_ putMVar resultMVars results

214 zipWithM_ putMVar resultMVars results

228 forM_ callbacksToFree $ \(JSValueReceived val) ->

215 forM_ callbacksToFree $ \(JSValueReceived val) ->

229 atomically (modifyTVar' callbacks (M.delete val))

216 atomically (modifyTVar' callbacks (M.delete val))

230− (_, Failure callbacksToFree results exception err) -> do

217+ (_, Failure callbacksToFree results exception) -> do

231 -- The exception will only be rethrown in Haskell if/when one of the

218 -- The exception will only be rethrown in Haskell if/when one of the

232 -- missing results (if any) is evaluated.

219 -- missing results (if any) is evaluated.

233 putStrLn "A JavaScript exception was thrown! (may not reach Haskell code)"

220 putStrLn "A JavaScript exception was thrown! (may not reach Haskell code)"

234− putStrLn err

235 zipWithM_ putMVar resultMVars $ results <> repeat (ThrowJSValue exception)

221 zipWithM_ putMVar resultMVars $ results <> repeat (ThrowJSValue exception)

236 forM_ callbacksToFree $ \(JSValueReceived val) ->

222 forM_ callbacksToFree $ \(JSValueReceived val) ->

237 atomically (modifyTVar' callbacks (M.delete val))

223 atomically (modifyTVar' callbacks (M.delete val))

jsaddle/src/Language/Javascript/JSaddle/Run/Files.hs+38−7

@@ -13,6 +13,7 @@

13

14module Language.Javascript.JSaddle.Run.Files (

15 indexHtml

16+ , jsaddleJs

16 , initState

17 , initState

17 , runBatch

18 , runBatch

18 , ghcjsHelpers

19 , ghcjsHelpers

@@ -41,7 +42,7 @@ initState = "\

41 \ jsaddle_values.set(1, undefined);\n\

42 \ jsaddle_values.set(1, undefined);\n\

42 \ jsaddle_values.set(2, false);\n\

43 \ jsaddle_values.set(2, false);\n\

43 \ jsaddle_values.set(3, true);\n\

44 \ jsaddle_values.set(3, true);\n\

44− \ jsaddle_values.set(4, globalThis);\n\

45+ \ jsaddle_values.set(4, window);\n\

45 \ var jsaddle_index = 100;\n\

46 \ var jsaddle_index = 100;\n\

46 \ var expectedBatch = 1;\n\

47 \ var expectedBatch = 1;\n\

47 \ var lastResults = [0, {\"tag\": \"Success\", \"contents\": [[], []]}];\n\

48 \ var lastResults = [0, {\"tag\": \"Success\", \"contents\": [[], []]}];\n\

@@ -93,10 +94,6 @@ runBatch send sendSync = "\

93 \ var n = d.contents[1];\n\

94 \ var n = d.contents[1];\n\

94 \ jsaddle_values.set(n, d.contents[0]);\n\

95 \ jsaddle_values.set(n, d.contents[0]);\n\

95 \ break;\n\

96 \ break;\n\

96− \ case \"JSONValueToValue\":\n\

97− \ var n = d.contents[1];\n\

98− \ jsaddle_values.set(n, d.contents[0]);\n\

99− \ break;\n\

100 \ case \"GetPropertyByName\":\n\

97 \ case \"GetPropertyByName\":\n\

101 \ var n = d.contents[2];\n\

98 \ var n = d.contents[2];\n\

102 \ jsaddle_values.set(n, jsaddle_values.get(d.contents[0])[d.contents[1]]);\n\

99 \ jsaddle_values.set(n, jsaddle_values.get(d.contents[0])[d.contents[1]]);\n\

@@ -315,8 +312,7 @@ runBatch send sendSync = "\

315 \ catch (err) {\n\

312 \ catch (err) {\n\

316 \ var n = ++jsaddle_index;\n\

313 \ var n = ++jsaddle_index;\n\

317 \ jsaddle_values.set(n, err);\n\

314 \ jsaddle_values.set(n, err);\n\

318− \ console.log(err);\n\

319− \ " <> send "{\"tag\": \"BatchResults\", \"contents\": [batch[2], {\"tag\": \"Failure\", \"contents\": [callbacksToFree, results, n, String(err)]}]}" <> "\n\

315+ \ " <> send "{\"tag\": \"BatchResults\", \"contents\": [batch[2], {\"tag\": \"Failure\", \"contents\": [callbacksToFree, results, n]}]}" <> "\n\

320 \ }\n\

316 \ }\n\

321 \ if(inCallback == 1) {\n\

317 \ if(inCallback == 1) {\n\

322 \ while(asyncBatch !== null) {\n\

318 \ while(asyncBatch !== null) {\n\

@@ -337,6 +333,41 @@ runBatch send sendSync = "\

337 \ runBatch(batch);\n\

333 \ runBatch(batch);\n\

338 \"

334 \"

339

335

336+-- Use this to generate this string for embedding

337+-- sed -e 's|\\|\\\\|g' -e 's|^| \\|' -e 's|$|\\n\\|' -e 's|"|\\"|g' data/jsaddle.js | pbcopy

338+jsaddleJs :: ByteString

339+jsaddleJs = "\

340+ \if(typeof global !== \"undefined\") {\n\

341+ \ global.window = global;\n\

342+ \ global.WebSocket = require('ws');\n\

343+ \}\n\

344+ \\n\

345+ \var connect = function() {\n\

346+ \ var wsaddress =\n\

347+ \ typeof window.location === \"undefined\"\n\

348+ \ ? \"ws://localhost:3709/\"\n\

349+ \ : window.location.protocol.replace('http', 'ws')+\"//\"+window.location.hostname+(window.location.port?(\":\"+window.location.port):\"\");\n\

350+ \\n\

351+ \ var ws = new WebSocket(wsaddress);\n\

352+ \\n\

353+ \ ws.onopen = function(e) {\n\

354+ \ " <> initState <> "\

355+ \\n\

356+ \ ws.onmessage = function(e) {\n\

357+ \ var batch = JSON.parse(e.data);\n\

358+ \\n\

359+ \ " <> runBatch (\a -> "ws.send(JSON.stringify(" <> a <> "));") Nothing <> "\

360+ \ };\n\

361+ \ };\n\

362+ \ ws.onerror = function() {\n\

363+ \ setTimeout(connect, 1000);\n\

364+ \ };\n\

365+ \}\n\

366+ \\n\

367+ \ " <> ghcjsHelpers <> "\

368+ \connect();\n\

369+ \"

370+

340ghcjsHelpers :: ByteString

371ghcjsHelpers :: ByteString

341ghcjsHelpers = "\

372ghcjsHelpers = "\

342 \function h$isNumber(o) {\

373 \function h$isNumber(o) {\

jsaddle/src/Language/Javascript/JSaddle/Types.hs+2−10

@@ -124,7 +124,6 @@ import Data.Aeson

124 (defaultOptions, genericToEncoding, ToJSON(..), FromJSON(..), Value)

125import GHC.Generics (Generic)

126import Control.Monad.IO.Unlift (MonadUnliftIO)

127−import qualified Control.Monad.Fail as Fail

128#endif

127#endif

129

128

130#if MIN_VERSION_base(4,9,0) && defined(CHECK_UNCHECKED)

129#if MIN_VERSION_base(4,9,0) && defined(CHECK_UNCHECKED)

@@ -166,7 +165,7 @@ data JSContextRef = JSContextRef {

166type JSM = IO

165type JSM = IO

167#else

166#else

168newtype JSM a = JSM { unJSM :: ReaderT JSContextRef IO a }

167newtype JSM a = JSM { unJSM :: ReaderT JSContextRef IO a }

169− deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadThrow, MonadUnliftIO, Fail.MonadFail)

168+ deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadThrow, MonadUnliftIO)

170

169

171instance MonadCatch JSM where

170instance MonadCatch JSM where

172 t `catch` c = JSM (unJSM (syncAfter t) `catch` \e -> unJSM (c e))

171 t `catch` c = JSM (unJSM (syncAfter t) `catch` \e -> unJSM (c e))

@@ -179,13 +178,6 @@ instance MonadMask JSM where

179 JSM $ uninterruptibleMask $ \unmask -> unJSM (a $ q unmask)

178 JSM $ uninterruptibleMask $ \unmask -> unJSM (a $ q unmask)

180 where q :: (ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a) -> JSM a -> JSM a

179 where q :: (ReaderT JSContextRef IO a -> ReaderT JSContextRef IO a) -> JSM a -> JSM a

181 q unmask (JSM b) = syncAfter . JSM $ unmask b

180 q unmask (JSM b) = syncAfter . JSM $ unmask b

182−#if MIN_VERSION_exceptions(0,9,0)

183− generalBracket acquire release use =

184− JSM $ generalBracket

185− (unJSM acquire)

186− (\resource exitCase -> unJSM $ release resource exitCase)

187− (unJSM . syncAfter . use)

188−#endif

189

181

190#endif

182#endif

191

183

@@ -504,7 +496,7 @@ instance ToJSON Result where

504instance FromJSON Result

496instance FromJSON Result

505

497

506data BatchResults = Success [JSValueReceived] [Result]

498data BatchResults = Success [JSValueReceived] [Result]

507− | Failure [JSValueReceived] [Result] JSValueReceived String

499+ | Failure [JSValueReceived] [Result] JSValueReceived

508 deriving (Show, Generic)

500 deriving (Show, Generic)

509

501

510instance ToJSON BatchResults where

502instance ToJSON BatchResults where

nix/hix.nixdeleted−8

@@ -1,8 +0,0 @@

1−{pkgs, ...}:

2−{ modules = [({pkgs, ...}: {

3− packages.webkit2gtk3-javascriptcore.components.library.doHaddock = false;

4− })];

5− shell.buildInputs = [ pkgs.nodejs ];

6− shell.tools.cabal = {};

7− shell.crossPlatforms = p: [ p.ghcjs ];

8−}

travis/build.sh+12−2

@@ -6,8 +6,18 @@ GHCVER=`ghc --numeric-version`

6

7JSADDLE_WARP_VERSION=`head -n2 jsaddle-warp/jsaddle-warp.cabal | tail -n1 | sed 's/[^0-9.]//g'`

8

9+if [[ -d .cabal && -d .ghc ]]; then

10+ cp -a .cabal .ghc /root

11+fi

12+

9cabal update

13cabal update

10−cabal new-build 'jsaddle-warp:lib:jsaddle-warp' 'jsaddle-warp:test:test-tool'

14+cabal new-build --constraint='Cabal>=1.24.2.0' 'jsaddle-warp:lib:jsaddle-warp' 'jsaddle-warp:test:test-tool'

11cd jsaddle-warp

15cd jsaddle-warp

12−GHC_PACKAGE_PATH=/opt/ghc/$GHCVER/lib/ghc-$GHCVER/package.conf.d:~/.cabal/store/ghc-$GHCVER/package.db:../dist-newstyle/packagedb/ghc-$GHCVER ../dist-newstyle/build/x86_64-linux/ghc-$GHCVER/jsaddle-warp-$JSADDLE_WARP_VERSION/t/test-tool/build/test-tool/test-tool ../jsaddle

16+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 ../jsaddle-warp

17+

18+# update the cache

19+rm -rf .cabal

20+cp -a /root/.cabal ./

21+rm -rf .ghc

22+cp -a /root/.ghc ./

13

23