diff --git a/.travis.yml b/.travis.yml index 15bacc0..2e30c22 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,7 +1,7 @@ language: node_js dist: trusty sudo: required -node_js: 6 +node_js: stable install: - npm install -g bower - npm install diff --git a/bower.json b/bower.json index cf47f00..3fb2c5a 100644 --- a/bower.json +++ b/bower.json @@ -22,11 +22,11 @@ }, "license": "MIT", "dependencies": { - "purescript-argonaut-core": "^2.0.0", - "purescript-generics": "^3.0.0", - "purescript-integers": "^2.0.0" + "purescript-argonaut-core": "^3.0.0", + "purescript-generics": "^4.0.0", + "purescript-integers": "^3.0.0" }, "devDependencies": { - "purescript-strongcheck": "^2.0.0" + "purescript-strongcheck": "^3.1.0" } } diff --git a/package.json b/package.json index b2282a8..90bef43 100644 --- a/package.json +++ b/package.json @@ -6,9 +6,9 @@ "test": "pulp test" }, "devDependencies": { - "pulp": "^10.0.0", - "purescript-psa": "^0.4.0", - "purescript": "^0.10.7", - "rimraf": "^2.5.4" + "pulp": "^11.0.0", + "purescript-psa": "^0.5.0", + "purescript": "^0.11.1", + "rimraf": "^2.6.1" } } diff --git a/src/Data/Argonaut/Decode.purs b/src/Data/Argonaut/Decode.purs index 64b87ed..2eaa1df 100644 --- a/src/Data/Argonaut/Decode.purs +++ b/src/Data/Argonaut/Decode.purs @@ -3,5 +3,5 @@ module Data.Argonaut.Decode , module Data.Argonaut.Decode.Combinators ) where -import Data.Argonaut.Decode.Class (class DecodeJson, decodeJson, gDecodeJson, gDecodeJson') +import Data.Argonaut.Decode.Class (class DecodeJson, decodeJson) import Data.Argonaut.Decode.Combinators (getField, (.?)) diff --git a/src/Data/Argonaut/Decode/Class.purs b/src/Data/Argonaut/Decode/Class.purs index d44ce19..67f93b6 100644 --- a/src/Data/Argonaut/Decode/Class.purs +++ b/src/Data/Argonaut/Decode/Class.purs @@ -1,72 +1,25 @@ module Data.Argonaut.Decode.Class ( class DecodeJson , decodeJson - , gDecodeJson - , gDecodeJson' ) where import Prelude -import Data.Argonaut.Core (Json, JArray, JObject, isNull, foldJsonNull, foldJsonBoolean, foldJsonNumber, foldJsonString, toArray, toNumber, toObject, toString, toBoolean) -import Data.Array (zipWithA) +import Data.Argonaut.Core (Json, JArray, JObject, isNull, foldJsonNull, foldJsonBoolean, foldJsonNumber, foldJsonString, toArray, toObject, toString) import Data.Bifunctor (lmap) import Data.Either (Either(..)) -import Data.Foldable (find) -import Data.Generic (class Generic, GenericSpine(..), GenericSignature(..), fromSpine, toSignature) import Data.Int (fromNumber) import Data.List (List(..), (:), fromFoldable) import Data.Map as M import Data.Maybe (maybe, Maybe(..)) -import Data.String (charAt, toChar) +import Data.String (charAt) import Data.StrMap as SM -import Data.Traversable (traverse, for) +import Data.Traversable (traverse) import Data.Tuple (Tuple(..)) -import Type.Proxy (Proxy(..)) - class DecodeJson a where decodeJson :: Json -> Either String a --- | Decode `Json` representation of a value which has a `Generic` type. -gDecodeJson :: forall a. Generic a => Json -> Either String a -gDecodeJson - = maybe (Left "fromSpine failed") Right - <<< fromSpine - <=< gDecodeJson' (toSignature (Proxy :: Proxy a)) - --- | Decode `Json` representation of a `GenericSpine`. -gDecodeJson' :: GenericSignature -> Json -> Either String GenericSpine -gDecodeJson' signature json = case signature of - SigNumber -> SNumber <$> mFail "Expected a number" (toNumber json) - SigInt -> SInt <$> mFail "Expected an integer number" (fromNumber =<< toNumber json) - SigString -> SString <$> mFail "Expected a string" (toString json) - SigChar -> SChar <$> mFail "Expected a char" (toChar =<< toString json) - SigBoolean -> SBoolean <$> mFail "Expected a boolean" (toBoolean json) - SigUnit -> pure SUnit - SigArray thunk -> do - jArr <- mFail "Expected an array" $ toArray json - SArray <$> traverse (map const <<< gDecodeJson' (thunk unit)) jArr - SigRecord props -> do - jObj <- mFail "Expected an object" $ toObject json - SRecord <$> for props \({recLabel: lbl, recValue: val}) -> do - pf <- mFail ("'" <> lbl <> "' property missing") (SM.lookup lbl jObj) - sp <- gDecodeJson' (val unit) pf - pure { recLabel: lbl, recValue: const sp } - SigProd typeConstr alts -> do - let decodingErr msg = "When decoding a " <> typeConstr <> ": " <> msg - jObj <- mFail (decodingErr "expected an object") (toObject json) - tagJson <- mFail (decodingErr "'tag' property is missing") (SM.lookup "tag" jObj) - tag <- mFail (decodingErr "'tag' property is not a string") (toString tagJson) - case find ((tag == _) <<< _.sigConstructor) alts of - Nothing -> Left (decodingErr ("'" <> tag <> "' isn't a valid constructor")) - Just { sigValues: sigValues } -> do - vals <- mFail (decodingErr "'values' array is missing") (toArray =<< SM.lookup "values" jObj) - sps <- zipWithA (\k -> gDecodeJson' (k unit)) sigValues vals - pure (SProd tag (const <$> sps)) - where - mFail :: forall a. String -> Maybe a -> Either String a - mFail msg = maybe (Left msg) Right - instance decodeJsonMaybe :: DecodeJson a => DecodeJson (Maybe a) where decodeJson j = case decode j of diff --git a/src/Data/Argonaut/Encode.purs b/src/Data/Argonaut/Encode.purs index cd3ff73..d04cc05 100644 --- a/src/Data/Argonaut/Encode.purs +++ b/src/Data/Argonaut/Encode.purs @@ -3,5 +3,5 @@ module Data.Argonaut.Encode , module Data.Argonaut.Encode.Combinators ) where -import Data.Argonaut.Encode.Class (class EncodeJson, encodeJson, gEncodeJson, gEncodeJson') +import Data.Argonaut.Encode.Class (class EncodeJson, encodeJson) import Data.Argonaut.Encode.Combinators (assoc, extend, (:=), (~>)) diff --git a/src/Data/Argonaut/Encode/Class.purs b/src/Data/Argonaut/Encode/Class.purs index c58f5f7..fa8d88c 100644 --- a/src/Data/Argonaut/Encode/Class.purs +++ b/src/Data/Argonaut/Encode/Class.purs @@ -4,8 +4,6 @@ import Prelude import Data.Argonaut.Core (Json(), jsonNull, fromBoolean, fromNumber, fromString, fromArray, fromObject, jsonEmptyObject, jsonSingletonObject) import Data.Either (Either(), either) -import Data.Foldable (foldr) -import Data.Generic (class Generic, GenericSpine(..), toSpine) import Data.Int (toNumber) import Data.List (List(..), (:), toUnfoldable) import Data.Map as M @@ -17,30 +15,6 @@ import Data.Tuple (Tuple(..)) class EncodeJson a where encodeJson :: a -> Json --- | Encode any `Generic` data structure into `Json`. -gEncodeJson :: forall a. Generic a => a -> Json -gEncodeJson = gEncodeJson' <<< toSpine - --- | Encode `GenericSpine` into `Json`. -gEncodeJson' :: GenericSpine -> Json -gEncodeJson' = case _ of - SInt x -> fromNumber $ toNumber x - SString x -> fromString x - SChar x -> fromString $ singleton x - SNumber x -> fromNumber x - SBoolean x -> fromBoolean x - SArray thunks -> fromArray (gEncodeJson' <<< (unit # _) <$> thunks) - SUnit -> jsonNull - SProd constr args -> - fromObject - $ SM.insert "tag" (encodeJson constr) - $ SM.singleton "values" (encodeJson (gEncodeJson' <<< (unit # _) <$> args)) - SRecord fields -> - fromObject $ foldr addField SM.empty fields - where - addField field = - SM.insert field.recLabel (gEncodeJson' $ field.recValue unit) - instance encodeJsonMaybe :: EncodeJson a => EncodeJson (Maybe a) where encodeJson Nothing = jsonEmptyObject encodeJson (Just a) = jsonSingletonObject "just" (encodeJson a) @@ -87,7 +61,7 @@ instance encodeStrMap :: EncodeJson a => EncodeJson (SM.StrMap a) where encodeJson = fromObject <<< map encodeJson instance encodeMap :: (Ord a, EncodeJson a, EncodeJson b) => EncodeJson (M.Map a b) where - encodeJson = encodeJson <<< M.toList + encodeJson = encodeJson <<< (M.toUnfoldable :: M.Map a b -> List (Tuple a b)) instance encodeVoid :: EncodeJson Void where encodeJson = absurd diff --git a/test/Test/Main.purs b/test/Test/Main.purs index e4fc7c0..dbfc995 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -2,85 +2,40 @@ module Test.Main where import Prelude -import Control.Monad.Eff.Console (log, logShow) +import Control.Monad.Eff.Console (log) -import Data.Argonaut.Core (JObject, Json, toObject, fromObject, fromArray, fromString, fromNumber, fromBoolean, jsonNull) +import Data.Argonaut.Core (JObject, Json, isObject, toObject) import Data.Argonaut.Decode (decodeJson) -import Data.Argonaut.Encode (encodeJson, gEncodeJson, (:=), (~>)) -import Data.Array (zipWith, nubBy, length) +import Data.Argonaut.Encode (encodeJson, (:=), (~>)) +import Data.Argonaut.Gen (genJson) import Data.Either (Either(..)) import Data.Foldable (foldl) -import Data.Function (on) -import Data.Generic (class Generic) -import Data.List (fromFoldable) import Data.Maybe (Maybe(..), maybe, isJust) import Data.StrMap as SM -import Data.Tuple (Tuple(..), fst) +import Data.Tuple (Tuple(..)) import Test.StrongCheck (SC, quickCheck, quickCheck', ()) -import Test.StrongCheck.Arbitrary (class Arbitrary, arbitrary) -import Test.StrongCheck.Data.AlphaNumString (AlphaNumString(..)) -import Test.StrongCheck.Gen (Gen, Size, showSample, sized, frequency, oneOf, vectorOf) +import Test.StrongCheck.Arbitrary (class Arbitrary) +import Test.StrongCheck.Gen (suchThat, resize) main :: SC () Unit main = do eitherCheck encodeDecodeCheck combinatorsCheck - genericsCheck - -genJNull :: Gen Json -genJNull = pure jsonNull - -genJBool :: Gen Json -genJBool = fromBoolean <$> arbitrary - -genJNumber :: Gen Json -genJNumber = fromNumber <$> arbitrary - -genJString :: Gen Json -genJString = fromString <$> arbitrary - -genJArray :: Size -> Gen Json -genJArray sz = fromArray <$> vectorOf sz (genJson $ sz - 1) - -genJObject :: Size -> Gen Json -genJObject sz = do - v <- vectorOf sz (genJson $ sz - 1) - k <- vectorOf (length v) (arbitrary :: Gen AlphaNumString) - pure - let - f (AlphaNumString s) = s <> "x" - k' = f <$> k - in - fromObject <<< SM.fromFoldable <<< nubBy (eq `on` fst) $ zipWith Tuple k' v - -genJson :: Size -> Gen Json -genJson 0 = oneOf genJNull [genJBool, genJNumber, genJString] -genJson n = frequency (Tuple 1.0 genJNull) rest where - rest = fromFoldable - [ Tuple 2.0 genJBool - , Tuple 2.0 genJNumber - , Tuple 3.0 genJString - , Tuple 1.0 (genJArray n) - , Tuple 1.0 (genJObject n) - ] newtype TestJson = TestJson Json instance arbitraryTestJson :: Arbitrary TestJson where - arbitrary = TestJson <$> sized genJson + arbitrary = TestJson <$> (resize 5 genJson) encodeDecodeCheck :: SC () Unit encodeDecodeCheck = do - log "Showing small sample of JSON" - showSample (genJson 10) - log "Testing that any JSON can be encoded and then decoded" quickCheck' 20 prop_encode_then_decode log "Testing that any JSON can be decoded and then encoded" - quickCheck' 20 prop_decode_then_encode + quickCheck' 20 (prop_decode_then_encode) where @@ -98,7 +53,7 @@ unObj :: Obj -> Json unObj (Obj j) = j instance arbitraryObj :: Arbitrary Obj where - arbitrary = Obj <$> genJObject 5 + arbitrary = Obj <$> suchThat (resize 5 genJson) isObject combinatorsCheck :: SC () Unit combinatorsCheck = do @@ -121,7 +76,7 @@ combinatorsCheck = do prop_assoc_append (Tuple (Tuple key (TestJson val)) (Obj obj)) = let appended = (key := val) ~> obj in case toObject appended >>= SM.lookup key of - Just val -> true + Just value -> true _ -> false prop_get_jobject_field :: Obj -> Boolean @@ -129,61 +84,9 @@ combinatorsCheck = do maybe false go $ toObject obj where go :: JObject -> Boolean - go obj = - let keys = SM.keys obj - in foldl (\ok key -> ok && isJust (SM.lookup key obj)) true keys - -newtype MyRecord = MyRecord { foo :: String, bar :: Int } - -derive instance genericMyRecord :: Generic MyRecord - -data User - = Anonymous - | Guest String - | Registered - { name :: String - , bio :: Maybe String - , age :: Int - , balance :: Number - , banned :: Boolean - , tweets :: Array String - , followers :: Array User - } - -derive instance genericUser :: Generic User - -genericsCheck :: SC () Unit -genericsCheck = do - log "Print samples of values encoded with gEncodeJson" - logShow $ gEncodeJson 5 - logShow $ gEncodeJson [1, 2, 3, 5] - logShow $ gEncodeJson (Just "foo") - logShow $ gEncodeJson (Right "foo" :: Either String String) - logShow $ gEncodeJson $ MyRecord { foo: "foo", bar: 2} - logShow $ gEncodeJson "foo" - logShow $ gEncodeJson Anonymous - logShow $ gEncodeJson $ Guest "guest's handle" - logShow $ gEncodeJson $ Registered - { name: "user1" - , bio: Just "Ordinary User" - , age: 5 - , balance: 26.6 - , banned: false - , tweets: ["Hello", "What's up"] - , followers: - [ Anonymous - , Guest "someGuest" - , Registered - { name: "user2" - , bio: Nothing - , age: 6 - , balance: 32.1 - , banned: false - , tweets: ["Hi"] - , followers: [] - } - ] - } + go object = + let keys = SM.keys object + in foldl (\ok key -> ok && isJust (SM.lookup key object)) true keys eitherCheck :: SC () Unit eitherCheck = do