Skip to content

Commit 51cbc16

Browse files
sebrightsebright
committed
Started updating to use aeson-0.7.0.0
1 parent b9c9786 commit 51cbc16

File tree

4 files changed

+53
-45
lines changed

4 files changed

+53
-45
lines changed

‎json-rpc-server.cabal‎

Lines changed: 4 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
-- documentation, see http://haskell.org/cabal/users-guide/
33

44
name: json-rpc-server
5-
version: 0.1.0.0
5+
version: 0.1.1.0
66
license: MIT
77
license-file: LICENSE
88
category: Network, JSON
@@ -31,13 +31,12 @@ library
3131
exposed-modules: Network.JsonRpc.Server
3232
other-modules: Network.JsonRpc.Types
3333
build-depends: base >=4.5 && <4.7,
34-
aeson >=0.6 && <0.7,
34+
aeson >=0.6 && <0.8,
3535
bytestring >=0.9 && <0.11,
3636
mtl >=2.1 && <2.2,
3737
text >=0.11 && <0.12,
3838
vector >=0.8 && <0.11,
39-
unordered-containers >=0.1 && <0.3,
40-
attoparsec >=0.8 && <0.11
39+
unordered-containers >=0.1 && <0.3
4140
hs-source-dirs: src
4241
ghc-options: -Wall
4342

@@ -68,6 +67,5 @@ test-suite tests
6867
mtl,
6968
text,
7069
vector,
71-
unordered-containers,
72-
attoparsec
70+
unordered-containers
7371
ghc-options: -Wall -fno-warn-incomplete-patterns

‎src/Network/JsonRpc/Types.hs‎

Lines changed: 5 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,6 @@ import Data.Aeson ((.=), (.:), (.:?), (.!=))
2727
import Data.Aeson.Types (emptyObject)
2828
import qualified Data.Vector as V
2929
import qualified Data.HashMap.Strict as H
30-
import Data.Attoparsec.Number (Number)
3130
import Control.Applicative ((<$>), (<*>), (<|>), (*>), empty)
3231
import Control.Monad (when)
3332
import Control.Monad.Error (Error, ErrorT, throwError, strMsg, noMsg)
@@ -126,17 +125,17 @@ instance A.ToJSON Response where
126125
, either ("error" .=) ("result" .=) result
127126
, idKey .= i]
128127

129-
data Id = IdString Text | IdNumber Number | IdNull
128+
data Id = IdString A.Value | IdNumber A.Value | IdNull
130129

131130
instance A.FromJSON Id where
132-
parseJSON (A.String x) = return $ IdString x
133-
parseJSON (A.Number x) = return $ IdNumber x
131+
parseJSON x@(A.String _) = return $ IdString x
132+
parseJSON x@(A.Number _) = return $ IdNumber x
134133
parseJSON A.Null = return IdNull
135134
parseJSON _ = empty
136135

137136
instance A.ToJSON Id where
138-
toJSON (IdString x) = A.String x
139-
toJSON (IdNumber x) = A.Number x
137+
toJSON (IdString x) = x
138+
toJSON (IdNumber x) = x
140139
toJSON IdNull = A.Null
141140

142141
-- | Error to be returned to the client.

‎tests/TestSuite.hs‎

Lines changed: 25 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ module Main (main) where
44

55
import Network.JsonRpc.Server
66
import TestTypes
7-
import Data.List ((\\), sort)
7+
import Data.List ((\\))
88
import Data.Aeson
99
import Data.Aeson.Types
1010
import Data.Text (Text)
@@ -60,48 +60,48 @@ testEncodeErrorWithData = (fromByteString $ encode $ toJSON err) @?= Just testEr
6060
errorData = (['\x03BB'], True, ())
6161

6262
testInvalidJson :: Assertion
63-
testInvalidJson = checkResponseWithSubtract "5" IdNull (-32700)
63+
testInvalidJson = checkResponseWithSubtract "5" idNull (-32700)
6464

6565
testInvalidJsonRpc :: Assertion
66-
testInvalidJsonRpc = checkResponseWithSubtract (encode $ object ["id" .= (10 :: Int)]) IdNull (-32600)
66+
testInvalidJsonRpc = checkResponseWithSubtract (encode $ object ["id" .= (10 :: Int)]) idNull (-32600)
6767

6868
testEmptyBatchCall :: Assertion
69-
testEmptyBatchCall = checkResponseWithSubtract (encode emptyArray) IdNull (-32600)
69+
testEmptyBatchCall = checkResponseWithSubtract (encode emptyArray) idNull (-32600)
7070

7171
testWrongVersion :: Assertion
72-
testWrongVersion = checkResponseWithSubtract (encode requestWrongVersion) IdNull (-32600)
72+
testWrongVersion = checkResponseWithSubtract (encode requestWrongVersion) idNull (-32600)
7373
where requestWrongVersion = Object $ H.insert versionKey (String "1") hm
74-
Object hm = toJSON $ subtractRequestNamed [("a1", Number 4)] (IdNumber 10)
74+
Object hm = toJSON $ subtractRequestNamed [("a1", Number 4)] (idNumber 10)
7575

