websockets-rpc 0.1.0 → 0.1.1

raw patch · 4 files changed

+45/−7 lines, 4 filessetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Setup.hs +2/−0
• example/Main-Client.hs +3/−3
• src/Network/WebSockets/RPC.hs +39/−3
• websockets-rpc.cabal +1/−1

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -14,7 +14,7 @@ import Control.Concurrent.Async (async, link) import Control.Monad (forM_, when, void) import Control.Monad.IO.Class (liftIO, MonadIO)-import Control.Monad.Catch (MonadThrow)+import Control.Monad.Catch (MonadThrow, MonadCatch) import Control.Monad.Random.Class (getRandom)  @@ -45,7 +45,7 @@   -myClient :: (MonadIO m, MonadThrow m) => ClientAppT (WebSocketClientRPCT MyRepDSL MyComDSL m) ()+myClient :: (MonadIO m, MonadThrow m, MonadCatch m) => ClientAppT (WebSocketClientRPCT MyRepDSL MyComDSL m) () myClient = rpcClient $ \dispatch -> do   -- only going to make one RPC call for this example   liftIO $ putStrLn "Subscribing Foo..."@@ -77,4 +77,4 @@       myClient' = runClientAppT execWebSocketClientRPCT myClient    threadDelay 1000000-  runClient "127.0.0.1" 8080 "" myClient'+  runClientAppTBackingOff id "127.0.0.1" 8080 "" myClient'

@@ -12,6 +12,7 @@   , -- * Re-Exports     WebSocketServerRPCT, execWebSocketServerRPCT, WebSocketClientRPCT, execWebSocketClientRPCT   , WebSocketRPCException (..)+  , runClientAppTBackingOff   ) where  import Network.WebSockets.RPC.Trans.Server ( WebSocketServerRPCT, execWebSocketServerRPCT@@ -24,13 +25,14 @@                                     , ClientToServer (Sub, Sup, Ping), ServerToClient (Rep, Com, Pong)                                     , RPCIdentified (..)                                     )-import Network.WebSockets (acceptRequest, receiveDataMessage, sendDataMessage, DataMessage (Text, Binary))-import Network.Wai.Trans (ServerAppT, ClientAppT)+import Network.WebSockets (acceptRequest, receiveDataMessage, sendDataMessage, DataMessage (Text, Binary), ConnectionException, runClient)+import Network.Wai.Trans (ServerAppT, ClientAppT, runClientAppT) import Data.Aeson (ToJSON, FromJSON, decode, encode)+import Data.IORef (newIORef, readIORef, writeIORef)  import Control.Monad (forever, void) import Control.Monad.IO.Class (liftIO, MonadIO)-import Control.Monad.Catch (MonadThrow, throwM)+import Control.Monad.Catch (MonadThrow, throwM, MonadCatch, catch, SomeException) import Control.Monad.Trans (lift) import Control.Concurrent (threadDelay) import qualified Control.Concurrent.Async as Async@@ -138,6 +140,7 @@              , FromJSON com              , MonadIO m              , MonadThrow m+             , MonadCatch m              )           => ((RPCClient sub sup rep com m -> WebSocketClientRPCT rep com m ()) -> WebSocketClientRPCT rep com m ())           -> ClientAppT (WebSocketClientRPCT rep com m) ()@@ -191,3 +194,36 @@                   Pong    -> liftIO (sendDataMessage conn (Text (encode (Ping :: ClientToServer () ()))))    in  userGo go+++++runClientAppTBackingOff :: (forall a. m a -> IO a)+                        -> String+                        -> Int+                        -> String+                        -> ClientAppT m ()+                        -> IO ()+runClientAppTBackingOff runM host port path app = do+  let app' = runClientAppT runM app+      second = 1000000++  spentWaiting <- newIORef (0 :: Int)++  let handleConnError :: SomeException -> IO ()+      handleConnError _ = do+        toWait <- readIORef spentWaiting+        let toWait' = 2 ^ toWait+        putStrLn $ "websocket disconnected - waiting " ++ show toWait' ++ " seconds before trying again..."+        writeIORef spentWaiting (toWait + 1)+        threadDelay $ second * toWait'+        loop++      attemptRun x =+        runClient host port path $ \conn -> do+          writeIORef spentWaiting 0+          x conn++      loop = attemptRun app' `catch` handleConnError++  loop

@@ -1,5 +1,5 @@ Name:                   websockets-rpc-Version:                0.1.0+Version:                0.1.1 Author:                 Athan Clark <athan.clark@gmail.com> Maintainer:             Athan Clark <athan.clark@gmail.com> License:                BSD3