baa85a4 · reflex-dom · git.iko.soy

hydra.jsonnew file+29

compare with develop

unifiedsplit

@@ -0,0 +1,29 @@

1+{

2+ "enabled": 1,

3+ "hidden": true,

4+ "description": "Jobsets",

5+ "nixexprinput": "src",

6+ "nixexprpath": "jobsets.nix",

7+ "checkinterval": 300,

8+ "schedulingshares": 100,

9+ "enableemail": false,

10+ "emailoverride": "",

11+ "keepnr": 10,

12+ "inputs": {

13+ "src": {

14+ "type": "git",

15+ "value": "https://github.com/reflex-frp/reflex-dom.git develop",

16+ "emailresponsible": false

17+ },

18+ "nixpkgs": {

19+ "type": "git",

20+ "value": "https://github.com/NixOS/nixpkgs-channels nixos-unstable",

21+ "emailresponsible": false

22+ },

23+ "prs": {

24+ "type": "githubpulls",

25+ "value": "reflex-frp reflex-dom",

26+ "emailresponsible": false

27+ }

28+ }

29+}

jobsets.nixnew file+70

@@ -0,0 +1,70 @@

1+{ prs }:

2+

3+let

4+ pkgs = (import ./reflex-platform.nix {}).nixpkgs;

5+ mkFetchGithub = value: {

6+ inherit value;

7+ type = "git";

8+ emailresponsible = false;

9+ };

10+in

11+with pkgs.lib;

12+let

13+ defaults = jobs: {

14+ inherit (jobs) description;

15+ enabled = 1;

16+ hidden = false;

17+ keepnr = 10;

18+ schedulingshares = 100;

19+ checkinterval = 120;

20+ enableemail = false;

21+ emailoverride = "";

22+ nixexprinput = "reflex-dom";

23+ nixexprpath = "release.nix";

24+ inputs = jobs.inputs // {

25+ nixpkgs = {

26+ type = "git";

27+ value = "https://github.com/NixOS/nixpkgs-channels nixos-unstable";

28+ emailresponsible = false;

29+ };

30+ config = {

31+ type = "nix";

32+ value = "{ android_sdk.accept_license = true; }";

33+ emailresponsible = false;

34+ };

35+ };

36+ };

37+ branchJobset = branch: defaults {

38+ description = "reflex-dom-${branch}";

39+ inputs = {

40+ reflex-dom = {

41+ value = "https://github.com/reflex-frp/reflex-dom ${branch}";

42+ type = "git";

43+ emailresponsible = false;

44+ };

45+ };

46+ };

47+ makePr = num: info: {

48+ name = "reflex-dom-pr-${num}";

49+ value = defaults {

50+ description = "#${num}: ${info.title}";

51+ inputs = {

52+ reflex-dom = {

53+ #NOTE: This should really use "pull/${num}/merge"; however, GitHub's

54+ #status checks only operate on PR heads. This creates a race

55+ #condition, which can currently only be solved by requiring PRs to be

56+ #up to date before they're merged. See

57+ #https://github.com/isaacs/github/issues/1002

58+ value = "https://github.com/reflex-frp/reflex-dom pull/${num}/head";

59+ type = "git";

60+ emailresponsible = false;

61+ };

62+ };

63+ };

64+ };

65+ processedPrs = mapAttrs' makePr (builtins.fromJSON (builtins.readFile prs));

66+ jobsetsAttrs = processedPrs //

67+ genAttrs ["develop"] branchJobset;

68+in {

69+ jobsets = pkgs.writeText "spec.json" (builtins.toJSON jobsetsAttrs);

70+}

reflex-dom-core/src/Reflex/Dom/WebSocket.hs+12−4

@@ -55,6 +55,7 @@ import Data.Text

55import Data.Text.Encoding

56import Foreign.JavaScript.Utils (jsonDecode)

57import GHCJS.DOM.Types (runJSM, askJSM, MonadJSM, liftJSM, JSM)

58+import GHCJS.DOM.WebSocket (getReadyState)

58import GHCJS.Marshal

59import GHCJS.Marshal

59import qualified Language.Javascript.JSaddle.Monad as JS (catch)

60import qualified Language.Javascript.JSaddle.Monad as JS (catch)

60

61

@@ -101,7 +102,7 @@ webSocket' url config onRawMessage = do

101 liftIO $ triggerEClose args

102 liftIO $ triggerEClose args

102 _ <- liftIO $ atomically $ tryTakeTMVar isOpen

103 _ <- liftIO $ atomically $ tryTakeTMVar isOpen

103 liftIO $ writeIORef currentSocketRef Nothing

104 liftIO $ writeIORef currentSocketRef Nothing

104− when (_webSocketConfig_reconnect config) $ do

105+ when (_webSocketConfig_reconnect config) $ forkJSM $ do

105 liftIO $ threadDelay 1000000

106 liftIO $ threadDelay 1000000

106 start

107 start

107 start = do

