Skip to content

Commit 534e1c8

Browse files
committed
Continued moving tests into defaultMain
1 parent 5c67e11 commit 534e1c8

File tree

1 file changed

+24
-40
lines changed

1 file changed

+24
-40
lines changed

tests/TestSuite.hs

Lines changed: 24 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -63,19 +63,34 @@ main = defaultMain [ testCase "encode RPC error" testEncodeRpcError
6363
rsp = errResponse nonNullId (-32602)
6464
in testCase "disallow extra unnamed arguments" $ assertSubtractResponse req rsp
6565

66-
, testCase "invalid notification" testNoResponseToInvalidNotification
66+
, let req = TestRequest "12345" (Nothing :: Maybe ()) Nothing
67+
in testCase "invalid notification" $ callSubtractMethods req @?= (Nothing :: Maybe Value)
68+
6769
, testCase "batch request" testBatch
6870
, testCase "batch notifications" testBatchNotifications
6971
, testCase "allow missing version" testAllowMissingVersion
7072
, testCase "no arguments" testNoArgs
7173
, testCase "empty argument array" testEmptyUnnamedArgs
7274
, testCase "empty argument object" testEmptyNamedArgs
73-
, testCase "allow extra named argument" testAllowExtraNamedArg
74-
, testCase "use default named argument" testDefaultNamedArg
75-
, testCase "use default unnamed argument" testDefaultUnnamedArg
76-
, testCase "null request ID" testNullId
75+
76+
, let req = subtractRequestNamed [("x", Number 10), ("y", Number 20), ("z", String "extra")] nonNullId
77+
rsp = TestResponse nonNullId $ Right $ Number (-10)
78+
in testCase "allow extra named argument" $ assertSubtractResponse req rsp
79+
80+
, let req = subtractRequestNamed [("x1", Number 500), ("x", Number 1000)] nonNullId
81+
rsp = TestResponse nonNullId (Right $ Number 1000)
82+
in testCase "use default named argument" $ assertSubtractResponse req rsp
83+
84+
, let req = subtractRequestUnnamed [Number 4] nonNullId
85+
rsp = TestResponse nonNullId (Right $ Number 4)
86+
in testCase "use default unnamed argument" $ assertSubtractResponse req rsp
87+
88+
, let req = subtractRequestNamed [("y", Number 70), ("x", Number (-10))] idNull
89+
rsp = TestResponse idNull (Right $ Number (-80))
90+
in testCase "null request ID" $ assertSubtractResponse req rsp
91+
7792
, testCase "parallelize tasks" P.testParallelizingTasks ]
78-
93+
7994
testEncodeRpcError :: Assertion
8095
testEncodeRpcError = fromByteString (encode err) @?= Just testError
8196
where err = rpcError (-1) "error"
@@ -100,11 +115,6 @@ testWrongVersion = removeErrMsg <$> rsp @?= Just (errResponse idNull (-32600))
100115
where rsp = callSubtractMethods $ Object $ H.insert versionKey (String "1") hm
101116
Object hm = toJSON $ subtractRequestNamed [("x", Number 4)] nonNullId
102117

103-
testNoResponseToInvalidNotification :: Assertion
104-
testNoResponseToInvalidNotification = runIdentity response @?= Nothing
105-
where response = call (toMethods [subtractMethod]) $ encode request
106-
request = TestRequest "12345" (Nothing :: Maybe ()) Nothing
107-
108118
testBatch :: Assertion
109119
testBatch = sortBy (compare `on` fromIntId) (fromJust (fromByteString =<< runIdentity response)) @?= expected
110120
where expected = [TestResponse i1 (Right $ Number 2), TestResponse i2 (Right $ Number 4)]
@@ -127,32 +137,6 @@ testAllowMissingVersion = (fromByteString =<< runIdentity response) @?= (Just $
127137
response = call (toMethods [subtractMethod]) $ encode requestNoVersion
128138
i = idNumber (-1)
129139

130-
testAllowExtraNamedArg :: Assertion
131-
testAllowExtraNamedArg = (fromByteString =<< runIdentity response) @?= (Just $ TestResponse i (Right $ Number (-10)))
132-
where response = call (toMethods [subtractMethod]) $ encode request
133-
request = subtractRequestNamed args i
134-
args = [("x", Number 10), ("y", Number 20), ("z", String "extra")]
135-
i = idString "ID"
136-
137-
testDefaultNamedArg :: Assertion
138-
testDefaultNamedArg = (fromByteString =<< runIdentity response) @?= (Just $ TestResponse i (Right $ Number 1000))
139-
where response = call (toMethods [subtractMethod]) $ encode request
140-
request = subtractRequestNamed args i
141-
args = [("x1", Number 500), ("x", Number 1000)]
142-
i = idNumber 3
143-
144-
testDefaultUnnamedArg :: Assertion
145-
testDefaultUnnamedArg = (fromByteString =<< runIdentity response) @?= (Just $ TestResponse i (Right $ Number 4))
146-
where response = call (toMethods [subtractMethod]) $ encode request
147-
request = subtractRequestUnnamed [Number 4] i
148-
i = idNumber 0
149-
150-
testNullId :: Assertion
151-
testNullId = (fromByteString =<< runIdentity response) @?= (Just $ TestResponse idNull (Right $ Number (-80)))
152-
where response = call (toMethods [subtractMethod]) $ encode request
153-
request = subtractRequestNamed args idNull
154-
args = [("y", Number 70), ("x", Number (-10))]
155-
156140
testNoArgs :: Assertion
157141
testNoArgs = compareGetTimeResult Nothing
158142

@@ -175,10 +159,10 @@ compareGetTimeResult requestArgs = assertEqual "unexpected rpc response" expecte
175159
i = idString "Id 1"
176160

177161
subtractRequestNamed :: [(Text, Value)] -> TestId -> TestRequest
178-
subtractRequestNamed args i = TestRequest "subtract 1" (Just $ H.fromList args) (Just i)
162+
subtractRequestNamed args i = TestRequest "subtract" (Just $ H.fromList args) (Just i)
179163

180164
subtractRequestUnnamed :: [Value] -> TestId -> TestRequest
181-
subtractRequestUnnamed args i = TestRequest "subtract 1" (Just args) (Just i)
165+
subtractRequestUnnamed args i = TestRequest "subtract" (Just args) (Just i)
182166

183167
callSubtractMethods :: (ToJSON a, FromJSON b) => a -> Maybe b
184168
callSubtractMethods req = let methods :: Methods Identity
@@ -192,7 +176,7 @@ fromByteString str = case fromJSON <$> decode str of
192176
_ -> Nothing
193177

194178
subtractMethod :: Method Identity
195-
subtractMethod = toMethod "subtract 1" sub (Required "x" :+: Optional "y" 0 :+: ())
179+
subtractMethod = toMethod "subtract" sub (Required "x" :+: Optional "y" 0 :+: ())
196180
where sub :: Int -> Int -> RpcResult Identity Int
197181
sub x y = return (x - y)
198182

0 commit comments

Comments
 (0)