Skip to content

Commit

Permalink
Update dependencies, remove dependency on test-unit
Browse files Browse the repository at this point in the history
  • Loading branch information
@garyb
garyb committed Mar 5, 2019
1 parent 3be823e commit da3a9fd
Show file tree
Hide file tree
Showing 2 changed files with 72 additions and 39 deletions.
9 changes: 5 additions & 4 deletions bower.json
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,16 +22,17 @@
},
"license": "MIT",
"dependencies": {
"purescript-argonaut-core": "^4.0.0",
"purescript-argonaut-core": "^5.0.0",
"purescript-integers": "^4.0.0",
"purescript-maybe": "^4.0.0",
"purescript-ordered-collections": "^1.0.0",
"purescript-foreign-object": "^1.0.0",
"purescript-record": "^1.0.0",
"purescript-foreign-object": "^2.0.0",
"purescript-record": "^2.0.0",
"purescript-nonempty": "^5.0.0",
"purescript-arrays": "^5.1.0"
},
"devDependencies": {
"purescript-test-unit": "^14.0.0"
"purescript-assert": "^4.1.0",
"purescript-quickcheck": "^6.1.0"
}
}
102 changes: 67 additions & 35 deletions test/Test/Main.purs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@ module Test.Main where
import Prelude

import Control.Monad.Gen.Common (genMaybe)
import Control.Monad.Reader (ReaderT, ask, local, runReaderT)
import Data.Argonaut.Core (Json, isObject, stringify, toObject)
import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.:), (.:!), (.:?), (.!=))
import Data.Argonaut.Encode (encodeJson, (:=), (:=?), (~>), (~>?))
Expand All @@ -12,23 +13,54 @@ import Data.Bifunctor (rmap)
import Data.Either (Either(..))
import Data.Foldable (foldl)
import Data.List (List)
import Data.List as List
import Data.Maybe (Maybe(..), isJust, isNothing, maybe)
import Data.Monoid (power)
import Data.NonEmpty (NonEmpty)
import Data.String.Gen (genUnicodeString)
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Effect.Class (liftEffect)
import Effect.Class.Console (log)
import Effect.Exception (throw)
import Foreign.Object as FO
import Test.QuickCheck (Result(..), (<?>), (===))
import Test.Assert as Assert
import Test.QuickCheck (Result(..), unSeed, (<?>), (===))
import Test.QuickCheck as LCG
import Test.QuickCheck as QC
import Test.QuickCheck.Arbitrary (arbitrary)
import Test.QuickCheck.Gen (Gen, resize, suchThat)
import Test.Unit (TestSuite, failure, success, suite, test)
import Test.Unit.Assert as Assert
import Test.Unit.Main (runTest)
import Test.Unit.QuickCheck (quickCheck)

type Test = ReaderT Int Effect Unit

suite :: String -> Test -> Test
suite = test

test :: String -> Test -> Test
test name run = do
indent <- ask
log (mkIndent indent <> name)
local (_ + 2) run

mkIndent :: Int -> String
mkIndent = power " "

assertEqual :: forall a. Eq a => Show a => { actual :: a, expected :: a } -> Test
assertEqual = liftEffect <<< Assert.assertEqual

quickCheck :: forall prop. QC.Testable prop => prop -> Test
quickCheck prop = liftEffect do
seed <- LCG.randomSeed
let summary = QC.checkResults (QC.quickCheckPure' seed 100 prop)
case List.head summary.failures of
Nothing -> pure unit
Just err -> throw $ "Property failed (seed " <> show (unSeed err.seed) <> ") failed: \n" <> err.message

failure :: String -> Test
failure = liftEffect <<< throw

main :: Effect Unit
main = runTest do
main = flip runReaderT 0 do
suite "Either Check" eitherCheck
suite "Encode/Decode NonEmpty Check" nonEmptyCheck
suite "Encode/Decode Checks" encodeDecodeCheck
Expand All @@ -46,7 +78,7 @@ genTestRecord
))
genTestRecord = arbitrary