108 start = do

@@ -127,9 +128,11 @@ webSocket' url config onRawMessage = do

127 mws <- liftIO $ readIORef currentSocketRef

128 mws <- liftIO $ readIORef currentSocketRef

128 success <- case mws of

129 success <- case mws of

129 Nothing -> return False

130 Nothing -> return False

131+ Just ws -> flip runJSM ctx $ do

132+ rs <- getReadyState $ unWebSocket ws

133+ if rs == 1

130− Just ws -> runJSM ((webSocketSend ws payload >> return True)

134+ then (webSocketSend ws payload >> return True) `JS.catch` (\(_ :: SomeException) -> return False)

131− `JS.catch`

135+ else return False

132− (\(_ :: SomeException) -> return False)) ctx

133 unless success $ atomically $ unGetTQueue payloadQueue payload

136 unless success $ atomically $ unGetTQueue payloadQueue payload

134 return $ RawWebSocket eRecv eOpen eError eClose

137 return $ RawWebSocket eRecv eOpen eError eClose

135

138

@@ -141,6 +144,11 @@ jsonWebSocket url cfg = do

141 ws <- textWebSocket url $ cfg { _webSocketConfig_send = fmap (decodeUtf8 . toStrict . encode) <$> _webSocketConfig_send cfg }

144 ws <- textWebSocket url $ cfg { _webSocketConfig_send = fmap (decodeUtf8 . toStrict . encode) <$> _webSocketConfig_send cfg }

142 return ws { _webSocket_recv = jsonDecode . textToJSString <$> _webSocket_recv ws }

145 return ws { _webSocket_recv = jsonDecode . textToJSString <$> _webSocket_recv ws }

143

146

147+forkJSM :: JSM () -> JSM ()

148+forkJSM a = do

149+ jsm <- askJSM

150+ void $ liftIO $ forkIO $ runJSM a jsm

151+

144#ifdef USE_TEMPLATE_HASKELL

152#ifdef USE_TEMPLATE_HASKELL

145makeLensesWith (lensRules & simpleLenses .~ True) ''WebSocketConfig

153makeLensesWith (lensRules & simpleLenses .~ True) ''WebSocketConfig

146makeLensesWith (lensRules & simpleLenses .~ True) ''RawWebSocket

154makeLensesWith (lensRules & simpleLenses .~ True) ''RawWebSocket

reflex-dom-core/src/Reflex/Dom/WebSocket/Foreign.hs+37−23

@@ -12,7 +12,6 @@ module Reflex.Dom.WebSocket.Foreign

12

13import Prelude hiding (all, concat, concatMap, div, mapM, mapM_, sequence, span)

14

15−import Control.Monad.Reader

16import Data.Bifoldable

15import Data.Bifoldable

17import Data.ByteString (ByteString)

16import Data.ByteString (ByteString)

18import qualified Data.ByteString.Lazy as LBS

17import qualified Data.ByteString.Lazy as LBS

@@ -20,12 +19,11 @@ import Data.Text (Text)

20import Data.Text.Encoding

19import Data.Text.Encoding

21import Foreign.JavaScript.Utils (bsFromMutableArrayBuffer, bsToArrayBuffer)

20import Foreign.JavaScript.Utils (bsFromMutableArrayBuffer, bsToArrayBuffer)

22import GHCJS.DOM.CloseEvent

21import GHCJS.DOM.CloseEvent

23−import GHCJS.DOM.EventM (on)

24import GHCJS.DOM.MessageEvent

22import GHCJS.DOM.MessageEvent

25−import GHCJS.DOM.Types (JSM, JSVal, liftJSM, fromJSValUnchecked)

23+import GHCJS.DOM.Types (JSM, JSVal, liftJSM, fromJSValUnchecked, WebSocket(..))

26−import GHCJS.DOM.WebSocket (WebSocket)

27import qualified GHCJS.DOM.WebSocket as DOM

24import qualified GHCJS.DOM.WebSocket as DOM

28import GHCJS.Foreign (JSType(..), jsTypeOf)

25import GHCJS.Foreign (JSType(..), jsTypeOf)

26+import Language.Javascript.JSaddle (fun, eval, toJSVal, call)

29import Language.Javascript.JSaddle.Helper (mutableArrayBufferFromJSVal)

27import Language.Javascript.JSaddle.Helper (mutableArrayBufferFromJSVal)

30import Language.Javascript.JSaddle.Types (ghcjsPure)

28import Language.Javascript.JSaddle.Types (ghcjsPure)

31

29

@@ -64,25 +62,41 @@ newWebSocket

64 -> ((Bool, Word, Text) -> JSM ()) -- onclose

62 -> ((Bool, Word, Text) -> JSM ()) -- onclose

65 -> JSM JSWebSocket

63 -> JSM JSWebSocket

66newWebSocket _ url protocols onMessage onOpen onError onClose = do

64newWebSocket _ url protocols onMessage onOpen onError onClose = do

