git.iko.soy/reflex-dom
on develop help sign in
Various cleanup and fixing warnings
commite5983b803c2f096ddb5ad269cd0f789d89e9953c authorRyan Trinkle <ryan.trinkle@gmail.com> dateFri 5 May 2017, 22:05 (9 years ago) parent9aff752
7 files changed+46−47
compare with develop
unifiedsplit
reflex-dom-core/src/Foreign/JavaScript/Orphans.hs+1−1 reflex-dom-core/src/Foreign/JavaScript/TH.hs+9−11 reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+8−6 reflex-dom-core/src/Reflex/Dom/WebSocket.hs−6 reflex-dom-core/src/Reflex/Dom/WebSocket/Foreign.hs+16−11 reflex-dom-core/src/Reflex/Dom/Xhr/Foreign.hs+1−1 reflex-dom-core/src/Reflex/Dom/Xhr/ResponseType.hs+11−11
reflex-dom-core/src/Foreign/JavaScript/Orphans.hs+1−1
@@ -3,7 +3,7 @@
33{-# OPTIONS_GHC -fno-warn-orphans #-}
44module Foreign.JavaScript.Orphans where
55
6−#ifndef __GHCJS__
6+#ifndef ghcjs_HOST_OS
77
88import Control.Monad.Trans.Class (lift)
99import GHCJS.DOM.Types (MonadJSM(..))
reflex-dom-core/src/Foreign/JavaScript/TH.hs+9−11
@@ -15,7 +15,7 @@
1515{-# LANGUAGE TypeSynonymInstances #-}
1616{-# LANGUAGE UndecidableInstances #-}
1717{-# LANGUAGE ConstraintKinds #-}
18−#ifdef __GHCJS__
18+#ifdef ghcjs_HOST_OS
1919{-# LANGUAGE ForeignFunctionInterface #-}
2020{-# LANGUAGE JavaScriptFFI #-}
2121#endif
@@ -41,17 +41,14 @@ import Language.Haskell.TH
4141#endif
4242
4343import GHCJS.DOM.Types
44− (toJSString, liftJSM, askJSM, runJSM, JSContextRef,
45− Node(..), MonadJSM(..), toJSVal, JSVal)
46−#ifdef __GHCJS__
44+ (askJSM, JSContextRef, Node(..))
45+#ifdef ghcjs_HOST_OS
46+import GHCJS.DOM.Types (MonadJSM)
4747import qualified GHCJS.Buffer as JS
4848import qualified GHCJS.DOM.Types as JS
4949import qualified GHCJS.Foreign as JS
5050import qualified GHCJS.Foreign.Callback as JS
5151import 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
5552import qualified JavaScript.Array as JS
5653import qualified JavaScript.Array.Internal (SomeJSArray (..))
5754import qualified JavaScript.Object as JS
@@ -64,6 +61,7 @@ import Foreign.C.Types
6461import Foreign.Ptr
6562import Text.Encoding.Z
6663#else
64+import GHCJS.DOM.Types (MonadJSM(..), runJSM, liftJSM, toJSString, toJSVal, JSVal)
6765import Data.Word (Word8)
6866import Control.Lens.Operators ((^.))
6967import Language.Javascript.JSaddle
@@ -210,7 +208,7 @@ withJSContextSingletonMono f = askJSM >>= f . JSContextSingleton
210208-- | A singleton type for a given JSContext; we use this to statically guarantee that different JSContexts don't get mixed up
211209newtype JSContextSingleton x = JSContextSingleton { unJSContextSingleton :: JSContextRef }
212210
213−#ifdef __GHCJS__
211+#ifdef ghcjs_HOST_OS
214212type JSFFI_Internal = JS.MutableJSArray -> IO JS.JSVal
215213newtype JSFFI = JSFFI JSFFI_Internal
216214#else
@@ -218,7 +216,7 @@ newtype JSFFI = JSFFI String
218216#endif
219217
220218data JSFun x = JSFun { unJSFun :: JSRef x
221−#ifndef __GHCJS__
219+#ifndef ghcjs_HOST_OS
222220 , unJSFunction :: Function
223221#endif
224222 }
@@ -277,7 +275,7 @@ class Monad m => MonadJS x m | m -> x where
277275 getJSProp :: String -> JSRef x -> m (JSRef x)
278276 withJSNode :: Node -> (JSRef x -> m r) -> m r
279277
280−#ifdef __GHCJS__
278+#ifdef ghcjs_HOST_OS
281279
282280data JSCtx_IO
283281
@@ -536,7 +534,7 @@ importJS safety body name qt = do
536534 ]
537535
538536mkJSFFI :: Safety -> String -> Q ([Dec], Exp)
539−#ifdef __GHCJS__
537+#ifdef ghcjs_HOST_OS
540538mkJSFFI safety body = do
541539 -- n <- newName "jsffi" --TODO: Should use newName, but that doesn't seem to work with ghcjs
542540 l <- location
reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+8−6
@@ -136,7 +136,7 @@ import qualified GHCJS.DOM.TouchList as TouchList
136136import GHCJS.DOM.Node (appendChild_, getOwnerDocumentUnchecked, getParentNodeUnchecked, setNodeValue, toNode)
137137import qualified GHCJS.DOM.Node as DOM (insertBefore_)
138138import GHCJS.DOM.Types
139− (liftJSM, askJSM, runJSM, JSM, MonadJSM(..),
139+ (liftJSM, askJSM, runJSM, JSM, MonadJSM,
140140 FocusEvent, IsElement, IsEvent, IsNode, KeyboardEvent, Node,
141141 ToDOMString, TouchEvent, WheelEvent, uncheckedCastTo, ClipboardEvent)
142142import qualified GHCJS.DOM.Types as DOM
@@ -149,6 +149,13 @@ import Reflex.Requester.Base
149149import Reflex.Requester.Class
150150import Foreign.JavaScript.Internal.Utils
151151
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+
152159data ImmediateDomBuilderEnv t
153160 = ImmediateDomBuilderEnv { _immediateDomBuilderEnv_document :: Document
154161 , _immediateDomBuilderEnv_parent :: Node
@@ -163,11 +170,6 @@ newtype ImmediateDomBuilderT t m a = ImmediateDomBuilderT { unImmediateDomBuilde
163170#endif
164171 )
165172
166−#ifndef __GHCJS__
167−instance MonadJSM m => MonadJSM (ImmediateDomBuilderT t m) where
168− liftJSM' = ImmediateDomBuilderT . liftJSM'
169−#endif
170−
171173instance PrimMonad m => PrimMonad (ImmediateDomBuilderT x m) where
172174 type PrimState (ImmediateDomBuilderT x m) = PrimState m
173175 primitive = lift . primitive
reflex-dom-core/src/Reflex/Dom/WebSocket.hs−6
@@ -71,12 +71,6 @@ data RawWebSocket t a
7171 )
7272 }
7373
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−
8074webSocket :: (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)
8175webSocket url config = webSocket' url config onBSMessage
8276
reflex-dom-core/src/Reflex/Dom/WebSocket/Foreign.hs+16−11
@@ -13,6 +13,7 @@ module Reflex.Dom.WebSocket.Foreign
1313import Prelude hiding (all, concat, concatMap, div, mapM, mapM_, sequence, span)
1414
1515import Control.Monad.Reader
16+import Data.Bifoldable
1617import Data.ByteString (ByteString)
1718import Data.Text (Text)
1819import qualified Data.Text as T (unpack)
@@ -21,8 +22,9 @@ import Foreign.JavaScript.Utils (bsFromMutableArrayBuffer, bsToArrayBuffer)
2122import GHCJS.DOM.CloseEvent
2223import GHCJS.DOM.EventM (on)
2324import GHCJS.DOM.MessageEvent
24−import GHCJS.DOM.Types hiding (Text, ByteString)
25−import qualified GHCJS.DOM.WebSocket as GD
25+import GHCJS.DOM.Types (JSM, JSVal, liftJSM, fromJSValUnchecked)
26+import GHCJS.DOM.WebSocket (WebSocket)
27+import qualified GHCJS.DOM.WebSocket as DOM
2628import GHCJS.Foreign (JSType(..), jsTypeOf)
2729import Language.Javascript.JSaddle.Helper (mutableArrayBufferFromJSVal)
2830import Language.Javascript.JSaddle.Types (ghcjsPure)
@@ -32,19 +34,22 @@ newtype JSWebSocket = JSWebSocket { unWebSocket :: WebSocket }
3234class IsWebSocketMessage a where
3335 webSocketSend :: JSWebSocket -> a -> JSM ()
3436
37+instance (IsWebSocketMessage a, IsWebSocketMessage b) => IsWebSocketMessage (Either a b) where
38+ webSocketSend jws = bitraverse_ (webSocketSend jws) (webSocketSend jws)
39+
3540-- Use binary websocket communication for ByteString
3641-- Note: Binary websockets may not work correctly in IE 11 and below
3742instance IsWebSocketMessage ByteString where
3843 webSocketSend (JSWebSocket ws) bs = do
3944 ab <- bsToArrayBuffer bs
40− GD.send ws ab
45+ DOM.send ws ab
4146
4247-- Use plaintext websocket communication for Text, and String
4348instance IsWebSocketMessage Text where
44− webSocketSend (JSWebSocket ws) = GD.sendString ws . T.unpack
49+ webSocketSend (JSWebSocket ws) = DOM.sendString ws . T.unpack
4550
4651closeWebSocket :: 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)
4853
4954newWebSocket
5055 :: a
@@ -55,17 +60,17 @@ newWebSocket
5560 -> ((Bool, Word, Text) -> JSM ()) -- onclose
5661 -> JSM JSWebSocket
5762newWebSocket _ url onMessage onOpen onError onClose = do
58− ws <- GD.newWebSocket url ([] :: [Text])
59− GD.setBinaryType ws "arraybuffer"
60− _ <- on ws GD.open $ liftJSM onOpen
61− _ <- on ws GD.error $ liftJSM onError
62− _ <- on ws GD.closeEvent $ do
63+ ws <- DOM.newWebSocket url ([] :: [Text])
64+ DOM.setBinaryType ws "arraybuffer"
65+ _ <- on ws DOM.open $ liftJSM onOpen
66+ _ <- on ws DOM.error $ liftJSM onError
67+ _ <- on ws DOM.closeEvent $ do
6368 e <- ask
6469 wasClean <- getWasClean e
6570 code <- getCode e
6671 reason <- getReason e
6772 liftJSM $ onClose (wasClean, code, reason)
68− _ <- on ws GD.message $ do
73+ _ <- on ws DOM.message $ do
6974 e <- ask
7075 d <- getData e
7176 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)
1818import GHCJS.DOM.Enums
1919import GHCJS.DOM.EventM (EventM, on)
2020import 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)
2222import GHCJS.DOM.XMLHttpRequest
2323import Language.Javascript.JSaddle.Helper (mutableArrayBufferFromJSVal)
2424import 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)
77import Data.Typeable
88import GHCJS.DOM.Blob (Blob)
99
10−data XhrResponseType = XhrResponseType_Default
11− | XhrResponseType_ArrayBuffer
12− | XhrResponseType_Blob
13− | XhrResponseType_Text
14− 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)
10+data XhrResponseType
11+ = XhrResponseType_Default
12+ | XhrResponseType_ArrayBuffer
13+ | XhrResponseType_Blob
14+ | XhrResponseType_Text
15+ deriving (Show, Read, Eq, Ord, Typeable)
2116
17+data XhrResponseBody
18+ = XhrResponseBody_Default Text
19+ | XhrResponseBody_Text Text
20+ | XhrResponseBody_Blob Blob
21+ | XhrResponseBody_ArrayBuffer ByteString