7676
testMethodNotFound :: Assertion
7777
testMethodNotFound = checkResponseWithSubtract (encode request) i (-32601)
7878
where request = TestRequest "ad" Nothing (Just i)
79-
i = IdNumber 3
79+
i = idNumber 3
8080

8181
testWrongMethodNameCapitalization :: Assertion
8282
testWrongMethodNameCapitalization = checkResponseWithSubtract (encode request) i (-32601)
8383
where request = TestRequest "Add" Nothing (Just i)
84-
i = IdNull
84+
i = idNull
8585

8686
testMissingRequiredNamedArg :: Assertion
8787
testMissingRequiredNamedArg = checkResponseWithSubtract (encode request) i (-32602)
8888
where request = subtractRequestNamed [("A1", Number 1), ("a2", Number 20)] i
89-
i = IdNumber 2
89+
i = idNumber 2
9090

9191
testMissingRequiredUnnamedArg :: Assertion
9292
testMissingRequiredUnnamedArg = checkResponseWithSubtract (encode request) i (-32602)
9393
where request = TestRequest "subtract 2" (Just $ Right $ V.fromList [Number 0]) (Just i)
94-
i = IdString ""
94+
i = idString ""
9595

9696
testWrongArgType :: Assertion
9797
testWrongArgType = checkResponseWithSubtract (encode request) i (-32602)
9898
where request = subtractRequestNamed [("a1", Number 1), ("a2", Bool True)] i
99-
i = IdString "ABC"
99+
i = idString "ABC"
100100

101101
testDisallowExtraUnnamedArg :: Assertion
102102
testDisallowExtraUnnamedArg = checkResponseWithSubtract (encode request) i (-32602)
103103
where request = subtractRequestUnnamed (map Number [1, 2, 3]) i
104-
i = IdString "i"
104+
i = idString "i"
105105

