use quickcheck instead of strongcheck for tests

Author: kritzcreek

bower.json

@@ -25,9 +25,10 @@
     "purescript-argonaut-core": "^4.0.0",
     "purescript-integers": "^4.0.0",
     "purescript-maybe": "^4.0.0",
+    "purescript-ordered-collections": "^1.0.0",
     "purescript-foreign-object": "^1.0.0"
   },
   "devDependencies": {
-    "purescript-strongcheck": "#compiler/0.12"
+    "purescript-quickcheck": "^5.0.0"
   }
-}
+}

test/Test/Main.purs

@@ -2,106 +2,114 @@ module Test.Main where
 
 import Prelude
 
-import Data.Argonaut.Core (Json, isObject, toObject)
+import Control.Monad.Gen.Common (genMaybe)
+import Data.Argonaut.Core (Json, isObject, stringify, toObject)
 import Data.Argonaut.Decode (decodeJson)
-import Data.Argonaut.Encode (class EncodeJson, encodeJson, (:=), (:=?), (~>), (~>?))
+import Data.Argonaut.Encode (encodeJson, (:=), (:=?), (~>), (~>?))
 import Data.Argonaut.Gen (genJson)
+import Data.Bifunctor (rmap)
 import Data.Either (Either(..))
 import Data.Foldable (foldl)
 import Data.Maybe (Maybe(..), isJust, isNothing, maybe)
+import Data.String.Gen (genUnicodeString)
 import Data.Tuple (Tuple(..))
 import Effect (Effect)
 import Effect.Console (log)
 import Foreign.Object as FO
