Skip to content

Commit ac5e4fb

Browse files
garybgaryb
authored
Merge pull request #53 from purescript-contrib/bump
Update dependencies, remove dependency on test-unit
2 parents 3be823e + da3a9fd commit ac5e4fb

File tree

2 files changed

+72
-39
lines changed

2 files changed

+72
-39
lines changed

‎bower.json

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -22,16 +22,17 @@
2222
},
2323
"license": "MIT",
2424
"dependencies": {
25-
"purescript-argonaut-core": "^4.0.0",
25+
"purescript-argonaut-core": "^5.0.0",
2626
"purescript-integers": "^4.0.0",
2727
"purescript-maybe": "^4.0.0",
2828
"purescript-ordered-collections": "^1.0.0",
29-
"purescript-foreign-object": "^1.0.0",
30-
"purescript-record": "^1.0.0",
29+
"purescript-foreign-object": "^2.0.0",
30+
"purescript-record": "^2.0.0",
3131
"purescript-nonempty": "^5.0.0",
3232
"purescript-arrays": "^5.1.0"
3333
},
3434
"devDependencies": {
35-
"purescript-test-unit": "^14.0.0"
35+
"purescript-assert": "^4.1.0",
36+
"purescript-quickcheck": "^6.1.0"
3637
}
3738
}

‎test/Test/Main.purs

Lines changed: 67 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@ module Test.Main where
33
import Prelude
44

55
import Control.Monad.Gen.Common (genMaybe)
6+
import Control.Monad.Reader (ReaderT, ask, local, runReaderT)
67
import Data.Argonaut.Core (Json, isObject, stringify, toObject)
78
import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.:), (.:!), (.:?), (.!=))
89
import Data.Argonaut.Encode (encodeJson, (:=), (:=?), (~>), (~>?))
@@ -12,23 +13,54 @@ import Data.Bifunctor (rmap)
1213
import Data.Either (Either(..))
1314
import Data.Foldable (foldl)
1415
import Data.List (List)
16+
import Data.List as List
1517
import Data.Maybe (Maybe(..), isJust, isNothing, maybe)
18+
import Data.Monoid (power)
1619
import Data.NonEmpty (NonEmpty)
1720
import Data.String.Gen (genUnicodeString)
1821
import Data.Tuple (Tuple(..))
1922
import Effect (Effect)
23+
import Effect.Class (liftEffect)
24+
import Effect.Class.Console (log)
25+
import Effect.Exception (throw)
2026
import Foreign.Object as FO
21-
import Test.QuickCheck (Result(..), (<?>), (===))
27+
import Test.Assert as Assert
28+
import Test.QuickCheck (Result(..), unSeed, (<?>), (===))
29+
import Test.QuickCheck as LCG
30+
import Test.QuickCheck as QC
2231
import Test.QuickCheck.Arbitrary (arbitrary)
2332
import Test.QuickCheck.Gen (Gen, resize, suchThat)
24-
import Test.Unit (TestSuite, failure, success, suite, test)
25-
import Test.Unit.Assert as Assert
26-
import Test.Unit.Main (runTest)
27-
import Test.Unit.QuickCheck (quickCheck)
2833

34+
type Test = ReaderT Int Effect Unit
35+
36+
suite :: String -> Test -> Test
37+
suite = test
38+
39+
test :: String -> Test -> Test
40+
test name run = do
41+
indent <- ask
42+
log (mkIndent indent <> name)
43+
local (_ + 2) run
44+
45+
mkIndent :: Int -> String
46+
mkIndent = power " "
47+
48+
assertEqual :: forall a. Eq a => Show a => { actual :: a, expected :: a } -> Test
49+
assertEqual = liftEffect <<< Assert.assertEqual
50+
51+
quickCheck :: forall prop. QC.Testable prop => prop -> Test
52+
quickCheck prop = liftEffect do
53+
seed <- LCG.randomSeed
54+
let summary = QC.checkResults (QC.quickCheckPure' seed 100 prop)
55+
case List.head summary.failures of
56+
Nothing -> pure unit
57+
Just err -> throw $ "Property failed (seed " <> show (unSeed err.seed) <> ") failed: \n" <> err.message
58+
59+
failure :: String -> Test
60+
failure = liftEffect <<< throw
2961

3062
main :: Effect Unit
31-
main = runTest do
63+
main = flip runReaderT 0 do
3264
suite "Either Check" eitherCheck
3365
suite "Encode/Decode NonEmpty Check" nonEmptyCheck
3466
suite "Encode/Decode Checks" encodeDecodeCheck
@@ -46,7 +78,7 @@ genTestRecord
4678
))
4779
genTestRecord = arbitrary
4880

