Simplified demo

Author: sebright

.travis.yml

@@ -67,11 +67,7 @@ before_install:
    fi
 
    if [ "$AESONVER" = "0.6.0.0" ]; then
-       echo "constraints:attoparsec==0.8.6.1,blaze-builder==0.2.1.4,bytestring==0.9.1.8,happstack-server==6.2.4,hashable==1.1.2.0,mtl==1.1.1.0,network==2.3.0.1,test-framework-hunit==0.3.0,text==0.11.1.1,unordered-containers==0.1.3.0,vector==0.7.1,zlib==0.5.2.0" >> cabal.config;
-   fi
-
-   if [[ $HPVER == 2012.* ]]; then
-      echo "constraints:happstack-server==7.3.0" >> cabal.config;
+       echo "constraints:attoparsec==0.8.6.1,blaze-builder==0.2.1.4,bytestring==0.9.1.8,hashable==1.1.2.0,mtl==1.1.1.0,network==2.3.0.1,test-framework-hunit==0.3.0,text==0.11.1.1,unordered-containers==0.1.3.0,vector==0.7.1,zlib==0.5.2.0" >> cabal.config;
    fi
 
  - sudo add-apt-repository -y ppa:hvr/ghc

README.md

@@ -2,4 +2,4 @@ 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>. 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>.

demo/Demo.hs

@@ -3,34 +3,35 @@
 module Main (main) where
 
 import Network.JsonRpc.Server
-import Happstack.Server.SimpleHTTP( ServerPartT, simpleHTTP, nullConf
-                                  , askRq, rqBody, unBody, toResponse)
+import qualified Data.ByteString.Lazy.Char8 as B
 import Data.List (intercalate)
 import Data.Maybe (fromMaybe)
-import Control.Monad (when)
+import Control.Monad (forM_, when)
 import Control.Monad.Trans (liftIO)
 import Control.Monad.Error (throwError)
 import Control.Monad.Reader (ReaderT, ask, runReaderT)
-import Control.Concurrent.MVar (MVar, newMVar, readMVar, modifyMVar)
+import Control.Concurrent.MVar (MVar, newMVar, modifyMVar)
 
 main :: IO ()
-main = newMVar 0 >>= \count ->
-       simpleHTTP nullConf $ do
-         request <- askRq
-         body <- liftIO $ getBody request
-         result <- runReaderT (call methods body) count
-         let resultStr = fromMaybe "" result
-         return $ toResponse resultStr
-    where getBody r = unBody `fmap` readMVar (rqBody r)
+main = do
+  contents <- B.getContents
+  count <- newMVar 0
+  forM_ (B.lines contents) $ \request -> do
+         response <- runReaderT (call methods request) count
+         B.putStrLn $ fromMaybe "" response
 
-type Server = ReaderT (MVar Integer) (ServerPartT IO)
+type Server = ReaderT (MVar Integer) IO
 
 methods :: Methods Server
-methods = toMethods [printSequence, getCount, add]
+methods = toMethods [add, printSequence, increment]
 
-printSequence, getCount, add :: Method Server
+add, printSequence, increment :: Method Server
 
-printSequence = toMethod "print" f params
+add = toMethod "add" f (Required "x" :+: Required "y" :+: ())
+    where f :: Double -> Double -> RpcResult Server Double
+          f x y = liftIO $ return (x + y)
+
+printSequence = toMethod "print_sequence" f params
     where params = Required "string" :+:
                    Optional "count" 1 :+:
                    Optional "separator" ',' :+: ()
@@ -40,11 +41,7 @@ printSequence = toMethod "print" f params
               liftIO $ print $ intercalate [sep] $ replicate count str
           negativeCount = rpcError (-32000) "negative count"
 
-getCount = toMethod "get_count" f ()
+increment = toMethod "increment_and_get_count" f ()
     where f :: RpcResult Server Integer
           f = ask >>= \count -> liftIO $ modifyMVar count inc
               where inc x = return (x + 1, x + 1)
-
-add = toMethod "add" f (Required "x" :+: Required "y" :+: ())
-    where f :: Double -> Double -> RpcResult Server Double
-          f x y = liftIO $ return (x + y)

json-rpc-server.cabal

