Merge branch 'safareli-compiler/0.12'

zudov · Feb 9, 2019 · 2e7d652 · 2e7d652
2 parents 64ef4eb + d1d88a9
commit 2e7d652
Show file tree

Hide file tree

Showing 7 changed files with 106 additions and 125 deletions.
diff --git 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
@@ -3,18 +3,17 @@ sudo: false
 node_js:
   - node
 install:
-- npm install [email protected] bower pulp purescript-psa -g
-- bower install
+  - npm install -g bower
+  - npm 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
+  - bower install --production
+  - npm run build
+  - bower install
+  - 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
diff --git 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": "v3.0.0"
   },
   "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
diff --git 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 :: 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
@@ -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
@@ -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,56 @@ 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, (<$>), (>>>), (>>=), ($))
 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 +80,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 +123,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 +156,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 +168,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 +177,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 +222,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,19 +235,19 @@ 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
 
 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