49-
encodeDecodeRecordCheck :: TestSuite
81+
encodeDecodeRecordCheck :: Test
5082
encodeDecodeRecordCheck = do
5183
test "Testing that any record can be encoded and then decoded" do
5284
quickCheck rec_encode_then_decode
@@ -62,7 +94,7 @@ encodeDecodeRecordCheck = do
6294
genTestJson :: Gen Json
6395
genTestJson = resize 5 genJson
6496

65-
encodeDecodeCheck :: TestSuite
97+
encodeDecodeCheck :: Test
6698
encodeDecodeCheck = do
6799
test "Testing that any JSON can be encoded and then decoded" do
68100
quickCheck prop_encode_then_decode
@@ -88,7 +120,7 @@ encodeDecodeCheck = do
88120
genObj :: Gen Json
89121
genObj = suchThat (resize 5 genJson) isObject
90122

91-
combinatorsCheck :: TestSuite
123+
combinatorsCheck :: Test
92124
combinatorsCheck = do
93125
test "Check assoc builder `:=`" do
94126
quickCheck prop_assoc_builder_str
@@ -150,7 +182,7 @@ combinatorsCheck = do
150182
let keys = FO.keys object
151183
in foldl (\ok key -> ok && isJust (FO.lookup key object)) true keys
152184

153-
eitherCheck :: TestSuite
185+
eitherCheck :: Test
154186
eitherCheck = do
155187
test "Test EncodeJson/DecodeJson Either test" do
156188
quickCheck \(x :: Either String String) ->
@@ -161,83 +193,83 @@ eitherCheck = do
161193
Left err ->
162194
false <?> err
163195