67− ws <- DOM.newWebSocket url protocols

65+ let onOpenWrapped = fun $ \_ _ _ -> onOpen

68− DOM.setBinaryType ws "arraybuffer"

66+ onErrorWrapped = fun $ \_ _ _ -> onError

69− _ <- on ws DOM.open $ liftJSM onOpen

67+ onCloseWrapped = fun $ \_ _ (e:_) -> do

70− _ <- on ws DOM.error $ liftJSM onError

68+ let e' = CloseEvent e

71− _ <- on ws DOM.closeEvent $ do

72− e <- ask

73− wasClean <- getWasClean e

69+ wasClean <- getWasClean e'

74− code <- getCode e

70+ code <- getCode e'

75− reason <- getReason e

71+ reason <- getReason e'

76− liftJSM $ onClose (wasClean, code, reason)

72+ liftJSM $ onClose (wasClean, code, reason)

77− _ <- on ws DOM.message $ do

73+ onMessageWrapped = fun $ \_ _ (e:_) -> do

78− e <- ask

74+ let e' = MessageEvent e

79− d <- getData e

75+ d <- getData e'

80− liftJSM $ ghcjsPure (jsTypeOf d) >>= \case

76+ liftJSM $ ghcjsPure (jsTypeOf d) >>= \case

81− String -> onMessage $ Right d

77+ String -> onMessage $ Right d

82− _ -> do

78+ _ -> do

83− ab <- mutableArrayBufferFromJSVal d

79+ ab <- mutableArrayBufferFromJSVal d

84− bsFromMutableArrayBuffer ab >>= onMessage . Left

80+ bsFromMutableArrayBuffer ab >>= onMessage . Left

81+ newWS <- eval $ unlines

82+ [ "(function(url, protos, open, error, close, message) {"

83+ , " var ws = new window['WebSocket'](url, protos);"

84+ , " ws['binaryType'] = 'arraybuffer';"

85+ , " ws['addEventListener']('open', open);"

86+ , " ws['addEventListener']('error', error);"

87+ , " ws['addEventListener']('close', close);"

88+ , " ws['addEventListener']('message', message);"

89+ , " return ws;"

90+ , "})"

91+ ]

92+ url' <- toJSVal url

93+ protocols' <- toJSVal protocols

94+ onOpen' <- toJSVal onOpenWrapped

95+ onError' <- toJSVal onErrorWrapped

96+ onClose' <- toJSVal onCloseWrapped

97+ onMessage' <- toJSVal onMessageWrapped

98+ ws <- call newWS newWS [url', protocols', onOpen', onError', onClose', onMessage']

85− return $ JSWebSocket ws

99+ return $ JSWebSocket $ WebSocket ws

86

100

87onBSMessage :: Either ByteString JSVal -> JSM ByteString

101onBSMessage :: Either ByteString JSVal -> JSM ByteString

88onBSMessage = either return $ fmap encodeUtf8 . fromJSValUnchecked

102onBSMessage = either return $ fmap encodeUtf8 . fromJSValUnchecked

reflex-dom/reflex-dom.cabal+4−1

@@ -1,7 +1,10 @@

1Name: reflex-dom

2Version: 0.4

3Synopsis: Functional Reactive Web Apps with Reflex

4+Description:

4−Description: Reflex-DOM is a Functional Reactive web framework based on the Reflex FRP engine

5+ Reflex-DOM is a Functional Reactive web framework based on the Reflex FRP engine.

6+ .

7+ For hackage documentation, please see: <https://hackage.haskell.org/package/reflex-dom-core>.

5License: BSD3

8License: BSD3

6License-file: LICENSE

9License-file: LICENSE

7Author: Ryan Trinkle

10Author: Ryan Trinkle

reflex-platform.nixnew file+8

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

1+let

2+ reflex-platform-src = (import <nixpkgs> {}).fetchFromGitHub {

3+ owner = "reflex-frp";

4+ repo = "reflex-platform";

5+ rev = "384cd850f3adf1d404bced2424b5f6efb0f415f2";

6+ sha256 = "1ws77prqx8khmp8j6br1ij4k2v4dlgv170r9fmg0p1jivfbn8y9d";

7+ };

8+in import reflex-platform-src

release.nixnew file+12

@@ -0,0 +1,12 @@

1+{ rp ? import ./reflex-platform.nix {}

2+}:

3+let

4+ inherit (rp.nixpkgs) lib;

5+ systems = ["x86_64-linux" "x86_64-darwin"];

6+ compilers = ["ghc8_4" "ghc8_0" "ghcjs8_4" "ghcjs8_0"];

7+in lib.genAttrs systems (system:

8+ lib.genAttrs compilers (ghc: let

9+ reflex-platform = import ./reflex-platform.nix { inherit system; };

10+ hsPkgs = reflex-platform.${ghc};

11+ in { inherit (import ./. hsPkgs reflex-platform.nixpkgs) reflex-dom reflex-dom-core; })

12+)