courier 0.1.0.3 → 0.1.0.4

raw patch · 3 files changed

+62/−34 lines, 3 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• courier.cabal +4/−6
• src/Network/Endpoints.hs +52/−2
• tests/TestTCP.hs +6/−26

@@ -2,14 +2,14 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                courier-version:             0.1.0.3+version:             0.1.0.4 synopsis:            A message-passing library, intended for simplifying network applications description:         Inspired by Erlang's simple message-passing facilities, courier provides roughly similar -                     capabilities. Applications simply create one or more 'Network.Endpoints.Endpoint's, -                     bind each to a 'Network.Transport.Transport' using a given name, then can freely +                     capabilities. Applications simply create one or more endpoints, +                     bind each to a transport using a given name, then can freely                       send / receive messages to other endpoints just by referencing the name each endpoint                       bound to its transport.-+                      homepage:          http://github.com/hargettp/courier license:             MIT license-file:        LICENSE@@ -65,11 +65,9 @@         test-framework-quickcheck2,         -- Cabal,         -- 3rd party modules-        async,         cereal,         directory,         hslogger,-        stm,         -- this project's modules         courier 

@@ -21,7 +21,10 @@  module Network.Endpoints (   - --  * Primary API+  -- * How to use courier in an application+  -- $use+  +  -- * Primary API   Endpoint,   newEndpoint,   @@ -29,7 +32,9 @@   unbindEndpoint,      sendMessage,+  broadcastMessage,   receiveMessage,+  receiveMessageTimeout,      -- * Transports   {-|@@ -49,6 +54,8 @@  -- external imports +import Control.Concurrent+import Control.Concurrent.Async import Control.Concurrent.STM  import qualified Data.Map as M@@ -56,6 +63,30 @@ -------------------------------------------------------------------------------- -------------------------------------------------------------------------------- +-- $use+-- +-- A sample of how to use this library:+-- +-- > -- Just import this package to access the primary APIs+-- > import Network.Endpoints+-- >+-- > -- A specific transport is necessary, however+-- > import Network.Transport.TCP+-- > +-- > helloWorld :: IO ()+-- > helloWorld = do+-- >   let name1 = "endpoint1"b+-- >       name2 = "endpoint2"+-- >       resolver = resolverFromList [(name1,"localhost:2000"),+-- >                                    (name2,"localhost:2001")]+-- >   endpoint1 <- newEndpoint [transport]+-- >   endpoint2 <- newEndpoint [transport]+-- >   Right () <- bindEndpoint endpoint1 name1+-- >   Right () <- bindEndpoint endpoint2 name2+-- >   sendMessage endpoint1 name2 $ encode "hello world!"+-- >   msg <- receiveMessage endpoint2+-- >   print msg+ {-| Endpoints are a locus of communication, used for sending and receive messages. -}@@ -132,10 +163,29 @@       return $ Right ()  {-|-Receive the next 'Message' sent to the 'Endpoint'.+Helper for sending a single 'Message' to several 'Endpoint's. -}+broadcastMessage :: Endpoint -> [Name] -> Message -> IO [(Either String ())]+broadcastMessage endpoint names msg = do+  mapM (\name -> sendMessage endpoint name msg) names++{-|+Receive the next 'Message' sent to the 'Endpoint', blocking until a message is available.+-} receiveMessage :: Endpoint -> IO Message receiveMessage endpoint = atomically $ readTQueue $ endpointMailbox endpoint++{-|+Wait for a message to be received within the timeout, blocking until either a message+is available or the timeout has occurred.  If a message was available, returns @Just message@,+but returns @Nothing@ if no message available before the timeout occurred.+-}+receiveMessageTimeout :: Endpoint -> Int -> IO (Maybe Message)+receiveMessageTimeout endpoint delay = do+  resultOrTimeout <- race (receiveMessage endpoint) (threadDelay delay)+  case resultOrTimeout of+    Left result -> return $ Just result+    Right () -> return Nothing  findTransport :: Endpoint -> Name -> IO (Maybe Transport) findTransport endpoint name = do

@@ -8,8 +8,6 @@ -- external imports  import Control.Concurrent-import Control.Concurrent.Async-import Control.Concurrent.STM import Control.Exception  import Data.Serialize@@ -79,14 +77,8 @@               Right () <- bindEndpoint endpoint2 name2               threadDelay $ 1 * 1000000               _ <- sendMessage endpoint1 name2 $ encode "hello!"-              msgVar <- atomically $ newTVar Nothing-              withAsync (do-                            msg <- receiveMessage endpoint2    -                            atomically $ writeTVar msgVar $ Just msg)-                (\_ -> do -                    threadDelay (2 * 1000000)-                    Just msg <- atomically $ readTVar msgVar-                    assertEqual "Received message not same as sent" (Right "hello!") (decode msg))+              Just msg <- receiveMessageTimeout endpoint2 (2 * 1000000)+              assertEqual "Received message not same as sent" (Right "hello!") (decode msg)               return ()))    testEndpointSendReceiveReply :: Assertion@@ -109,25 +101,13 @@                              infoM _log "Sending message from 1 to 2"               _ <- sendMessage endpoint1 name2 $ encode "hello!"-              msgVar1 <- atomically $ newTVar Nothing-              withAsync (do-                            msg <- receiveMessage endpoint2    -                            atomically $ writeTVar msgVar1 $ Just msg)-                (\_ -> do -                    threadDelay (1 * 1000000)-                    Just msg <- atomically $ readTVar msgVar1-                    assertEqual "Received message not same as sent" (Right "hello!") (decode msg))+              Just msg1 <- receiveMessageTimeout endpoint2 (1 * 1000000)+              assertEqual "Received message not same as sent" (Right "hello!") (decode msg1)                                infoM _log "Sending message from 2 to 1"               _ <- sendMessage endpoint2 name1 $ encode "hi!"-              msgVar2 <- atomically $ newTVar Nothing-              withAsync (do-                            msg <- receiveMessage endpoint1-                            atomically $ writeTVar msgVar2 $ Just msg)-                (\_ -> do -                    threadDelay (1 * 1000000)-                    Just msg <- atomically $ readTVar msgVar2-                    assertEqual "Received message not same as sent" (Right "hi!") (decode msg))+              Just msg2 <- receiveMessageTimeout endpoint1 (1 * 1000000)+              assertEqual "Received message not same as sent" (Right "hi!") (decode msg2)                                return ()))