-import Test.StrongCheck (quickCheck, quickCheck', (<?>))
-import Test.StrongCheck.Arbitrary (class Arbitrary)
-import Test.StrongCheck.Gen (suchThat, resize)
+import Test.QuickCheck (Result(..), quickCheck, (<?>), (===))
+import Test.QuickCheck.Gen (Gen, resize, suchThat)
 
 main :: Effect Unit
 main = do
   eitherCheck
   encodeDecodeCheck
   combinatorsCheck
 
-newtype TestJson = TestJson Json
-
-instance encodeJsonTestJson :: EncodeJson TestJson where
-  encodeJson (TestJson x) = encodeJson x
-
-instance arbitraryTestJson :: Arbitrary TestJson where
-  arbitrary = TestJson <$> (resize 5 genJson)
+genTestJson :: Gen Json
+genTestJson = resize 5 genJson
 
 encodeDecodeCheck :: Effect Unit
 encodeDecodeCheck = do
   log "Testing that any JSON can be encoded and then decoded"
-  quickCheck' 20 prop_encode_then_decode
+  quickCheck prop_encode_then_decode
 
   log "Testing that any JSON can be decoded and then encoded"
-  quickCheck' 20 (prop_decode_then_encode)
+  quickCheck prop_decode_then_encode
 
   where
 
-  prop_encode_then_decode :: TestJson -> Boolean
-  prop_encode_then_decode (TestJson json) =
-    Right json == decodeJson (encodeJson json)
-
-  prop_decode_then_encode :: TestJson -> Boolean
-  prop_decode_then_encode (TestJson json) =
-    let decoded = (decodeJson json) :: Either String Json in
-    Right json == (decoded >>= (encodeJson >>> pure))
+  prop_encode_then_decode :: Gen Result
+  prop_encode_then_decode = do
+    json <- genTestJson
+    let redecoded = decodeJson (encodeJson json)
+    pure $ Right json == redecoded <?> (show (rmap stringify redecoded) <> " /= Right " <> stringify json)
 
-newtype Obj = Obj Json
-unObj :: Obj -> Json
-unObj (Obj j) = j
+  prop_decode_then_encode :: Gen Result
+  prop_decode_then_encode = do
+    json <- genTestJson
+    let (decoded :: Either String Json) = decodeJson json
+    let reencoded = decoded >>= (encodeJson >>> pure)
+    pure $ Right json == reencoded <?> (show (rmap stringify reencoded) <> " /= Right " <> stringify json)
 
-instance arbitraryObj :: Arbitrary Obj where
-  arbitrary = Obj <$> suchThat (resize 5 genJson) isObject
+genObj :: Gen Json
+genObj = suchThat (resize 5 genJson) isObject
 
 combinatorsCheck :: Effect Unit
 combinatorsCheck = do
   log "Check assoc builder `:=`"
-  quickCheck' 20 prop_assoc_builder_str
+  quickCheck prop_assoc_builder_str
   log "Check assocOptional builder `:=?`"
-  quickCheck' 20 prop_assoc_optional_builder_str
+  quickCheck prop_assoc_optional_builder_str
   log "Check JAssoc append `~>`"
-  quickCheck' 20 prop_assoc_append
+  quickCheck prop_assoc_append
   log "Check JAssoc appendOptional `~>?`"
-  quickCheck' 20 prop_assoc_append_optional
+  quickCheck prop_assoc_append_optional
   log "Check get field `obj .? 'foo'`"
-  quickCheck' 20 prop_get_jobject_field
+  quickCheck prop_get_jobject_field
 
   where
 
-  prop_assoc_builder_str :: Tuple String String -> Boolean
-  prop_assoc_builder_str (Tuple key str) =
+  prop_assoc_builder_str :: Gen Result
+  prop_assoc_builder_str = do
+    key <- genUnicodeString
+    str <- genUnicodeString
     case (key := str) of
       Tuple k json ->
-        (key == k) && (decodeJson json == Right str)
+        pure $ Tuple key (decodeJson json) === Tuple k (Right str)
 
-  prop_assoc_optional_builder_str :: Tuple String (Maybe String) -> Boolean
-  prop_assoc_optional_builder_str (Tuple key maybeStr) =
+  prop_assoc_optional_builder_str :: Gen Result
+  prop_assoc_optional_builder_str = do
+    key <- genUnicodeString
+    maybeStr <- genMaybe genUnicodeString
     case (key :=? maybeStr) of
       Just (Tuple k json) ->
-        (key == k) && (decodeJson json == Right maybeStr)
-      Nothing -> true
-
-  prop_assoc_append :: (Tuple (Tuple String TestJson) Obj) -> Boolean
-  prop_assoc_append (Tuple (Tuple key (TestJson val)) (Obj obj)) =
+        pure $ Tuple key (decodeJson json) === Tuple k (Right maybeStr)
+      Nothing -> pure Success
+
+  prop_assoc_append :: Gen Result
+  prop_assoc_append = do
+    key <- genUnicodeString
+    val <- genTestJson
+    obj <- genObj
     let appended = (key := val) ~> obj
-    in case toObject appended >>= FO.lookup key of
-      Just value -> true
-      _ -> false
-
-  prop_assoc_append_optional :: Tuple (Tuple String (Maybe TestJson)) Obj -> Boolean
-  prop_assoc_append_optional (Tuple (Tuple key maybeVal) (Obj obj)) =
+    case toObject appended >>= FO.lookup key of
+      Just value -> pure Success
+      _ -> pure (Failed "failed to lookup key")
+
+  prop_assoc_append_optional :: Gen Result
+  prop_assoc_append_optional = do
+    key <- genUnicodeString
+    maybeVal <- genMaybe genTestJson
+    obj <- genObj
     let appended = (key :=? maybeVal) ~>? obj
-    in case toObject appended >>= FO.lookup key of
-      Just value -> isJust maybeVal
-      _ -> isNothing maybeVal
-
-  prop_get_jobject_field :: Obj -> Boolean
-  prop_get_jobject_field (Obj obj) =
-    maybe false go $ toObject obj
+    pure case toObject appended >>= FO.lookup key of
+      Just value -> isJust maybeVal === true
+      _ -> isNothing maybeVal === true
+
+  prop_get_jobject_field :: Gen Result
+  prop_get_jobject_field = do
+    obj <- genObj
+    pure (true === maybe false go (toObject obj))
     where
     go :: FO.Object Json -> Boolean
     go object =