encodeDecodeRecordCheck :: TestSuite
encodeDecodeRecordCheck :: Test
encodeDecodeRecordCheck = do
test "Testing that any record can be encoded and then decoded" do
quickCheck rec_encode_then_decode
Expand All @@ -62,7 +94,7 @@ encodeDecodeRecordCheck = do
genTestJson :: Gen Json
genTestJson = resize 5 genJson

encodeDecodeCheck :: TestSuite
encodeDecodeCheck :: Test
encodeDecodeCheck = do
test "Testing that any JSON can be encoded and then decoded" do
quickCheck prop_encode_then_decode
Expand All @@ -88,7 +120,7 @@ encodeDecodeCheck = do
genObj :: Gen Json
genObj = suchThat (resize 5 genJson) isObject

combinatorsCheck :: TestSuite
combinatorsCheck :: Test
combinatorsCheck = do
test "Check assoc builder `:=`" do
quickCheck prop_assoc_builder_str
Expand Down Expand Up @@ -150,7 +182,7 @@ combinatorsCheck = do
let keys = FO.keys object
in foldl (\ok key -> ok && isJust (FO.lookup key object)) true keys

eitherCheck :: TestSuite
eitherCheck :: Test
eitherCheck = do
test "Test EncodeJson/DecodeJson Either test" do
quickCheck \(x :: Either String String) ->
Expand All @@ -161,83 +193,83 @@ eitherCheck = do
Left err ->
false <?> err

