ghcjs-websockets 0.3.0.0 → 0.3.0.1

raw patch · 3 files changed

+144/−2 lines, 3 files

Files

• ghcjs-websockets.cabal +6/−2
• src/JavaScript/Blob.hs +37/−0
• src/JavaScript/WebSockets/FFI.hs +101/−0

@@ -1,7 +1,10 @@ name:                ghcjs-websockets-version:             0.3.0.0+version:             0.3.0.1 synopsis:            GHCJS interface for the Javascript Websocket API description:+                     Documentation online at+                     <http://mstksg.github.io/ghcjs-websockets/JavaScript-WebSockets.html>+                     .                      'ghcjs-websockets' aims to provide a clean, idiomatic,                      efficient, low-level, out-of-your-way, bare bones,                      concurrency-aware interface with minimal abstractions@@ -90,7 +93,8 @@   exposed-modules:     JavaScript.WebSockets                      , JavaScript.WebSockets.Internal   -- ghcjs-options: -O2-  -- other-modules:       +  other-modules:       JavaScript.Blob+                     , JavaScript.WebSockets.FFI   -- other-extensions:       ghc-options:         -Wall   build-depends:       base              >= 4.7      && < 5

@@ -0,0 +1,37 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE JavaScriptFFI #-}+{-# OPTIONS_HADDOCK hide #-}++module JavaScript.Blob (+    Blob+  , readBlob+  , isBlob+  ) where++import Control.Exception (mask_)+import Data.ByteString   (ByteString)+import GHCJS.Foreign     (bufferByteString)+import GHCJS.Types       (JSRef)+++data Blob_+type Blob = JSRef Blob_++foreign import javascript interruptible  "var reader = new FileReader();\+                                          reader.addEventListener('loadend', function() {\+                                            $c(reader.result);\+                                          });\+                                          reader.readAsArrayBuffer($1);"+    ffi_readBlob :: Blob -> IO (JSRef a)++foreign import javascript unsafe "$1 instanceof Blob" ffi_blobCheck :: JSRef a -> IO Bool++readBlob :: Blob -> IO ByteString+readBlob b = bufferByteString 0 0 =<< mask_ (ffi_readBlob b)++isBlob :: JSRef a -> IO Bool+isBlob ref = ffi_blobCheck ref+++

@@ -0,0 +1,101 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE JavaScriptFFI #-}+{-# OPTIONS_HADDOCK hide #-}++module JavaScript.WebSockets.FFI (+  -- * Types+    Socket+  , Waiter+  , ConnectionQueue+  , ConnectionWaiters+  , WaiterKilled+    -- * FFI+  , ws_newSocket+  , ws_closeSocket+  , ws_socketSend+  , ws_awaitConn+  , ws_clearWaiters+  , ws_clearQueue+  , ws_handleOpen+  , ws_handleClose+  , ws_readyState+  ) where++import Data.Text   (Text)+import GHCJS.Types (JSRef, JSArray, JSString, JSObject, JSBool)++data Socket_+type Socket = JSRef Socket_++data Waiter_+type Waiter = JSRef Waiter_++type WaiterKilled = JSObject JSBool++type ConnectionQueue = JSArray Text+type ConnectionWaiters = JSArray Waiter++type WSCloseEvent = JSObject ()++foreign import javascript unsafe "$1.close();"+  ws_closeSocket :: Socket -> IO ()++foreign import javascript unsafe "$1.send(atob($2));"+  ws_socketSend :: Socket -> JSString -> IO ()++foreign import javascript interruptible "$1.onopen = function() { $c($1); };"+  ws_handleOpen :: Socket -> IO Socket++foreign import javascript unsafe  "var ws = new WebSocket($1);\+                                   ws.onmessage = function(e) {\+                                     if (!(typeof e === 'undefined')) {\+                                       if (window.ws_debug) {\+                                         console.log(e);\+                                       };\+                                       $2.push(e.data);\+                                       if ($3.length > 0) {\+                                         var e0 = $2.shift();\+                                         var found = false;\+                                         while ($3.length > 0 && !found) {\+                                           var w0 = $3.shift();\+                                           found = w0(e0);\+                                         };\+                                         if (!found) {\+                                           $2.unshift(e0);\+                                         };\+                                       };\+                                     }\+                                   };\+                                   $r = ws;"+  ws_newSocket :: JSString -> ConnectionQueue -> ConnectionWaiters -> IO Socket++foreign import javascript interruptible  "if ($1.length > 0) {\+                                            var d = $1.shift();\+                                            $c(d);\+                                          } else {\+                                            $2.push(function(d) {\+                                              if ($3.k) {\+                                                return false;\+                                              } else {\+                                                $c(d);\+                                                return true;\+                                              };\+                                            });\+                                          }"+  ws_awaitConn :: ConnectionQueue -> ConnectionWaiters -> WaiterKilled -> IO (JSRef ())++foreign import javascript unsafe "while ($1.length > 0) {\+                                    var w0 = $1.shift();\+                                    w0(null);\+                                  };"+  ws_clearWaiters :: ConnectionWaiters -> IO ()++foreign import javascript unsafe "while ($1.length > 0) { $1.shift(); };"+  ws_clearQueue :: ConnectionQueue -> IO ()++foreign import javascript interruptible  "$1.onclose = function (e) { $c(e); };"+  ws_handleClose :: Socket -> IO WSCloseEvent++foreign import javascript unsafe "$1.readyState"+  ws_readyState :: Socket -> IO Int