json-rpc-server 0.1.4.0 → 0.1.5.0

raw patch · 8 files changed

+66/−27 lines, 8 filesdep +deepseqdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: deepseq

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• README.md +2/−2
• demo/Demo.hs +2/−1
• json-rpc-server.cabal +11/−6
• src/Network/JsonRpc/Server.hs +15/−10
• src/Network/JsonRpc/Types.hs +18/−2
• tests/Internal.hs +5/−1
• tests/TestParallelism.hs +7/−3
• tests/TestSuite.hs +6/−2

@@ -1,5 +1,5 @@ json-rpc-server ===============-[![Build Status](https://travis-ci.org/grayjay/json-rpc-server.svg?branch=master)](https://travis-ci.org/grayjay/json-rpc-server)+[![Hackage](https://img.shields.io/hackage/v/json-rpc-server.svg?style=flat)](https://hackage.haskell.org/package/json-rpc-server) [![Build Status](https://travis-ci.org/grayjay/json-rpc-server.svg?branch=master)](https://travis-ci.org/grayjay/json-rpc-server) -An implementation of the server side of JSON-RPC 2.0. See <http://www.jsonrpc.org/specification>. This library uses ByteString for input and output, leaving the choice of transport up to the user. The documentation is on Hackage: <http://hackage.haskell.org/package/json-rpc-server>.+An implementation of the server side of JSON-RPC 2.0. See <http://www.jsonrpc.org/specification>.  json-rpc-server uses ByteString for input and output, leaving the choice of transport up to the user.  It can be used with [json-rpc-client](http://hackage.haskell.org/package/json-rpc-client) to create a client and server that communicate with the same methods.

@@ -3,6 +3,7 @@ module Main (main) where  import Network.JsonRpc.Server+import System.IO (BufferMode (LineBuffering), hSetBuffering, stdout) import qualified Data.ByteString.Lazy.Char8 as B import Data.List (intercalate) import Data.Maybe (fromMaybe)@@ -12,8 +13,8 @@ import Control.Monad.Reader (ReaderT, ask, runReaderT) import Control.Concurrent.MVar (MVar, newMVar, modifyMVar) -main :: IO () main = do+  hSetBuffering stdout LineBuffering   contents <- B.getContents   count <- newMVar 0   forM_ (B.lines contents) $ \request -> do

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                json-rpc-server-version:             0.1.4.0+version:             0.1.5.0 license:             MIT license-file:        LICENSE category:            Network, JSON@@ -11,12 +11,17 @@ build-type:          Simple extra-source-files:  README.md cabal-version:       >=1.8-tested-with:         GHC == 7.0.1, GHC == 7.4.1, GHC == 7.6.2, GHC == 7.6.3, GHC == 7.8.3+tested-with:         GHC == 7.0.1, GHC == 7.4.1, GHC == 7.6.2,+                     GHC == 7.6.3, GHC == 7.8.3, GHC == 7.10.1 description:         An implementation of the server side of JSON-RPC 2.0.                      See <http://www.jsonrpc.org/specification>. This                      library uses 'ByteString' for input and output,                      leaving the choice of transport up to the user.                      See the "Network.JsonRpc.Server" module for an example.+                     json-rpc-server can be used with+                     <http://hackage.haskell.org/package/json-rpc-client json-rpc-client>+                     to create a client and server that communicate+                     with the same methods.  source-repository head   type:              git@@ -30,8 +35,9 @@ library   exposed-modules:     Network.JsonRpc.Server   other-modules:       Network.JsonRpc.Types-  build-depends:       base >=4.3 && <4.8,+  build-depends:       base >=4.3 && <4.9,                        aeson >=0.6 && <0.9,+                       deepseq >= 1.1 && <1.5,                        bytestring >=0.9 && <0.11,                        mtl >=1.1.1 && <2.3,                        text >=0.11 && <1.3,@@ -44,11 +50,10 @@   main-is:             Demo.hs   hs-source-dirs:      demo   if flag (demo)-    build-depends:     base >=4.3 && <4.8,+    build-depends:     base >=4.3 && <4.9,                        json-rpc-server,                        bytestring >=0.9 && <0.11,                        mtl >=1.1.1 && <2.3-    ghc-options:       -Wall   else     buildable:         False @@ -57,7 +62,7 @@   main-is:             TestSuite.hs   other-modules:       TestParallelism, Internal   type:                exitcode-stdio-1.0-  build-depends:       base >=4.3 && <4.8,+  build-depends:       base >=4.3 && <4.9,                        json-rpc-server,                        HUnit >=1.2 && <1.3,                        test-framework >=0.7 && <0.9,

@@ -43,11 +43,15 @@ import qualified Data.Aeson as A import qualified Data.Vector as V import qualified Data.HashMap.Strict as H-import Control.Applicative ((<$>))+import Control.DeepSeq (NFData) import Control.Monad (liftM) import Control.Monad.Identity (runIdentity) import Control.Monad.Error (runErrorT, throwError) +#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>))+#endif+ -- $instructions -- * Create methods by calling 'toMethod' and providing the method --   names, lists of parameters, and functions to be called.@@ -77,6 +81,7 @@ -- > module Main (main) where -- >  -- > import Network.JsonRpc.Server+-- > import System.IO (BufferMode (LineBuffering), hSetBuffering, stdout) -- > import qualified Data.ByteString.Lazy.Char8 as B -- > import Data.List (intercalate) -- > import Data.Maybe (fromMaybe)@@ -86,8 +91,8 @@ -- > import Control.Monad.Reader (ReaderT, ask, runReaderT) -- > import Control.Concurrent.MVar (MVar, newMVar, modifyMVar) -- > --- > main :: IO () -- > main = do+-- >   hSetBuffering stdout LineBuffering -- >   contents <- B.getContents -- >   count <- newMVar 0 -- >   forM_ (B.lines contents) $ \request -> do@@ -143,13 +148,13 @@  -- | Handles one JSON-RPC request. callWithBatchStrategy :: Monad m =>-                         (forall a . [m a] -> m [a]) -- ^ Function specifying the-                                                     --   evaluation strategy.-                      -> Methods m                   -- ^ Choice of methods to call.-                      -> B.ByteString                -- ^ JSON-RPC request.-                      -> m (Maybe B.ByteString)      -- ^ The response wrapped in 'Just', or-                                                     --   'Nothing' in the case of a notification,-                                                     --   all wrapped in the given monad.+                         (forall a . NFData a => [m a] -> m [a]) -- ^ Function specifying the+                                                                 --   evaluation strategy.+                      -> Methods m                               -- ^ Choice of methods to call.+                      -> B.ByteString                            -- ^ JSON-RPC request.+                      -> m (Maybe B.ByteString)                  -- ^ The response wrapped in 'Just', or+                                                                 --   'Nothing' in the case of a notification,+                                                                 --   all wrapped in the given monad. callWithBatchStrategy strategy fs input = either returnErr callMethod request     where request :: Either RpcError (Either A.Value [A.Value])           request = runIdentity $ runErrorT $ parseVal =<< parseJson input@@ -190,7 +195,7 @@ throwInvalidRpc :: Monad m => Text -> RpcResult m a throwInvalidRpc = throwError . rpcErrorWithData (-32600) "Invalid JSON-RPC 2.0 request" -batchCall :: Monad m => (forall a. [m a] -> m [a])+batchCall :: Monad m => (forall a. NFData a => [m a] -> m [a])           -> Methods m           -> [A.Value]           -> m (Maybe [Response])

@@ -32,11 +32,16 @@ import Data.Aeson.Types (emptyObject) import qualified Data.Vector as V import qualified Data.HashMap.Strict as H-import Control.Applicative ((<$>), (<*>), (<|>), (*>), empty)+import Control.DeepSeq (NFData, rnf) import Control.Monad (mplus, when) import Control.Monad.Error (Error, ErrorT, throwError, strMsg, noMsg) import Prelude hiding (length)+import Control.Applicative ((<|>), empty) +#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>), (<*>), (*>))+#endif+ -- | Return type of a method. A method call can either fail with an 'RpcError' --   or succeed with a result of type 'r'. type RpcResult m r = ErrorT RpcError m r@@ -132,6 +137,9 @@  data Response = Response Id (Either RpcError A.Value) +instance NFData Response where+    rnf (Response i e) = rnf i `seq` rnf e+ instance A.ToJSON Response where     toJSON (Response i result) = A.object pairs         where pairs = [ versionKey .= jsonRpcVersion@@ -142,6 +150,11 @@ -- since it changes between aeson-0.6 and 0.7. data Id = IdString A.Value | IdNumber A.Value | IdNull +instance NFData Id where+    rnf (IdString s) = rnf s+    rnf (IdNumber n) = rnf n+    rnf IdNull = ()+ instance A.FromJSON Id where     parseJSON x@(A.String _) = return $ IdString x     parseJSON x@(A.Number _) = return $ IdNumber x@@ -157,7 +170,10 @@ data RpcError = RpcError { errCode :: Int                          , errMsg :: Text                          , errData :: Maybe A.Value }-                           deriving (Show, Eq)+                deriving (Show, Eq)++instance NFData RpcError where+    rnf (RpcError e m d) = rnf e `seq` rnf m `seq` rnf d  instance Error RpcError where     noMsg = strMsg "unknown error"

@@ -1,4 +1,5 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP,+             OverloadedStrings #-}  module Internal ( request                 , errRsp@@ -21,7 +22,10 @@ import Data.Maybe (catMaybes) import qualified Data.Vector as V import Data.Text (Text)++#if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>))+#endif  array :: [A.Value] -> A.Value array = A.Array . V.fromList

@@ -1,4 +1,5 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP,+             OverloadedStrings #-}  module TestParallelism (testParallelizingTasks) where @@ -11,12 +12,15 @@ import Data.Aeson ((.=)) import qualified Data.Aeson.Types as A import Data.Maybe (fromJust)-import Control.Applicative ((<$>)) import Control.Monad.Trans (liftIO) import Control.Concurrent (forkIO) import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar) import Test.HUnit (Assertion, assert) +#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>))+#endif+ -- | Tests parallelizing a batch request.  Each request either --   locks or unlocks an MVar.  The MVar is initially locked, --   so the first lock request cannot succeed if the requests@@ -37,7 +41,7 @@  possibleResponses :: [[A.Value]] possibleResponses = (rsp <$>) <$> perms-    where perms = zip `zipWith` repeat [1, 2, 3] $ permutations ["A", "B", "C"] +    where perms = map (zip [1, 2, 3]) $ permutations ["A", "B", "C"]           rsp (i, r) = defaultRsp `result` A.String r `id'` Just (A.Number i)  lockRequest :: Int -> A.Value

@@ -1,4 +1,5 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP,+             OverloadedStrings #-}  module Main (main) where @@ -16,7 +17,6 @@ import Data.Aeson ((.=)) import qualified Data.Aeson.Types as A import qualified Data.HashMap.Strict as H-import Control.Applicative ((<$>)) import Control.Monad.Trans (liftIO) import Control.Monad.State (State, runState, lift, modify) import Control.Monad.Identity (Identity, runIdentity)@@ -24,6 +24,10 @@ import Test.Framework (defaultMain, Test) import Test.Framework.Providers.HUnit (testCase) import Prelude hiding (subtract)++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>))+#endif  main :: IO () main = defaultMain $ errorHandlingTests ++ otherTests