Migrate from purescript-dom

bower.json

@@ -0,0 +1,29 @@
+{
+  "name": "purescript-web-socket",
+  "homepage": "https://github.com/purescript-web/purescript-web-socket",
+  "description": "PureScript type definitions and effect for interacting with the WebSockets API",
+  "keywords": [
+    "purescript"
+  ],
+  "license": "MIT",
+  "repository": {
+    "type": "git",
+    "url": "git://github.com/purescript-web/purescript-web-socket.git"
+  },
+  "ignore": [
+    "**/.*",
+    "bower_components",
+    "node_modules",
+    "output",
+    "bower.json",
+    "package.json"
+  ],
+    "dependencies": {
+    "purescript-dom": "[email protected]:gabejohnson/purescript-dom.git#remove-web-socket",
+    "purescript-arraybuffer-types": "^1.0.0",
+    "purescript-enums": "^3.0.0",
+    "purescript-foreign": "^4.0.0",
+    "purescript-prelude": "^3.0.0",
+    "purescript-unsafe-coerce": "^3.0.0"
+  }
+}

src/Web/Socket.js

@@ -0,0 +1,67 @@
+"use strict";
+
+exports.create = function (url) {
+  return function (protocols) {
+    return function () {
+      return new WebSocket(url, protocols);
+    };
+  };
+};
+
+exports.url = function (ws) {
+  return function () {
+    return ws.url;
+  };
+};
+
+exports.readyStateImpl = function (ws) {
+  return function () {
+    return ws.readyState;
+  };
+};
+
+exports.bufferedAmount = function (ws) {
+  return function () {
+    return ws.bufferedAmount;
+  };
+};
+
+exports.extensions = function (ws) {
+  return function () {
+    return ws.extensions;
+  };
+};
+
+exports.protocol = function (ws) {
+  return function () {
+    return ws.protocol;
+  };
+};
+
+exports.close = function (ws) {
+  return function () {
+    return ws.close();
+  };
+};
+
+exports.getBinaryTypeImpl = function (ws) {
+  return function () {
+    return ws.binaryType;
+  };
+};
+
+exports.setBinaryTypeImpl = function (ws) {
+  return function (bt) {
+    return function () {
+      ws.binaryType = bt;
+    };
+  };
+};
+
+exports.sendImpl = function (ws) {
+  return function (value) {
+    return function () {
+      ws.send(value);
+    };
+  };
+};

src/Web/Socket.purs

@@ -0,0 +1,80 @@
+module Web.Socket
+  ( create
+  , url
+  , readyState
+  , bufferedAmount
+  , extensions
+  , protocol
+  , close
+  , getBinaryType
+  , setBinaryType
+  , sendString
+  , sendBlob
+  , sendArrayBuffer
+  , sendArrayBufferView
+  , module Web.Socket.BinaryType
+  , module Web.Socket.Event.Types
+  , module Web.Socket.ReadyState
+  , module Web.Socket.Types
+  ) where
+
+import Prelude
+
+import Control.Monad.Eff (Eff)
+
+import Data.ArrayBuffer.Types (ArrayBuffer, ArrayView)
+import Data.Foreign (Foreign, toForeign)
+import Data.Maybe (fromJust)
+
+import DOM (DOM)
+import DOM.File.Types (Blob)
+import Web.Socket.BinaryType (BinaryType(..), fromEnumBinaryType, printBinaryType, toEnumBinaryType)
+import Web.Socket.Event.Types (CloseEvent, MessageEvent, readCloseEvent, readMessageEvent)
+import Web.Socket.ReadyState (ReadyState(..), fromEnumReadyState, toEnumReadyState)
+import Web.Socket.Types (Protocol(..), URL(..), WebSocket, readWebSocket, socketToEventTarget)
+
+import Partial.Unsafe (unsafePartial)
+
+foreign import create :: forall eff. URL -> Array Protocol -> Eff (dom :: DOM | eff) WebSocket
+
+foreign import url :: forall eff. WebSocket -> Eff (dom :: DOM | eff) String
+
+foreign import readyStateImpl :: forall eff. WebSocket -> Eff (dom :: DOM | eff) Int
+
+readyState :: forall eff. WebSocket -> Eff (dom :: DOM | eff) ReadyState
+readyState ws = do
+  rs <- readyStateImpl ws
+  pure $ unsafePartial $ fromJust $ toEnumReadyState rs
+
+foreign import bufferedAmount :: forall eff. WebSocket -> Eff (dom :: DOM | eff) Number
+
+foreign import extensions :: forall eff. WebSocket -> Eff (dom :: DOM | eff) String
+foreign import protocol :: forall eff. WebSocket -> Eff (dom :: DOM | eff) String
+
+foreign import close :: forall eff. WebSocket -> Eff (dom :: DOM | eff) Unit
+
+foreign import getBinaryTypeImpl :: forall eff. WebSocket -> Eff (dom :: DOM | eff) String
+foreign import setBinaryTypeImpl :: forall eff. WebSocket -> String -> Eff (dom :: DOM | eff) Unit
+
+getBinaryType :: forall eff. WebSocket -> Eff (dom :: DOM | eff) BinaryType
+getBinaryType ws = unsafePartial do
+  getBinaryTypeImpl ws <#> case _ of
+    "blob" -> Blob
+    "arraybuffer" -> ArrayBuffer
+
+setBinaryType :: forall eff. WebSocket -> BinaryType -> Eff (dom :: DOM | eff) Unit
+setBinaryType ws = setBinaryTypeImpl ws <<< printBinaryType
+
+foreign import sendImpl :: forall eff. WebSocket -> Foreign -> Eff (dom :: DOM | eff) Unit
+
+sendString :: forall eff. WebSocket -> String -> Eff (dom :: DOM | eff) Unit
+sendString ws = sendImpl ws <<< toForeign
+
+sendBlob :: forall eff. WebSocket -> Blob -> Eff (dom :: DOM | eff) Unit
+sendBlob ws = sendImpl ws <<< toForeign
+
+sendArrayBuffer :: forall eff. WebSocket -> ArrayBuffer -> Eff (dom :: DOM | eff) Unit
+sendArrayBuffer ws = sendImpl ws <<< toForeign
+
+sendArrayBufferView :: forall t eff. WebSocket -> ArrayView t -> Eff (dom :: DOM | eff) Unit
+sendArrayBufferView ws = sendImpl ws <<< toForeign