@@ -7,12 +7,12 @@ license:             MIT
 license-file:        LICENSE
 category:            Network, JSON
 maintainer:          Kristen Kozak <[email protected]>
-synopsis:            JSON RPC 2.0 on the server side.
+synopsis:            JSON-RPC 2.0 on the server side.
 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
-description:         An implementation of the server side of JSON RPC 2.0.
+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.
@@ -23,7 +23,7 @@ source-repository head
   location:          https://github.com/grayjay/json-rpc-server
 
 flag demo
-  description:       Builds the demo Happstack JSON RPC server.
+  description:       Builds the JSON-RPC demo.
   default:           False
   manual:            True
 
@@ -46,8 +46,8 @@ executable demo
   if flag (demo)
     build-depends:     base >=4.3 && <4.8,
                        json-rpc-server,
-                       mtl >=1.1.1 && <2.3,
-                       happstack-server >=6.2.4 && <7.4
+                       bytestring >=0.9 && <0.11,
+                       mtl >=1.1.1 && <2.3
     ghc-options:       -Wall
   else
     buildable:         False

src/Network/JsonRpc/Server.hs

@@ -8,7 +8,7 @@
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 #endif
 
--- | Functions for implementing the server side of JSON RPC 2.0.
+-- | Functions for implementing the server side of JSON-RPC 2.0.
 --   See <http://www.jsonrpc.org/specification>.
 module Network.JsonRpc.Server (
                           -- ** Instructions
@@ -66,8 +66,9 @@ import Control.Monad.Error (runErrorT, throwError)
 -- optional parameters.
 
 -- $example
--- Here is an example of a simple Happstack server with three methods.
--- Compile it with the build flag @demo@.
+-- Here is an example with three JSON-RPC methods. It reads requests
+-- from stdin and writes responses to stdout.  Compile it with the
+-- build flag @demo@.
 --   
 -- > <insert Demo.hs>
 --   
@@ -83,21 +84,21 @@ toMethods :: [Method m] -> Methods m
 toMethods fs = Methods $ H.fromList $ map pair fs
     where pair mth@(Method name _) = (name, mth)
 
--- | Handles one JSON RPC request. It is the same as
+-- | Handles one JSON-RPC request. It is the same as
 --   @callWithBatchStrategy sequence@.
 call :: Monad m => Methods m   -- ^ Choice of methods to call.
-     -> B.ByteString           -- ^ JSON RPC request.
+     -> 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.
 call = callWithBatchStrategy sequence
 
--- | Handles one JSON RPC request.
+-- | 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.
+                      -> 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.
@@ -139,7 +140,7 @@ lookupMethod name = maybe notFound return . H.lookup name
     where notFound = throwError $ rpcError (-32601) $ "Method not found: " `append` name
 
 throwInvalidRpc :: Monad m => Text -> RpcResult m a
-throwInvalidRpc = throwError . rpcErrorWithData (-32600) "Invalid JSON RPC 2.0 request"
+throwInvalidRpc = throwError . rpcErrorWithData (-32600) "Invalid JSON-RPC 2.0 request"
 
 batchCall :: Monad m => (forall a. [m a] -> m [a])
           -> Methods m

src/Network/JsonRpc/Types.hs

@@ -121,7 +121,7 @@ instance A.FromJSON Request where
               parseParams (A.Array ar) = return $ Right ar
               parseParams _ = empty
               checkVersion ver = when (ver /= jsonRpcVersion) $
-                            fail $ "Wrong JSON RPC version: " ++ unpack ver
+                            fail $ "Wrong JSON-RPC version: " ++ unpack ver
                -- (.:?) parses Null value as Nothing so parseId needs
                -- to use both (.:?) and (.:) to handle all cases
               parseId = x .:? idKey >>= \optional ->

tests/TestSuite.hs

@@ -32,7 +32,7 @@ errorHandlingTests :: [Test]
 errorHandlingTests = [ testCase "invalid JSON" $
                            assertSubtractResponse (A.String "5") $ nullIdErrRsp (-32700)
 
-                     , testCase "invalid JSON RPC" $
+                     , testCase "invalid JSON-RPC" $
                            assertSubtractResponse (A.object ["id" .= A.Number 10]) $ nullIdErrRsp (-32600)
 
                      , testCase "empty batch call" $