network-messagepack-rpc 0.1.0.0 → 0.1.1.0

raw patch · 2 files changed

+44/−24 lines, 2 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• network-messagepack-rpc.cabal +3/−3
• src/Network/MessagePack/RPC/Client.hs +41/−21

@@ -1,8 +1,8 @@ name:                network-messagepack-rpc-version:             0.1.0.0+version:             0.1.1.0 synopsis:            MessagePack RPC description:         [MessagePack RPC](https://github.com/msgpack-rpc/msgpack-rpc/blob/master/spec.md) library based on the "data-msgpack" package.-homepage:            https://github.com/iij-ii/network-messagepack-rpc+homepage:            https://github.com/iij-ii/direct-hs/tree/master/network-messagepack-rpc license:             BSD3 license-file:        LICENSE author:              Yuji Yamamoto and Kazu Yamamoto@@ -27,4 +27,4 @@  source-repository head   type:     git-  location: https://github.com/iij-ii/network-messagepack-rpc+  location: https://github.com/iij-ii/direct-hs

@@ -2,30 +2,33 @@  -- | Backend-free MessagePack RPC Client. module Network.MessagePack.RPC.Client-  (+    (     -- * Config-    Config(..)-  , NotificationHandler-  , RequestHandler-  , Logger-  , Formatter-  , defaultConfig+      Config(..)+    , NotificationHandler+    , RequestHandler+    , Logger+    , Formatter+    , defaultConfig     -- * Backend-  , Backend(..)+    , Backend(..)     -- * Client-  , Client-  , withClient+    , Client+    , withClient+    , shutdown     -- * Call and reply-  , Result-  , call-  , reply-  ) where+    , Result+    , call+    , reply+    )+where -import           Control.Concurrent      (forkIO, killThread)+import           Control.Concurrent      (ThreadId, forkFinally, forkIO,+                                          killThread) import           Control.Concurrent.MVar (MVar) import qualified Control.Concurrent.MVar as MVar import qualified Control.Exception.Safe  as E-import           Control.Monad           (forever, void)+import           Control.Monad           (forever, void, when) import qualified Data.ByteString         as B import qualified Data.ByteString.Lazy    as BL import           Data.HashMap.Strict     (HashMap)@@ -44,6 +47,7 @@   , clientBackend      :: !Backend   , clientLog          :: Logger   , clientFormat       :: Formatter+  , clientHandlerTid   :: IORef (Maybe ThreadId)   }  data SessionState = SessionState {@@ -80,6 +84,7 @@     --   Until exiting from the block of 'withClient', the receiver thread     --   indefinitely waits for frames via 'backendRecv'.   , formatter           :: Formatter+  , waitRequestHandler  :: Bool   }  -- | The default configuration.@@ -92,6 +97,7 @@     , logger              = \_ -> return ()     , exceptionHandlers   = [E.Handler $ \(E.SomeException _) -> return ()]     , formatter           = show+    , waitRequestHandler  = False     }  -- | Backend IO functions.@@ -173,12 +179,26 @@ -- | Executing the action in the 3rd argument with a 'Client'. withClient :: Config -> Backend -> (Client -> IO a) -> IO a withClient config backend action = do-    ss <- initSessionState-    let client = Client ss backend (logger config) (formatter config)-    tid <- forkIO $ receiverThread client config-    takeAction client `E.finally` killThread tid+    ss     <- initSessionState+    wait   <- MVar.newEmptyMVar+    tidref <- IORef.newIORef Nothing+    let client = Client ss backend (logger config) (formatter config) tidref+    tid <- forkFinally (receiverThread client config)+        $ \_ -> MVar.putMVar wait ()+    IORef.writeIORef tidref $ Just tid+    takeAction client wait `E.finally` killThread tid   where-    takeAction client = do+    takeAction client wait = do         returned <- action client+        when (waitRequestHandler config) $ MVar.takeMVar wait         backendClose backend         return returned++-- | This function cleans up the internal states including+--   the termination of internal threads.+shutdown :: Client -> IO ()+shutdown client = do+    mtid <- IORef.readIORef $ clientHandlerTid client+    case mtid of+        Nothing  -> return ()+        Just tid -> killThread tid