src/Web/Socket/BinaryType.purs

@@ -0,0 +1,48 @@
+module Web.Socket.BinaryType where
+
+import Prelude
+import Data.Enum (Cardinality(..), class BoundedEnum, defaultPred, defaultSucc, class Enum)
+import Data.Maybe (Maybe(..))
+
+data BinaryType
+  = Blob
+  | ArrayBuffer
+
+derive instance eqBinaryType :: Eq BinaryType
+derive instance ordBinaryType :: Ord BinaryType
+
+instance boundedBinaryType :: Bounded BinaryType where
+  bottom = Blob
+  top = ArrayBuffer
+
+instance enumBinaryType :: Enum BinaryType where
+  succ = defaultSucc toEnumBinaryType fromEnumBinaryType
+  pred = defaultPred toEnumBinaryType fromEnumBinaryType
+
+instance boundedEnumBinaryType :: BoundedEnum BinaryType where
+  cardinality = Cardinality 2
+  toEnum = toEnumBinaryType
+  fromEnum = fromEnumBinaryType
+
+instance showBinaryType :: Show BinaryType where
+  show Blob = "Blob"
+  show ArrayBuffer = "ArrayBuffer"
+
+toEnumBinaryType :: Int -> Maybe BinaryType
+toEnumBinaryType =
+  case _ of
+    0 -> Just Blob
+    1 -> Just ArrayBuffer
+    _ -> Nothing
+
+fromEnumBinaryType :: BinaryType -> Int
+fromEnumBinaryType =
+  case _ of
+    Blob -> 0
+    ArrayBuffer -> 1
+
+printBinaryType :: BinaryType -> String
+printBinaryType =
+  case _ of
+    Blob -> "blob"
+    ArrayBuffer -> "arraybuffer"

src/Web/Socket/Event/CloseEvent.js

@@ -0,0 +1,13 @@
+"use strict";
+
+exports.code = function (e) {
+  return e.code;
+};
+
+exports.reason = function (e) {
+  return e.reason;
+};
+
+exports.wasClean = function (e) {
+  return e.wasClean;
+};

src/Web/Socket/Event/CloseEvent.purs

@@ -0,0 +1,7 @@
+module Web.Socket.Event.CloseEvent where
+
+import Web.Socket.Event.Types (CloseEvent)
+
+foreign import code :: CloseEvent -> Int
+foreign import reason :: CloseEvent -> String
+foreign import wasClean :: CloseEvent -> Boolean

src/Web/Socket/Event/EventTypes.purs

