diff --git a/.eslintrc.json b/.eslintrc.json index 84cef4f..cb9c786 100644 --- a/.eslintrc.json +++ b/.eslintrc.json @@ -4,7 +4,8 @@ }, "extends": "eslint:recommended", "env": { - "commonjs": true + "commonjs": true, + "browser": true }, "rules": { "strict": [2, "global"], diff --git a/bower.json b/bower.json index a586840..74255db 100644 --- a/bower.json +++ b/bower.json @@ -20,6 +20,7 @@ "package.json" ], "dependencies": { + "purescript-arraybuffer-types": "^1.0.0", "purescript-datetime": "^3.0.0", "purescript-enums": "^3.0.0", "purescript-exceptions": "^3.0.0", diff --git a/src/DOM/Websocket/BinaryType.purs b/src/DOM/Websocket/BinaryType.purs new file mode 100644 index 0000000..2651491 --- /dev/null +++ b/src/DOM/Websocket/BinaryType.purs @@ -0,0 +1,48 @@ +module DOM.Websocket.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 3 + 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" diff --git a/src/DOM/Websocket/Event/EventTypes.purs b/src/DOM/Websocket/Event/EventTypes.purs new file mode 100644 index 0000000..8993521 --- /dev/null +++ b/src/DOM/Websocket/Event/EventTypes.purs @@ -0,0 +1,15 @@ +module DOM.Websocket.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" diff --git a/src/DOM/Websocket/Event/MessageEvent.js b/src/DOM/Websocket/Event/MessageEvent.js new file mode 100644 index 0000000..62472b6 --- /dev/null +++ b/src/DOM/Websocket/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; +}; diff --git a/src/DOM/Websocket/Event/MessageEvent.purs b/src/DOM/Websocket/Event/MessageEvent.purs new file mode 100644 index 0000000..79d37ae --- /dev/null +++ b/src/DOM/Websocket/Event/MessageEvent.purs @@ -0,0 +1,8 @@ +module DOM.Websocket.Event.MessageEvent where + +import Data.Foreign (Foreign) +import DOM.Websocket.Event.Types (MessageEvent) + +foreign import data_ :: MessageEvent -> Foreign +foreign import origin :: MessageEvent -> String +foreign import lastEventId :: MessageEvent -> String diff --git a/src/DOM/Websocket/ReadyState.purs b/src/DOM/Websocket/ReadyState.purs new file mode 100644 index 0000000..1a06773 --- /dev/null +++ b/src/DOM/Websocket/ReadyState.purs @@ -0,0 +1,50 @@ +module DOM.Websocket.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 3 + 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 diff --git a/src/DOM/Websocket/Types.purs b/src/DOM/Websocket/Types.purs new file mode 100644 index 0000000..2e83f56 --- /dev/null +++ b/src/DOM/Websocket/Types.purs @@ -0,0 +1,28 @@ +module DOM.Websocket.Types + ( module DOM.Websocket.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 _ diff --git a/src/DOM/Websocket/WebSocket.js b/src/DOM/Websocket/WebSocket.js new file mode 100644 index 0000000..4965de8 --- /dev/null +++ b/src/DOM/Websocket/WebSocket.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.readyStateImpl; + }; +}; + +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); + }; + }; +}; diff --git a/src/DOM/Websocket/WebSocket.purs b/src/DOM/Websocket/WebSocket.purs new file mode 100644 index 0000000..0d4be98 --- /dev/null +++ b/src/DOM/Websocket/WebSocket.purs @@ -0,0 +1,80 @@ +module DOM.Websocket.WebSocket + ( create + , url + , readyState + , bufferedAmount + , extensions + , protocol + , close + , getBinaryType + , setBinaryType + , sendString + , sendBlob + , sendArrayBuffer + , sendArrayBufferView + , module DOM.Websocket.BinaryType + , module DOM.Websocket.Event.Types + , module DOM.Websocket.ReadyState + , module DOM.Websocket.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 DOM.Websocket.BinaryType (BinaryType(..), fromEnumBinaryType, printBinaryType, toEnumBinaryType) +import DOM.Websocket.Event.Types (CloseEvent, MessageEvent, readCloseEvent, readMessageEvent) +import DOM.Websocket.ReadyState (ReadyState(..), fromEnumReadyState, toEnumReadyState) +import DOM.Websocket.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