e5983b8 · reflex-dom · git.iko.soy

reflex-dom-core/src/Foreign/JavaScript/Orphans.hs+1−1

compare with develop

unifiedsplit

@@ -3,7 +3,7 @@

3{-# OPTIONS_GHC -fno-warn-orphans #-}

4module Foreign.JavaScript.Orphans where

5

6−#ifndef __GHCJS__

6+#ifndef ghcjs_HOST_OS

7

8import Control.Monad.Trans.Class (lift)

9import GHCJS.DOM.Types (MonadJSM(..))

reflex-dom-core/src/Foreign/JavaScript/TH.hs+9−11

@@ -15,7 +15,7 @@

15{-# LANGUAGE TypeSynonymInstances #-}

16{-# LANGUAGE UndecidableInstances #-}

17{-# LANGUAGE ConstraintKinds #-}

18−#ifdef __GHCJS__

18+#ifdef ghcjs_HOST_OS

19{-# LANGUAGE ForeignFunctionInterface #-}

20{-# LANGUAGE JavaScriptFFI #-}

21#endif

@@ -41,17 +41,14 @@ import Language.Haskell.TH

41#endif

42

43import GHCJS.DOM.Types

44− (toJSString, liftJSM, askJSM, runJSM, JSContextRef,

44+ (askJSM, JSContextRef, Node(..))

45− Node(..), MonadJSM(..), toJSVal, JSVal)

45+#ifdef ghcjs_HOST_OS

46−#ifdef __GHCJS__

46+import GHCJS.DOM.Types (MonadJSM)

47import qualified GHCJS.Buffer as JS

48import qualified GHCJS.DOM.Types as JS

49import qualified GHCJS.Foreign as JS

50import qualified GHCJS.Foreign.Callback as JS

51import qualified GHCJS.Foreign.Callback.Internal (Callback (..))

52−import qualified GHCJS.Marshal as JS

53−import qualified GHCJS.Marshal.Pure as JS

54−import qualified GHCJS.Types as JS

55import qualified JavaScript.Array as JS

52import qualified JavaScript.Array as JS

56import qualified JavaScript.Array.Internal (SomeJSArray (..))

53import qualified JavaScript.Array.Internal (SomeJSArray (..))

57import qualified JavaScript.Object as JS

54import qualified JavaScript.Object as JS

@@ -64,6 +61,7 @@ import Foreign.C.Types

64import Foreign.Ptr

61import Foreign.Ptr

65import Text.Encoding.Z

62import Text.Encoding.Z

66#else

63#else

64+import GHCJS.DOM.Types (MonadJSM(..), runJSM, liftJSM, toJSString, toJSVal, JSVal)

67import Data.Word (Word8)

65import Data.Word (Word8)

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

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

69import Language.Javascript.JSaddle

67import Language.Javascript.JSaddle

@@ -210,7 +208,7 @@ withJSContextSingletonMono f = askJSM >>= f . JSContextSingleton

210-- | A singleton type for a given JSContext; we use this to statically guarantee that different JSContexts don't get mixed up

208-- | A singleton type for a given JSContext; we use this to statically guarantee that different JSContexts don't get mixed up

211newtype JSContextSingleton x = JSContextSingleton { unJSContextSingleton :: JSContextRef }

209newtype JSContextSingleton x = JSContextSingleton { unJSContextSingleton :: JSContextRef }

212

210

213−#ifdef __GHCJS__

211+#ifdef ghcjs_HOST_OS

214type JSFFI_Internal = JS.MutableJSArray -> IO JS.JSVal

212type JSFFI_Internal = JS.MutableJSArray -> IO JS.JSVal

215newtype JSFFI = JSFFI JSFFI_Internal

213newtype JSFFI = JSFFI JSFFI_Internal

216#else

214#else

@@ -218,7 +216,7 @@ newtype JSFFI = JSFFI String

218#endif

216#endif

219

217

220data JSFun x = JSFun { unJSFun :: JSRef x

218data JSFun x = JSFun { unJSFun :: JSRef x

221−#ifndef __GHCJS__

219+#ifndef ghcjs_HOST_OS

222 , unJSFunction :: Function

220 , unJSFunction :: Function

223#endif

221#endif

224 }

222 }

@@ -277,7 +275,7 @@ class Monad m => MonadJS x m | m -> x where

277 getJSProp :: String -> JSRef x -> m (JSRef x)

275 getJSProp :: String -> JSRef x -> m (JSRef x)

278 withJSNode :: Node -> (JSRef x -> m r) -> m r

276 withJSNode :: Node -> (JSRef x -> m r) -> m r

279

277

280−#ifdef __GHCJS__

278+#ifdef ghcjs_HOST_OS

281

279

282data JSCtx_IO

280data JSCtx_IO

283

281

@@ -536,7 +534,7 @@ importJS safety body name qt = do

536 ]

534 ]

537

535

538mkJSFFI :: Safety -> String -> Q ([Dec], Exp)

536mkJSFFI :: Safety -> String -> Q ([Dec], Exp)

539−#ifdef __GHCJS__

537+#ifdef ghcjs_HOST_OS

540mkJSFFI safety body = do

538mkJSFFI safety body = do

541 -- n <- newName "jsffi" --TODO: Should use newName, but that doesn't seem to work with ghcjs

539 -- n <- newName "jsffi" --TODO: Should use newName, but that doesn't seem to work with ghcjs

542 l <- location

540 l <- location

reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+8−6

@@ -136,7 +136,7 @@ import qualified GHCJS.DOM.TouchList as TouchList

136import GHCJS.DOM.Node (appendChild_, getOwnerDocumentUnchecked, getParentNodeUnchecked, setNodeValue, toNode)

137import qualified GHCJS.DOM.Node as DOM (insertBefore_)

138import GHCJS.DOM.Types

139− (liftJSM, askJSM, runJSM, JSM, MonadJSM(..),

139+ (liftJSM, askJSM, runJSM, JSM, MonadJSM,

140 FocusEvent, IsElement, IsEvent, IsNode, KeyboardEvent, Node,

141 ToDOMString, TouchEvent, WheelEvent, uncheckedCastTo, ClipboardEvent)

142import qualified GHCJS.DOM.Types as DOM

@@ -149,6 +149,13 @@ import Reflex.Requester.Base

149import Reflex.Requester.Class

150import Foreign.JavaScript.Internal.Utils

151

152+#ifndef ghcjs_HOST_OS

153+import GHCJS.DOM.Types (MonadJSM (..))

154+

155+instance MonadJSM m => MonadJSM (ImmediateDomBuilderT t m) where

156+ liftJSM' = ImmediateDomBuilderT . liftJSM'

157+#endif

158+

152data ImmediateDomBuilderEnv t

159data ImmediateDomBuilderEnv t

153 = ImmediateDomBuilderEnv { _immediateDomBuilderEnv_document :: Document

160 = ImmediateDomBuilderEnv { _immediateDomBuilderEnv_document :: Document

154 , _immediateDomBuilderEnv_parent :: Node

161 , _immediateDomBuilderEnv_parent :: Node

@@ -163,11 +170,6 @@ newtype ImmediateDomBuilderT t m a = ImmediateDomBuilderT { unImmediateDomBuilde

163#endif

170#endif

164 )

171 )

165

172

166−#ifndef __GHCJS__

167−instance MonadJSM m => MonadJSM (ImmediateDomBuilderT t m) where

168− liftJSM' = ImmediateDomBuilderT . liftJSM'

169−#endif

170−

171instance PrimMonad m => PrimMonad (ImmediateDomBuilderT x m) where

173instance PrimMonad m => PrimMonad (ImmediateDomBuilderT x m) where

172 type PrimState (ImmediateDomBuilderT x m) = PrimState m

174 type PrimState (ImmediateDomBuilderT x m) = PrimState m

173 primitive = lift . primitive

175 primitive = lift . primitive

reflex-dom-core/src/Reflex/Dom/WebSocket.hs−6

@@ -71,12 +71,6 @@ data RawWebSocket t a

71 )

72 }

73

74−-- This can be used to send either binary or text messages for the same websocket connection

75−instance (IsWebSocketMessage a, IsWebSocketMessage b) => IsWebSocketMessage (Either a b) where

76− webSocketSend jws (Left a) = webSocketSend jws a

77− webSocketSend jws (Right a) = webSocketSend jws a

78−

79−

80webSocket :: (MonadJSM m, MonadJSM (Performable m), HasJSContext m, PerformEvent t m, TriggerEvent t m, PostBuild t m, IsWebSocketMessage a) => Text -> WebSocketConfig t a -> m (WebSocket t)

74webSocket :: (MonadJSM m, MonadJSM (Performable m), HasJSContext m, PerformEvent t m, TriggerEvent t m, PostBuild t m, IsWebSocketMessage a) => Text -> WebSocketConfig t a -> m (WebSocket t)

81webSocket url config = webSocket' url config onBSMessage

75webSocket url config = webSocket' url config onBSMessage

82

76

reflex-dom-core/src/Reflex/Dom/WebSocket/Foreign.hs+16−11

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

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

14

15import Control.Monad.Reader

16+import Data.Bifoldable

16import Data.ByteString (ByteString)

17import Data.ByteString (ByteString)

17import Data.Text (Text)

18import Data.Text (Text)

18import qualified Data.Text as T (unpack)

19import qualified Data.Text as T (unpack)

@@ -21,8 +22,9 @@ import Foreign.JavaScript.Utils (bsFromMutableArrayBuffer, bsToArrayBuffer)

21import GHCJS.DOM.CloseEvent

22import GHCJS.DOM.CloseEvent

22import GHCJS.DOM.EventM (on)

23import GHCJS.DOM.EventM (on)

23import GHCJS.DOM.MessageEvent

24import GHCJS.DOM.MessageEvent

24−import GHCJS.DOM.Types hiding (Text, ByteString)

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

26+import GHCJS.DOM.WebSocket (WebSocket)

25−import qualified GHCJS.DOM.WebSocket as GD

27+import qualified GHCJS.DOM.WebSocket as DOM

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

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

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

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

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

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

@@ -32,19 +34,22 @@ newtype JSWebSocket = JSWebSocket { unWebSocket :: WebSocket }

32class IsWebSocketMessage a where

34class IsWebSocketMessage a where

33 webSocketSend :: JSWebSocket -> a -> JSM ()

35 webSocketSend :: JSWebSocket -> a -> JSM ()

34

36

37+instance (IsWebSocketMessage a, IsWebSocketMessage b) => IsWebSocketMessage (Either a b) where

38+ webSocketSend jws = bitraverse_ (webSocketSend jws) (webSocketSend jws)

39+

35-- Use binary websocket communication for ByteString

40-- Use binary websocket communication for ByteString

36-- Note: Binary websockets may not work correctly in IE 11 and below

41-- Note: Binary websockets may not work correctly in IE 11 and below

37instance IsWebSocketMessage ByteString where

42instance IsWebSocketMessage ByteString where

38 webSocketSend (JSWebSocket ws) bs = do

43 webSocketSend (JSWebSocket ws) bs = do

39 ab <- bsToArrayBuffer bs

44 ab <- bsToArrayBuffer bs

40− GD.send ws ab

45+ DOM.send ws ab

41

46

42-- Use plaintext websocket communication for Text, and String

47-- Use plaintext websocket communication for Text, and String

43instance IsWebSocketMessage Text where

48instance IsWebSocketMessage Text where

44− webSocketSend (JSWebSocket ws) = GD.sendString ws . T.unpack

49+ webSocketSend (JSWebSocket ws) = DOM.sendString ws . T.unpack

45

50

46closeWebSocket :: JSWebSocket -> Word -> Text -> JSM ()

51closeWebSocket :: JSWebSocket -> Word -> Text -> JSM ()

47−closeWebSocket (JSWebSocket ws) code reason = GD.close ws (Just code) (Just reason)

52+closeWebSocket (JSWebSocket ws) code reason = DOM.close ws (Just code) (Just reason)

48

53

49newWebSocket

54newWebSocket

50 :: a

55 :: a

@@ -55,17 +60,17 @@ newWebSocket

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

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

56 -> JSM JSWebSocket

61 -> JSM JSWebSocket

57newWebSocket _ url onMessage onOpen onError onClose = do

62newWebSocket _ url onMessage onOpen onError onClose = do

58− ws <- GD.newWebSocket url ([] :: [Text])

63+ ws <- DOM.newWebSocket url ([] :: [Text])

59− GD.setBinaryType ws "arraybuffer"

64+ DOM.setBinaryType ws "arraybuffer"

60− _ <- on ws GD.open $ liftJSM onOpen

65+ _ <- on ws DOM.open $ liftJSM onOpen

61− _ <- on ws GD.error $ liftJSM onError

66+ _ <- on ws DOM.error $ liftJSM onError

62− _ <- on ws GD.closeEvent $ do

67+ _ <- on ws DOM.closeEvent $ do

63 e <- ask

68 e <- ask

64 wasClean <- getWasClean e

69 wasClean <- getWasClean e

65 code <- getCode e

70 code <- getCode e

66 reason <- getReason e

71 reason <- getReason e

67 liftJSM $ onClose (wasClean, code, reason)

72 liftJSM $ onClose (wasClean, code, reason)

68− _ <- on ws GD.message $ do

73+ _ <- on ws DOM.message $ do

69 e <- ask

74 e <- ask

70 d <- getData e

75 d <- getData e

71 liftJSM $ ghcjsPure (jsTypeOf d) >>= \case

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

reflex-dom-core/src/Reflex/Dom/Xhr/Foreign.hs+1−1

@@ -18,7 +18,7 @@ import Foreign.JavaScript.Utils (bsFromMutableArrayBuffer, bsToArrayBuffer)

18import GHCJS.DOM.Enums

19import GHCJS.DOM.EventM (EventM, on)

20import GHCJS.DOM.EventTarget (dispatchEvent)

21−import GHCJS.DOM.Types hiding (Text, ByteString)

21+import GHCJS.DOM.Types (MonadJSM, ToJSString, FormData, Document, Blob (..), ArrayBuffer (..), JSVal, JSM, IsEvent, XMLHttpRequestProgressEvent, ProgressEvent, Event, XMLHttpRequestUpload, FromJSString, ArrayBufferView (..), liftJSM, castTo)

22import GHCJS.DOM.XMLHttpRequest

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

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

reflex-dom-core/src/Reflex/Dom/Xhr/ResponseType.hs+11−11

@@ -7,15 +7,15 @@ import Data.Text (Text)

7import Data.Typeable

8import GHCJS.DOM.Blob (Blob)

9

10+data XhrResponseType

10−data XhrResponseType = XhrResponseType_Default

11+ = XhrResponseType_Default

11− | XhrResponseType_ArrayBuffer

12+ | XhrResponseType_ArrayBuffer

12− | XhrResponseType_Blob

13+ | XhrResponseType_Blob

13− | XhrResponseType_Text

14+ | XhrResponseType_Text

14− deriving (Show, Read, Eq, Ord, Typeable)

15+ deriving (Show, Read, Eq, Ord, Typeable)

15−

16−data XhrResponseBody = XhrResponseBody_Default Text

17− | XhrResponseBody_Text Text

18− | XhrResponseBody_Blob Blob

19− | XhrResponseBody_ArrayBuffer ByteString

20−-- deriving (Eq)

21

16

17+data XhrResponseBody

18+ = XhrResponseBody_Default Text

19+ | XhrResponseBody_Text Text

20+ | XhrResponseBody_Blob Blob

21+ | XhrResponseBody_ArrayBuffer ByteString