From cc1ad6d0b5145919e34d636d403fb80e9f4faa64 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Thu, 22 Nov 2018 20:11:26 +0400 Subject: [PATCH 1/4] 0.12 Updates --- .gitignore | 13 ++-- .travis.yml | 17 +++--- bower.json | 14 +++-- example/bower.json | 18 ------ example/src/Main.purs | 15 ++--- package.json | 15 +++++ src/WebSocket.purs | 136 ++++++++++++++++++------------------------ 7 files changed, 104 insertions(+), 124 deletions(-) delete mode 100644 example/bower.json create mode 100644 package.json diff --git a/.gitignore b/.gitignore index da54bf3..332b6cf 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,8 @@ -bower_components -output -.psci* -/node_modules -.pursuit.json +/.* +!/.gitignore +!/.eslintrc.json +!/.travis.yml +/bower_components/ +/node_modules/ +/output/ +package-lock.json diff --git a/.travis.yml b/.travis.yml index df992b2..836e68e 100644 --- a/.travis.yml +++ b/.travis.yml @@ -3,18 +3,15 @@ sudo: false node_js: - node install: -- npm install purescript@0.11.4 bower pulp purescript-psa -g -- bower install + - npm install + - bower install script: - - pulp build -- --censor-lib && pulp docs - - bower link - - cd example/ && bower -q link purescript-websocket-simple && bower -q install && npm install ws && pulp build -- --censor-lib && pulp run + - npm run build + - npm run example + - pulp run after_success: - >- test $TRAVIS_TAG && - psc-publish > .pursuit.json && - curl -X POST https://pursuit.purescript.org/packages \ - -d @.pursuit.json \ - -H 'Accept: application/json' \ - -H "Authorization: token ${GITHUB_TOKEN}" + echo $GITHUB_TOKEN | pulp login && + echo y | pulp publish --no-push \ No newline at end of file diff --git a/bower.json b/bower.json index 2722e7f..75e5926 100644 --- a/bower.json +++ b/bower.json @@ -23,13 +23,15 @@ "purescript" ], "dependencies": { - "purescript-dom": "^4.0.0", - "purescript-eff": "^3.0.0", - "purescript-exceptions": "^3.0.0", - "purescript-generics": "^4.0.0", - "purescript-var": "^2.0.0" + "purescript-web-socket": "^1.0.0", + "purescript-web-events": "^1.0.0", + "purescript-effect": "^2.0.0", + "purescript-exceptions": "^4.0.0", + "purescript-generics-rep": "^6.0.0", + "purescript-var": "Thimoteus/purescript-var#25dae0b60466d76f12dc12e9894c4f517a6d6822" }, "devDependencies": { - "purescript-console": "^3.0.0" + "purescript-debug": "^4.0.0", + "purescript-console": "^4.0.0" } } diff --git a/example/bower.json b/example/bower.json deleted file mode 100644 index c502a70..0000000 --- a/example/bower.json +++ /dev/null @@ -1,18 +0,0 @@ -{ - "name": "example", - "version": "1.0.0", - "moduleType": [ - "node" - ], - "ignore": [ - "**/.*", - "node_modules", - "bower_components", - "output" - ], - "dependencies": { - "purescript-console": "^3.0.0", - "purescript-debug": "^3.0.0", - "purescript-websocket-simple": "*" - } -} diff --git a/example/src/Main.purs b/example/src/Main.purs index cb6a9fd..17e9370 100644 --- a/example/src/Main.purs +++ b/example/src/Main.purs @@ -2,18 +2,19 @@ module Main where import Prelude -import Control.Bind ((=<<)) -import Control.Monad.Eff.Var (($=), get) -import Control.Monad.Eff.Console (log) -import Debug.Trace (traceAnyM) +import Effect (Effect) +import Effect.Var (($=), get) +import Effect.Console (log) +import Debug.Trace (traceM, class DebugWarning) import WebSocket (Connection(..), Message(..), URL(..), runMessageEvent, runMessage, runURL, newWebSocket) +main :: DebugWarning => Effect Unit main = do Connection socket <- newWebSocket (URL "ws://echo.websocket.org") [] socket.onopen $= \event -> do - void $ traceAnyM event + traceM event log "onopen: Connection opened" log <<< runURL =<< get socket.url @@ -25,7 +26,7 @@ main = do socket.send (Message "goodbye") socket.onmessage $= \event -> do - void $ traceAnyM event + traceM event let received = runMessage (runMessageEvent event) log $ "onmessage: Received '" <> received <> "'" @@ -35,5 +36,5 @@ main = do socket.close socket.onclose $= \event -> do - void $ traceAnyM event + traceM event log "onclose: Connection closed" diff --git a/package.json b/package.json new file mode 100644 index 0000000..8b3a817 --- /dev/null +++ b/package.json @@ -0,0 +1,15 @@ +{ + "private": true, + "scripts": { + "build": "pulp build -- --censor-lib", + "example": "pulp build -I example/src/ -- --censor-lib" + }, + "dependencies": { + "ws": "^6.1.2" + }, + "devDependencies": { + "purescript-psa": "^0.6.0", + "purescript": "^0.12.0", + "pulp": "^12.2.0" + } +} diff --git a/src/WebSocket.purs b/src/WebSocket.purs index 279f1da..5c79f56 100644 --- a/src/WebSocket.purs +++ b/src/WebSocket.purs @@ -1,8 +1,7 @@ -- | This module defines a simple low-level interface to the websockets API. module WebSocket - ( WEBSOCKET() - , WebSocket() + ( WebSocket() , newWebSocket , Connection(..) , URL(..) @@ -22,76 +21,57 @@ module WebSocket , BinaryType(..) ) where -import Control.Monad.Eff (kind Effect, Eff) -import Control.Monad.Eff.Exception (EXCEPTION) -import Control.Monad.Eff.Var (Var, GettableVar, SettableVar, makeVar, makeGettableVar, makeSettableVar) -import Control.Monad.Except (runExcept) -import DOM.Event.EventTarget (eventListener, EventListener) -import DOM.Event.Types (Event) -import DOM.Websocket.Event.Types (CloseEvent, MessageEvent) -import Data.Either (Either(..)) +import Effect (Effect) +import Effect.Var (Var, GettableVar, SettableVar, makeVar, makeGettableVar, makeSettableVar) +import Web.Event.EventTarget (eventListener, EventListener) +import Web.Event.Internal.Types (Event) +import Web.Socket.Event.CloseEvent (CloseEvent) +import Web.Socket.Event.MessageEvent (data_, MessageEvent) import Data.Enum (class BoundedEnum, class Enum, defaultSucc, defaultPred, toEnum, Cardinality(..)) -import Data.Foreign (toForeign, unsafeFromForeign) -import Data.Foreign.Index (readProp) +import Foreign (unsafeFromForeign) import Data.Function.Uncurried (runFn2, Fn2) import Data.Functor.Contravariant (cmap) import Data.Functor.Invariant (imap) -import Data.Generic (class Generic, gShow, gEq, gCompare) +import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Show (genericShow) +import Data.Generic.Rep.Eq (genericEq) +import Data.Generic.Rep.Ord (genericCompare) import Data.Maybe (Maybe(..), fromMaybe) import Data.Nullable (toNullable, Nullable) -import Prelude (class Ord, compare, class Eq, eq, class Bounded, class Show, Unit, (<$>), map, (<<<), ($)) +import Prelude (class Ord, compare, class Eq, eq, class Bounded, class Show, Unit, (<$>), map, (<<<), (>>>), (>>=), ($)) import Unsafe.Coerce (unsafeCoerce) foreign import specViolation :: forall a. String -> a --- | The effect associated with websocket connections. -foreign import data WEBSOCKET :: Effect - -- | A reference to a WebSocket object. foreign import data WebSocket :: Type -- | Initiate a websocket connection. -newWebSocket :: forall eff. URL -> Array Protocol -> Eff (ws :: WEBSOCKET, err :: EXCEPTION | eff) Connection +newWebSocket :: URL -> Array Protocol -> Effect Connection newWebSocket url protocols = enhanceConnection <$> runFn2 newWebSocketImpl url protocols -foreign import newWebSocketImpl :: forall eff. Fn2 URL +foreign import newWebSocketImpl :: Fn2 URL (Array Protocol) - (Eff (ws :: WEBSOCKET, err :: EXCEPTION | eff) ConnectionImpl) + (Effect ConnectionImpl) runMessageEvent :: MessageEvent -> Message -runMessageEvent event = case runExcept (readProp "data" (toForeign event)) of - Right x -> unsafeFromForeign x - Left _ -> specViolation "'data' missing from MessageEvent" +runMessageEvent event = unsafeFromForeign $ data_ event type ConnectionImpl = - { setBinaryType - :: forall eff. String -> Eff (ws :: WEBSOCKET | eff) Unit - , getBinaryType - :: forall eff. Eff (ws :: WEBSOCKET | eff) String - , getBufferedAmount - :: forall eff. Eff (ws :: WEBSOCKET | eff) BufferedAmount - , setOnclose - :: forall eff handlerEff. EventListener handlerEff -> Eff (ws :: WEBSOCKET | eff) Unit - , setOnerror - :: forall eff handlerEff. EventListener handlerEff -> Eff (ws :: WEBSOCKET | eff) Unit - , setOnmessage - :: forall eff handlerEff. EventListener handlerEff -> Eff (ws :: WEBSOCKET | eff) Unit - , setOnopen - :: forall eff handlerEff. EventListener handlerEff -> Eff (ws :: WEBSOCKET | eff) Unit - , setProtocol - :: forall eff. Protocol -> Eff (ws :: WEBSOCKET | eff) Unit - , getProtocol - :: forall eff. Eff (ws :: WEBSOCKET | eff) Protocol - , getReadyState - :: forall eff. Eff (ws :: WEBSOCKET | eff) Int - , getUrl - :: forall eff. Eff (ws :: WEBSOCKET | eff) URL - , closeImpl - :: forall eff. Nullable { code :: Code, reason :: Nullable Reason } -> Eff (ws :: WEBSOCKET, err :: EXCEPTION | eff) Unit - , sendImpl - :: forall eff. Message -> Eff (ws :: WEBSOCKET, err :: EXCEPTION | eff) Unit - , getSocket - :: forall eff. Eff (ws :: WEBSOCKET | eff) WebSocket + { setBinaryType :: String -> Effect Unit + , getBinaryType :: Effect String + , getBufferedAmount :: Effect BufferedAmount + , setOnclose :: EventListener -> Effect Unit + , setOnerror :: EventListener -> Effect Unit + , setOnmessage :: EventListener -> Effect Unit + , setOnopen :: EventListener -> Effect Unit + , setProtocol :: Protocol -> Effect Unit + , getProtocol :: Effect Protocol + , getReadyState :: Effect Int + , getUrl :: Effect URL + , closeImpl :: Nullable { code :: Code, reason :: Nullable Reason } -> Effect Unit + , sendImpl :: Message -> Effect Unit + , getSocket :: Effect WebSocket } coerceEvent :: forall a. Event -> a @@ -101,10 +81,10 @@ enhanceConnection :: ConnectionImpl -> Connection enhanceConnection c = Connection $ { binaryType: imap toBinaryType fromBinaryType $ makeVar c.getBinaryType c.setBinaryType , bufferedAmount: makeGettableVar c.getBufferedAmount - , onclose: cmap (eventListener <<< (_ `map` coerceEvent)) (makeSettableVar c.setOnclose) - , onerror: cmap (eventListener <<< (_ `map` coerceEvent)) (makeSettableVar c.setOnerror) - , onmessage: cmap (eventListener <<< (_ `map` coerceEvent)) (makeSettableVar c.setOnmessage) - , onopen: cmap (eventListener <<< (_ `map` coerceEvent)) (makeSettableVar c.setOnopen) + , onclose: makeSettableVar \f -> eventListener (coerceEvent >>> f) >>= c.setOnclose + , onerror: makeSettableVar \f -> eventListener (coerceEvent >>> f) >>= c.setOnerror + , onmessage: makeSettableVar \f -> eventListener (coerceEvent >>> f) >>= c.setOnmessage + , onopen: makeSettableVar \f -> eventListener (coerceEvent >>> f) >>= c.setOnopen , protocol: makeVar c.getProtocol c.setProtocol , readyState: unsafeReadyState <$> makeGettableVar c.getReadyState , url: makeGettableVar c.getUrl @@ -144,19 +124,19 @@ enhanceConnection c = Connection $ -- | - `send` -- Transmits data to the server. -- | - `socket` -- Reference to closured WebSocket object. newtype Connection = Connection - { binaryType :: forall eff. Var (ws :: WEBSOCKET | eff) BinaryType - , bufferedAmount :: forall eff. GettableVar (ws :: WEBSOCKET | eff) BufferedAmount - , onclose :: forall eff handlerEff. SettableVar (ws :: WEBSOCKET | eff) (CloseEvent -> Eff handlerEff Unit) - , onerror :: forall eff handlerEff. SettableVar (ws :: WEBSOCKET | eff) (Event -> Eff handlerEff Unit) - , onmessage :: forall eff handlerEff. SettableVar (ws :: WEBSOCKET | eff) (MessageEvent -> Eff handlerEff Unit) - , onopen :: forall eff handlerEff. SettableVar (ws :: WEBSOCKET | eff) (Event -> Eff handlerEff Unit) - , protocol :: forall eff. Var (ws :: WEBSOCKET | eff) Protocol - , readyState :: forall eff. GettableVar (ws :: WEBSOCKET | eff) ReadyState - , url :: forall eff. GettableVar (ws :: WEBSOCKET | eff) URL - , close :: forall eff. Eff (ws :: WEBSOCKET, err :: EXCEPTION | eff) Unit - , close' :: forall eff. Code -> Maybe Reason -> Eff (ws :: WEBSOCKET, err :: EXCEPTION | eff) Unit - , send :: forall eff. Message -> Eff (ws :: WEBSOCKET, err :: EXCEPTION | eff) Unit - , socket :: forall eff. GettableVar (ws :: WEBSOCKET | eff) WebSocket + { binaryType :: Var BinaryType + , bufferedAmount :: GettableVar BufferedAmount + , onclose :: SettableVar (CloseEvent -> Effect Unit) + , onerror :: SettableVar (Event -> Effect Unit) + , onmessage :: SettableVar (MessageEvent -> Effect Unit) + , onopen :: SettableVar (Event -> Effect Unit) + , protocol :: Var Protocol + , readyState :: GettableVar ReadyState + , url :: GettableVar URL + , close :: Effect Unit + , close' :: Code -> Maybe Reason -> Effect Unit + , send :: Message -> Effect Unit + , socket :: GettableVar WebSocket } -- | The type of binary data being transmitted by the connection. @@ -177,7 +157,7 @@ newtype BufferedAmount = BufferedAmount Int runBufferedAmount :: BufferedAmount -> Int runBufferedAmount (BufferedAmount a) = a -derive instance genericBufferedAmount :: Generic BufferedAmount +derive instance genericBufferedAmount :: Generic BufferedAmount _ instance eqBufferedAmount :: Eq BufferedAmount where eq (BufferedAmount a) (BufferedAmount b) = eq a b instance ordBufferedAmount :: Ord BufferedAmount where @@ -189,7 +169,7 @@ newtype Protocol = Protocol String runProtocol :: Protocol -> String runProtocol (Protocol a) = a -derive instance genericProtocol :: Generic Protocol +derive instance genericProtocol :: Generic Protocol _ instance eqProtocol :: Eq Protocol where eq (Protocol a) (Protocol b) = eq a b instance ordProtocol :: Ord Protocol where @@ -198,16 +178,16 @@ instance ordProtocol :: Ord Protocol where -- | State of the connection. data ReadyState = Connecting | Open | Closing | Closed -derive instance genericReadyState :: Generic ReadyState +derive instance genericReadyState :: Generic ReadyState _ instance eqReadyState :: Eq ReadyState where - eq = gEq + eq = genericEq instance ordReadyState :: Ord ReadyState where - compare = gCompare + compare = genericCompare instance showReadyState :: Show ReadyState where - show = gShow + show = genericShow instance boundedReadyState :: Bounded ReadyState where bottom = Connecting @@ -243,7 +223,7 @@ newtype Code runCode :: Code -> Int runCode (Code a) = a -derive instance genericCode :: Generic Code +derive instance genericCode :: Generic Code _ instance eqCode :: Eq Code where eq (Code a) (Code b) = eq a b instance ordCode :: Ord Code where @@ -256,7 +236,7 @@ newtype Reason = Reason String runReason :: Reason -> String runReason (Reason a) = a -derive instance genericReason :: Generic Reason +derive instance genericReason :: Generic Reason _ -- | A synonym for URL strings. newtype URL = URL String @@ -264,11 +244,11 @@ newtype URL = URL String runURL :: URL -> String runURL (URL a) = a -derive instance genericURL :: Generic URL +derive instance genericURL :: Generic URL _ -- | A synonym for message strings. newtype Message = Message String -derive instance genericMessage :: Generic Reason +derive instance genericMessage :: Generic Reason _ runMessage :: Message -> String runMessage (Message a) = a From 51e4ddb767121d53d489da089b7f7cbf13988cb7 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Thu, 22 Nov 2018 20:35:03 +0400 Subject: [PATCH 2/4] Update .travis.yml --- .travis.yml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/.travis.yml b/.travis.yml index 836e68e..45e357e 100644 --- a/.travis.yml +++ b/.travis.yml @@ -3,10 +3,12 @@ sudo: false node_js: - node install: + - npm install -g bower - npm install - - bower install script: + - bower install --production - npm run build + - bower install - npm run example - pulp run @@ -14,4 +16,4 @@ after_success: - >- test $TRAVIS_TAG && echo $GITHUB_TOKEN | pulp login && - echo y | pulp publish --no-push \ No newline at end of file + echo y | pulp publish --no-push From e7d244c9c358beee02e5cc6446e1f0b025ff9a63 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Thu, 22 Nov 2018 21:57:44 +0400 Subject: [PATCH 3/4] lint --- example/src/Main.purs | 2 +- src/WebSocket.purs | 3 +-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/example/src/Main.purs b/example/src/Main.purs index 17e9370..f568c68 100644 --- a/example/src/Main.purs +++ b/example/src/Main.purs @@ -9,7 +9,7 @@ import Debug.Trace (traceM, class DebugWarning) import WebSocket (Connection(..), Message(..), URL(..), runMessageEvent, runMessage, runURL, newWebSocket) -main :: DebugWarning => Effect Unit +main :: Effect Unit main = do Connection socket <- newWebSocket (URL "ws://echo.websocket.org") [] diff --git a/src/WebSocket.purs b/src/WebSocket.purs index 5c79f56..8d88c0f 100644 --- a/src/WebSocket.purs +++ b/src/WebSocket.purs @@ -30,7 +30,6 @@ import Web.Socket.Event.MessageEvent (data_, MessageEvent) import Data.Enum (class BoundedEnum, class Enum, defaultSucc, defaultPred, toEnum, Cardinality(..)) import Foreign (unsafeFromForeign) import Data.Function.Uncurried (runFn2, Fn2) -import Data.Functor.Contravariant (cmap) import Data.Functor.Invariant (imap) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) @@ -38,7 +37,7 @@ import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Ord (genericCompare) import Data.Maybe (Maybe(..), fromMaybe) import Data.Nullable (toNullable, Nullable) -import Prelude (class Ord, compare, class Eq, eq, class Bounded, class Show, Unit, (<$>), map, (<<<), (>>>), (>>=), ($)) +import Prelude (class Ord, compare, class Eq, eq, class Bounded, class Show, Unit, (<$>), (>>>), (>>=), ($)) import Unsafe.Coerce (unsafeCoerce) foreign import specViolation :: forall a. String -> a From d1d88a94d27c2a1403411c48363712f4cd310361 Mon Sep 17 00:00:00 2001 From: Konstantin Zudov Date: Sat, 9 Feb 2019 18:37:52 +0200 Subject: [PATCH 4/4] Bump to purescript-var-v3.0.0 --- bower.json | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bower.json b/bower.json index 75e5926..36fc058 100644 --- a/bower.json +++ b/bower.json @@ -28,7 +28,7 @@ "purescript-effect": "^2.0.0", "purescript-exceptions": "^4.0.0", "purescript-generics-rep": "^6.0.0", - "purescript-var": "Thimoteus/purescript-var#25dae0b60466d76f12dc12e9894c4f517a6d6822" + "purescript-var": "v3.0.0" }, "devDependencies": { "purescript-debug": "^4.0.0",