websockets-simple 0.0.5 → 0.0.6

raw patch · 3 files changed

+130/−1 lines, 3 filesdep +hspecdep +tastydep +tasty-hspecdep ~base

Dependencies added: hspec, tasty, tasty-hspec, websockets-simple

Dependency ranges changed: base

Files

• src/Test/WebSockets/Simple.hs +67/−0
• test/Spec.hs +47/−0
• websockets-simple.cabal +16/−1

@@ -0,0 +1,67 @@+{-# LANGUAGE+    RankNTypes+  , ScopedTypeVariables+  , NamedFieldPuns+  , FlexibleContexts+  #-}++module Test.WebSockets.Simple where+++import Network.WebSockets.Simple (WebSocketsApp (..), WebSocketsAppParams (..))+import Control.Monad (forever, void)+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Trans.Control (MonadBaseControl (..))+import Control.Concurrent.Async (Async, async)+import Control.Concurrent.STM (atomically)+import Control.Concurrent.STM.TChan (TChan, newTChanIO, writeTChan, readTChan)++++-- | Runs two 'WebSocketsApp's together in a forged channel.+runConnected :: forall send receive m+              . ( MonadIO m+                , MonadBaseControl IO m+                )+             => WebSocketsApp send receive m+             -> WebSocketsApp receive send m+             -> m (Async (), Async (), TChan send, TChan receive)+runConnected sendsSreceivesR sendsRreceivesS = do+  (sendChan, receiveChan) <- liftIO $ (,) <$> newTChanIO <*> newTChanIO++  let sendToSend :: send -> m ()+      sendToSend s = liftIO $ atomically $ writeTChan sendChan s++      sendToReceive :: receive -> m ()+      sendToReceive r = liftIO $ atomically $ writeTChan receiveChan r++      close :: m ()+      close = do+        onClose sendsRreceivesS Nothing+        onClose sendsSreceivesR Nothing++  sToR <- liftBaseWith $ \runInBase -> async $ forever $ do+    s <- atomically $ readTChan sendChan+    void $ runInBase $ onReceive sendsRreceivesS WebSocketsAppParams+      { send = sendToReceive+      , close+      } s++  rToS <- liftBaseWith $ \runInBase -> async $ forever $ do+    r <- atomically $ readTChan receiveChan+    void $ runInBase $ onReceive sendsSreceivesR WebSocketsAppParams+      { send = sendToSend+      , close+      } r++  onOpen sendsRreceivesS WebSocketsAppParams+    { send = sendToReceive+    , close+    }++  onOpen sendsSreceivesR WebSocketsAppParams+    { send = sendToSend+    , close+    }++  pure (sToR,rToS,sendChan,receiveChan)

@@ -0,0 +1,47 @@+{-# LANGUAGE+    NamedFieldPuns+  #-}++module Main where++import Network.WebSockets.Simple (WebSocketsApp (..), WebSocketsAppParams (..))+import Control.Concurrent.STM (atomically)+import Control.Concurrent.STM.TChan (TChan, writeTChan, newTChanIO, readTChan)+import Test.Tasty (defaultMain, testGroup)+import Test.Tasty.Hspec (testSpec)+import Test.Hspec (runIO, it)+import Test.WebSockets.Simple (runConnected)+++testReceivingApp :: TChan Int -> WebSocketsApp Int Int IO+testReceivingApp receivedChan = WebSocketsApp+  { onOpen = \WebSocketsAppParams{send} ->+      send 0+  , onReceive = \_ x ->+      atomically $ writeTChan receivedChan x+  , onClose = \_ -> pure ()+  }++testSendingApp :: WebSocketsApp Int Int IO+testSendingApp = WebSocketsApp+  { onOpen = \_ -> pure ()+  , onReceive = \WebSocketsAppParams{send} x ->+      send x+  , onClose = \_ -> pure ()+  }+++main :: IO ()+main = do+  rwChan <- newTChanIO++  _ <- runConnected (testReceivingApp rwChan) testSendingApp+++  rwSpec <- testSpec "Atomic writes and receipts" $ do+    out <- runIO $ atomically $ readTChan rwChan+    it "has produced a receieved relay" $ out == 0++  defaultMain $ testGroup "WebSockets Simple"+    [ rwSpec+    ]

@@ -1,5 +1,5 @@ name:                websockets-simple-version:             0.0.5+version:             0.0.6 synopsis:            Simpler interface to the websockets api -- description: homepage:            https://github.com/athanclark/websockets-simple#readme@@ -17,6 +17,7 @@   hs-source-dirs:      src   exposed-modules:     Network.WebSockets.Simple                        Network.WebSockets.Simple.PingPong+                       Test.WebSockets.Simple   build-depends:       base >= 4.8 && < 5                      , aeson                      , async@@ -27,6 +28,20 @@                      , stm                      , wai-transformers                      , websockets >= 0.11+  default-language:    Haskell2010+++test-suite test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , websockets-simple+                     , stm+                     , tasty+                     , tasty-hspec+                     , hspec+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N   default-language:    Haskell2010  source-repository head