106106
testNoResponseToInvalidNotification :: Assertion
107107
testNoResponseToInvalidNotification = runIdentity response @?= Nothing
@@ -114,8 +114,8 @@ testBatch = assert (fromJust (fromByteString =<< runIdentity response) `equalCon
114114
response = call (toMethods [subtractMethod]) $ encode request
115115
request = [subtractRequestNamed (toArgs 10 8) i1, subtractRequestNamed (toArgs 24 20) i2]
116116
toArgs x y = [("a1", Number x), ("a2", Number y)]
117-
i1 = IdString "1"
118-
i2 = IdString "2"
117+
i1 = idString "1"
118+
i2 = idString "2"
119119

120120
testBatchNotifications :: Assertion
121121
testBatchNotifications = runState response 0 @?= (Nothing, 10)
@@ -127,32 +127,32 @@ testAllowMissingVersion = (fromByteString =<< runIdentity response) @?= (Just $
127127
where requestNoVersion = Object $ H.delete versionKey hm
128128
Object hm = toJSON $ subtractRequestNamed [("a1", Number 1)] i
129129
response = call (toMethods [subtractMethod]) $ encode requestNoVersion
130-
i = IdNumber (-1)
130+
i = idNumber (-1)
131131

132132
testAllowExtraNamedArg :: Assertion
133133
testAllowExtraNamedArg = (fromByteString =<< runIdentity response) @?= (Just $ TestResponse i (Right $ Number (-10)))
134134
where response = call (toMethods [subtractMethod]) $ encode request
135135
request = subtractRequestNamed args i
136136
args = [("a1", Number 10), ("a2", Number 20), ("a3", String "extra")]
137-
i = IdString "ID"
137+
i = idString "ID"
138138

139139
testDefaultNamedArg :: Assertion
140140
testDefaultNamedArg = (fromByteString =<< runIdentity response) @?= (Just $ TestResponse i (Right $ Number 1000))
141141
where response = call (toMethods [subtractMethod]) $ encode request
142142
request = subtractRequestNamed args i
143143
args = [("a", Number 500), ("a1", Number 1000)]
144-
i = IdNumber 3
144+
i = idNumber 3
145145

146146
testDefaultUnnamedArg :: Assertion
147147
testDefaultUnnamedArg = (fromByteString =<< runIdentity response) @?= (Just $ TestResponse i (Right $ Number 4))
148148
where response = call (toMethods [subtractMethod]) $ encode request
149149
request = subtractRequestUnnamed [Number 4] i
150-
i = IdNumber 0
150+
i = idNumber 0
151151

152152
testNullId :: Assertion
153-
testNullId = (fromByteString =<< runIdentity response) @?= (Just $ TestResponse IdNull (Right $ Number (-80)))
153+
testNullId = (fromByteString =<< runIdentity response) @?= (Just $ TestResponse idNull (Right $ Number (-80)))
154154
where response = call (toMethods [subtractMethod]) $ encode request
155-
request = subtractRequestNamed args IdNull
155+
request = subtractRequestNamed args idNull
156156
args = [("a2", Number 70), ("a1", Number (-10))]
157157

158158
testNoArgs :: Assertion
@@ -167,14 +167,14 @@ testEmptyNamedArgs = compareGetTimeResult $ Just $ Left H.empty
167167
testParallelizingTasks :: Assertion
168168
testParallelizingTasks = assert $ do
169169
a <- actual
170-
let ids = map fromIdNumber a
170+
let ids = map rspId a
171171
vals = map fromResult a
172-
return $ (sort ids == [1, 2]) &&
173-
(sort vals == ["A", "B"])
172+
return $ (equalContents ids $ map idNumber [1, 2]) &&
173+
(equalContents vals ["A", "B"])
174174
where actual = (fromJust . fromByteString . fromJust) <$> (flip (callWithBatchStrategy parallelize) input =<< methods)
175175
input = encode [ lockRequest 1, unlockRequest (String "A")
176176
, unlockRequest (String "B"), lockRequest 2]
177-
lockRequest i = TestRequest "lock" Nothing (Just $ IdNumber i)
177+
lockRequest i = TestRequest "lock" Nothing (Just $ idNumber i)
178178
unlockRequest str = TestRequest "unlock" (Just $ Right $ V.fromList [str]) Nothing
179179
methods = createMethods <$> newEmptyMVar
180180
createMethods lock = toMethods [lockMethod lock, unlockMethod lock]
@@ -185,7 +185,6 @@ testParallelizingTasks = assert $ do
185185
where f :: String -> RpcResult IO ()
186186
f val = liftIO $ putMVar lock val
187187
fromResult r | Right (String str) <- rspResult r = str
188-
fromIdNumber r | IdNumber i <- rspId r = i
189188

190189
parallelize :: [IO a] -> IO [a]
191190
parallelize tasks = do
@@ -205,7 +204,7 @@ compareGetTimeResult requestArgs = assertEqual "unexpected rpc response" expecte
205204
((fromByteString . fromJust) <$> call (toMethods [getTimeMethod]) (encode getTimeRequest))
206205
where expected = Just $ TestResponse i (Right $ Number 100)
207206
getTimeRequest = TestRequest "get_time_seconds" requestArgs (Just i)
208-
i = IdString "Id 1"
207+
i = idString "Id 1"
209208

210209
subtractRequestNamed :: [(Text, Value)] -> TestId -> TestRequest
211210
subtractRequestNamed args i = TestRequest "subtract 1" (Just $ Left $ H.fromList args) (Just i)

‎tests/TestTypes.hs‎

Lines changed: 19 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -3,14 +3,17 @@
33
module TestTypes ( TestRequest (..)
44
, TestResponse (..)
55
, TestRpcError (..)
6-
, TestId (..)
6+
, TestId
7+
, idString
8+
, idNumber
9+
, idNull
710
, versionKey) where
811

912
import qualified Data.Aeson as A
1013
import Data.Aeson ((.=), (.:), (.:?))
1114
import Data.Maybe (catMaybes)
15+
import Data.String (IsString, fromString)
1216
import Data.Text (Text, pack)
13-
import Data.Attoparsec.Number (Number)
1417
import Data.HashMap.Strict (size)
1518
import Control.Applicative ((<$>), (<*>), (<|>), pure, empty)
1619
import Control.Monad (when, guard)
@@ -48,18 +51,27 @@ instance A.FromJSON TestResponse where
4851
((Left <$> obj .: "error") <|> (Right <$> obj .: "result"))
4952
parseJSON _ = empty
5053

51-
data TestId = IdString Text | IdNumber Number | IdNull
54+
data TestId = IdString A.Value | IdNumber A.Value | IdNull
5255
deriving (Eq, Show)
5356

57+
idString :: String -> TestId
58+
idString = IdString . A.String . fromString
59+
60+
idNumber :: Integer -> TestId
61+
idNumber = IdNumber . A.Number . fromInteger
62+
63+
idNull :: TestId
64+
idNull = IdNull
65+
5466
instance A.FromJSON TestId where
55-
parseJSON (A.String x) = return $ IdString x
56-
parseJSON (A.Number x) = return $ IdNumber x
67+
parseJSON x@(A.String _) = return $ IdString x
68+
parseJSON x@(A.Number _) = return $ IdNumber x
5769
parseJSON A.Null = return IdNull
5870
parseJSON _ = empty
5971

6072
instance A.ToJSON TestId where
61-
toJSON (IdString x) = A.String x
62-
toJSON (IdNumber x) = A.Number x
73+
toJSON (IdString x) = x
74+
toJSON (IdNumber x) = x
6375
toJSON IdNull = A.Null
6476

6577
versionKey :: Text

0 commit comments

Comments
 (0)