@@ -0,0 +1,15 @@
+module Web.Socket.Event.EventTypes where
+
+import DOM.Event.Types (EventType(..))
+
+onOpen :: EventType
+onOpen = EventType "open"
+
+onMessage :: EventType
+onMessage = EventType "message"
+
+onError :: EventType
+onError = EventType "error"
+
+onClose :: EventType
+onClose = EventType "close"

src/Web/Socket/Event/MessageEvent.js

@@ -0,0 +1,13 @@
+"use strict";
+
+exports.data_ = function (e) {
+  return e.data;
+};
+
+exports.origin = function (e) {
+  return e.origin;
+};
+
+exports.lastEventId = function (e) {
+  return e.lastEventId;
+};

src/Web/Socket/Event/MessageEvent.purs

@@ -0,0 +1,8 @@
+module Web.Socket.Event.MessageEvent where
+
+import Data.Foreign (Foreign)
+import Web.Socket.Event.Types (MessageEvent)
+
+foreign import data_ :: MessageEvent -> Foreign
+foreign import origin :: MessageEvent -> String
+foreign import lastEventId :: MessageEvent -> String

src/Web/Socket/Event/Types.purs

@@ -0,0 +1,21 @@
+module Web.Socket.Event.Types where
+
+import Data.Foreign (Foreign, F, unsafeReadTagged)
+import DOM.Event.Types (Event)
+import Unsafe.Coerce as U
+
+foreign import data CloseEvent :: Type
+
+closeEventToEvent :: CloseEvent -> Event
+closeEventToEvent = U.unsafeCoerce
+
+readCloseEvent :: Foreign -> F CloseEvent
+readCloseEvent = unsafeReadTagged "CloseEvent"
+
+foreign import data MessageEvent :: Type
+
+messageEventToEvent :: MessageEvent -> Event
+messageEventToEvent = U.unsafeCoerce
+
+readMessageEvent :: Foreign -> F MessageEvent
+readMessageEvent = unsafeReadTagged "MessageEvent"

src/Web/Socket/ReadyState.purs

@@ -0,0 +1,50 @@
+module Web.Socket.ReadyState where
+
+import Prelude
+import Data.Enum (Cardinality(..), class BoundedEnum, defaultPred, defaultSucc, class Enum)
+import Data.Maybe (Maybe(..))
+
+data ReadyState
+  = Connecting
+  | Open
+  | Closing
+  | Closed
+
+derive instance eqReadyState :: Eq ReadyState
+derive instance ordReadyState :: Ord ReadyState
+
+instance boundedReadyState :: Bounded ReadyState where
+  bottom = Connecting
+  top = Closed
+
+instance enumReadyState :: Enum ReadyState where
+  succ = defaultSucc toEnumReadyState fromEnumReadyState
+  pred = defaultPred toEnumReadyState fromEnumReadyState
+
+instance boundedEnumReadyState :: BoundedEnum ReadyState where
+  cardinality = Cardinality 4
+  toEnum = toEnumReadyState
+  fromEnum = fromEnumReadyState
+
+instance showReadyState :: Show ReadyState where
+  show Connecting = "Connecting"
+  show Open = "Open"
+  show Closing = "Closing"
+  show Closed = "Closed"
+
+toEnumReadyState :: Int -> Maybe ReadyState
+toEnumReadyState =
+  case _ of
+    0 -> Just Connecting
+    1 -> Just Open
+    2 -> Just Closing
+    3 -> Just Closed
+    _ -> Nothing
+
+fromEnumReadyState :: ReadyState -> Int
+fromEnumReadyState =
+  case _ of
+    Connecting -> 0
+    Open -> 1
+    Closing -> 2
+    Closed -> 3

src/Web/Socket/Types.purs

@@ -0,0 +1,28 @@
+module Web.Socket.Types
+  ( module Web.Socket.Types
+  , module DOM.HTML.History
+  ) where
+
+import Prelude
+
+import Data.Foreign (F, Foreign, unsafeReadTagged)
+import Data.Newtype (class Newtype)
+
+import DOM.Event.Types (EventTarget)
+import DOM.HTML.History (URL(..))
+
+import Unsafe.Coerce (unsafeCoerce)
+
+foreign import data WebSocket :: Type
+
+readWebSocket :: Foreign -> F WebSocket
+readWebSocket = unsafeReadTagged "WebSocket"
+
+socketToEventTarget :: WebSocket -> EventTarget
+socketToEventTarget = unsafeCoerce
+
+newtype Protocol = Protocol String
+
+derive newtype instance eqProtocol :: Eq Protocol
+derive newtype instance ordProtocol :: Ord Protocol
+derive instance newtypeProtocol :: Newtype Protocol _