164-
manualRecordDecode :: TestSuite
196+
manualRecordDecode :: Test
165197
manualRecordDecode = do
166-
test "Test that decoding custom record is successful" do
198+
test "Test that decoding custom record is pure unitful" do
167199
case decodeJson =<< jsonParser fooJson of
168-
Right (Foo _) -> success
200+
Right (Foo _) -> pure unit
169201
Left err -> failure err
170202
suite "Test decoding empty record" testEmptyCases
171203
suite "Test decoding missing 'bar' key" testBarCases
172204
suite "Test decoding missing 'baz' key" testBazCases
173205
suite "Test decoding with all fields present" testFullCases
174206
where
175-
testEmptyCases :: TestSuite
207+
testEmptyCases :: Test
176208
testEmptyCases = do
177209
test "Empty Json should decode to FooNested" do
178210
case decodeJson =<< jsonParser fooNestedEmptyJson of
179-
Right (FooNested { bar: Nothing, baz: false }) -> success
211+
Right (FooNested { bar: Nothing, baz: false }) -> pure unit
180212
_ -> failure ("Failed to properly decode JSON string: " <> fooNestedEmptyJson)
181213
test "Json with null values should fail to decode to FooNested" do
182214
case decodeJson =<< jsonParser fooNestedEmptyJsonNull of
183215
Right (FooNested _) -> failure ("Should have failed to decode JSON string: " <> fooNestedEmptyJsonNull)
184-
_ -> success
216+
_ -> pure unit
185217
test "Empty Json should decode to FooNested'" do
186218
case decodeJson =<< jsonParser fooNestedEmptyJson of
187-
Right (FooNested' { bar: Nothing, baz: false }) -> success
219+
Right (FooNested' { bar: Nothing, baz: false }) -> pure unit
188220
_ -> failure ("Failed to properly decode JSON string: " <> fooNestedEmptyJson)
189221
test "Json with null values should decode to FooNested'" do
190222
case decodeJson =<< jsonParser fooNestedEmptyJsonNull of
191-
Right (FooNested' { bar: Nothing, baz: false }) -> success
223+
Right (FooNested' { bar: Nothing, baz: false }) -> pure unit
192224
_ -> failure ("Failed to properly decode JSON string: " <> fooNestedEmptyJsonNull)
193225

194-
testBarCases :: TestSuite
226+
testBarCases :: Test
195227
testBarCases = do
196228
test "Missing 'bar' key should decode to FooNested" do
197229
case decodeJson =<< jsonParser fooNestedBazJson of
198-
Right (FooNested { bar: Nothing, baz: true }) -> success
230+
Right (FooNested { bar: Nothing, baz: true }) -> pure unit
199231
_ -> failure ("Failed to properly decode JSON string: " <> fooNestedBazJson)
200232
test "Null 'bar' key should fail to decode to FooNested" do
201233
case decodeJson =<< jsonParser fooNestedBazJsonNull of
202234
Right (FooNested _) -> failure ("Should have failed to decode JSON string: " <> fooNestedBazJsonNull)
203-
_ -> success
235+
_ -> pure unit
204236
test "Missing 'bar' key should decode to FooNested'" do
205237
case decodeJson =<< jsonParser fooNestedBazJson of
206-
Right (FooNested' { bar: Nothing, baz: true }) -> success
238+
Right (FooNested' { bar: Nothing, baz: true }) -> pure unit
207239
_ -> failure ("Failed to properly decode JSON string: " <> fooNestedBazJson)
208240
test "Null 'bar' key should decode to FooNested'" do
209241
case decodeJson =<< jsonParser fooNestedBazJsonNull of
210-
Right (FooNested' { bar: Nothing, baz: true }) -> success
242+
Right (FooNested' { bar: Nothing, baz: true }) -> pure unit
211243
_ -> failure ("Failed to properly decode JSON string: " <> fooNestedBazJsonNull)
212244

213-
testBazCases :: TestSuite
245+
testBazCases :: Test
214246
testBazCases = do
215247
test "Missing 'baz' key should decode to FooNested" do
216248
case decodeJson =<< jsonParser fooNestedBarJson of
217-
Right (FooNested { bar: Just [1], baz: false }) -> success
249+
Right (FooNested { bar: Just [1], baz: false }) -> pure unit
218250
_ -> failure ("Failed to properly decode JSON string: " <> fooNestedBarJson)
219251
test "Null 'baz' key should fail to decode to FooNested" do
220252
case decodeJson =<< jsonParser fooNestedBarJsonNull of
221253
Right (FooNested _) -> failure ("Should have failed to decode JSON string: " <> fooNestedBarJsonNull)
222-
_ -> success
254+
_ -> pure unit
223255
test "Missing 'baz' key should decode to FooNested'" do
224256
case decodeJson =<< jsonParser fooNestedBarJson of
225-
Right (FooNested' { bar: Just [1], baz: false }) -> success
257+
Right (FooNested' { bar: Just [1], baz: false }) -> pure unit
226258
_ -> failure ("Failed to properly decode JSON string: " <> fooNestedBarJson)
227259
test "Null 'baz' key should decode to FooNested'" do
228260
case decodeJson =<< jsonParser fooNestedBarJsonNull of
229-
Right (FooNested' { bar: Just [1], baz: false }) -> success
261+
Right (FooNested' { bar: Just [1], baz: false }) -> pure unit
230262
_ -> failure ("Failed to properly decode JSON string: " <> fooNestedBarJsonNull)
231263

232-
testFullCases :: TestSuite
264+
testFullCases :: Test
233265
testFullCases = do
234266
test "Json should decode to FooNested" do
235267
case decodeJson =<< jsonParser fooNestedFullJson of
236-
Right (FooNested { bar: Just [1], baz: true }) -> success
268+
Right (FooNested { bar: Just [1], baz: true }) -> pure unit
237269
_ -> failure ("Failed to properly decode JSON string: " <> fooNestedFullJson)
238270
test "Json should decode to FooNested'" do
239271
case decodeJson =<< jsonParser fooNestedFullJson of
240-
Right (FooNested { bar: Just [1], baz: true }) -> success
272+
Right (FooNested { bar: Just [1], baz: true }) -> pure unit
241273
_ -> failure ("Failed to properly decode JSON string: " <> fooNestedFullJson)
242274

243275
fooJson :: String
@@ -264,7 +296,7 @@ manualRecordDecode = do
264296
fooNestedFullJson :: String
265297
fooNestedFullJson = """{ "bar": [1], "baz": true }"""
266298

267-
nonEmptyCheck :: TestSuite
299+
nonEmptyCheck :: Test
268300
nonEmptyCheck = do
269301
test "Test EncodeJson/DecodeJson on NonEmpty Array" do
270302
quickCheck \(x :: NonEmpty Array String) ->
@@ -283,15 +315,15 @@ nonEmptyCheck = do
283315
Left err ->
284316
false <?> err
285317

286-
errorMsgCheck :: TestSuite
318+
errorMsgCheck :: Test
287319
errorMsgCheck = do
288320
test "Test that decoding array fails with the proper message" do
289321
case notBar of
290-
Left err -> Assert.equal barErr err
322+
Left err -> assertEqual { expected: barErr, actual: err }
291323
_ -> failure "Should have failed to decode"
292324
test "Test that decoding record fails with the proper message" do
293325
case notBaz of
294-
Left err -> Assert.equal bazErr err
326+
Left err -> assertEqual { expected: bazErr, actual: err }
295327
_ -> failure "Should have failed to decode"
296328
where
297329
barErr :: String

0 commit comments

Comments
 (0)