manualRecordDecode :: TestSuite
manualRecordDecode :: Test
manualRecordDecode = do
test "Test that decoding custom record is successful" do
test "Test that decoding custom record is pure unitful" do
case decodeJson =<< jsonParser fooJson of
Right (Foo _) -> success
Right (Foo _) -> pure unit
Left err -> failure err
suite "Test decoding empty record" testEmptyCases
suite "Test decoding missing 'bar' key" testBarCases
suite "Test decoding missing 'baz' key" testBazCases
suite "Test decoding with all fields present" testFullCases
where
testEmptyCases :: TestSuite
testEmptyCases :: Test
testEmptyCases = do
test "Empty Json should decode to FooNested" do
case decodeJson =<< jsonParser fooNestedEmptyJson of
Right (FooNested { bar: Nothing, baz: false }) -> success
Right (FooNested { bar: Nothing, baz: false }) -> pure unit
_ -> failure ("Failed to properly decode JSON string: " <> fooNestedEmptyJson)
test "Json with null values should fail to decode to FooNested" do
case decodeJson =<< jsonParser fooNestedEmptyJsonNull of
Right (FooNested _) -> failure ("Should have failed to decode JSON string: " <> fooNestedEmptyJsonNull)
_ -> success
_ -> pure unit
test "Empty Json should decode to FooNested'" do
case decodeJson =<< jsonParser fooNestedEmptyJson of
Right (FooNested' { bar: Nothing, baz: false }) -> success
Right (FooNested' { bar: Nothing, baz: false }) -> pure unit
_ -> failure ("Failed to properly decode JSON string: " <> fooNestedEmptyJson)
test "Json with null values should decode to FooNested'" do
case decodeJson =<< jsonParser fooNestedEmptyJsonNull of
Right (FooNested' { bar: Nothing, baz: false }) -> success
Right (FooNested' { bar: Nothing, baz: false }) -> pure unit
_ -> failure ("Failed to properly decode JSON string: " <> fooNestedEmptyJsonNull)

testBarCases :: TestSuite
testBarCases :: Test
testBarCases = do
test "Missing 'bar' key should decode to FooNested" do
case decodeJson =<< jsonParser fooNestedBazJson of
Right (FooNested { bar: Nothing, baz: true }) -> success
Right (FooNested { bar: Nothing, baz: true }) -> pure unit
_ -> failure ("Failed to properly decode JSON string: " <> fooNestedBazJson)
test "Null 'bar' key should fail to decode to FooNested" do
case decodeJson =<< jsonParser fooNestedBazJsonNull of
Right (FooNested _) -> failure ("Should have failed to decode JSON string: " <> fooNestedBazJsonNull)
_ -> success
_ -> pure unit
test "Missing 'bar' key should decode to FooNested'" do
case decodeJson =<< jsonParser fooNestedBazJson of
Right (FooNested' { bar: Nothing, baz: true }) -> success
Right (FooNested' { bar: Nothing, baz: true }) -> pure unit
_ -> failure ("Failed to properly decode JSON string: " <> fooNestedBazJson)
test "Null 'bar' key should decode to FooNested'" do
case decodeJson =<< jsonParser fooNestedBazJsonNull of
Right (FooNested' { bar: Nothing, baz: true }) -> success
Right (FooNested' { bar: Nothing, baz: true }) -> pure unit
_ -> failure ("Failed to properly decode JSON string: " <> fooNestedBazJsonNull)

testBazCases :: TestSuite
testBazCases :: Test
testBazCases = do
test "Missing 'baz' key should decode to FooNested" do
case decodeJson =<< jsonParser fooNestedBarJson of
Right (FooNested { bar: Just [1], baz: false }) -> success
Right (FooNested { bar: Just [1], baz: false }) -> pure unit
_ -> failure ("Failed to properly decode JSON string: " <> fooNestedBarJson)
test "Null 'baz' key should fail to decode to FooNested" do
case decodeJson =<< jsonParser fooNestedBarJsonNull of
Right (FooNested _) -> failure ("Should have failed to decode JSON string: " <> fooNestedBarJsonNull)
_ -> success
_ -> pure unit
test "Missing 'baz' key should decode to FooNested'" do
case decodeJson =<< jsonParser fooNestedBarJson of
Right (FooNested' { bar: Just [1], baz: false }) -> success
Right (FooNested' { bar: Just [1], baz: false }) -> pure unit
_ -> failure ("Failed to properly decode JSON string: " <> fooNestedBarJson)
test "Null 'baz' key should decode to FooNested'" do
case decodeJson =<< jsonParser fooNestedBarJsonNull of
Right (FooNested' { bar: Just [1], baz: false }) -> success
Right (FooNested' { bar: Just [1], baz: false }) -> pure unit
_ -> failure ("Failed to properly decode JSON string: " <> fooNestedBarJsonNull)

testFullCases :: TestSuite
testFullCases :: Test
testFullCases = do
test "Json should decode to FooNested" do
case decodeJson =<< jsonParser fooNestedFullJson of
Right (FooNested { bar: Just [1], baz: true }) -> success
Right (FooNested { bar: Just [1], baz: true }) -> pure unit
_ -> failure ("Failed to properly decode JSON string: " <> fooNestedFullJson)
test "Json should decode to FooNested'" do
case decodeJson =<< jsonParser fooNestedFullJson of
Right (FooNested { bar: Just [1], baz: true }) -> success
Right (FooNested { bar: Just [1], baz: true }) -> pure unit
_ -> failure ("Failed to properly decode JSON string: " <> fooNestedFullJson)

fooJson :: String
Expand All @@ -264,7 +296,7 @@ manualRecordDecode = do
fooNestedFullJson :: String
fooNestedFullJson = """{ "bar": [1], "baz": true }"""

nonEmptyCheck :: TestSuite
nonEmptyCheck :: Test
nonEmptyCheck = do
test "Test EncodeJson/DecodeJson on NonEmpty Array" do
quickCheck \(x :: NonEmpty Array String) ->
Expand All @@ -283,15 +315,15 @@ nonEmptyCheck = do
Left err ->
false <?> err

errorMsgCheck :: TestSuite
errorMsgCheck :: Test
errorMsgCheck = do
test "Test that decoding array fails with the proper message" do
case notBar of
Left err -> Assert.equal barErr err
Left err -> assertEqual { expected: barErr, actual: err }
_ -> failure "Should have failed to decode"
test "Test that decoding record fails with the proper message" do
case notBaz of
Left err -> Assert.equal bazErr err
Left err -> assertEqual { expected: bazErr, actual: err }
_ -> failure "Should have failed to decode"
where
barErr :: String
Expand Down

0 comments on commit da3a9fd

Please sign in to comment.