diff --git a/README.md b/README.md index efe8230..2078c45 100644 --- a/README.md +++ b/README.md @@ -24,8 +24,8 @@ Using [purescript-argonaut-core](https://github.com/purescript-contrib/purescrip ```purescript someObject = - let - objects = + let + objects = [ jsonSingletonObject "bar" (fromString "a") , jsonSingletonObject "bar" (fromString "b") ] @@ -33,19 +33,38 @@ someObject = fromObject $ Object.fromFoldable [ Tuple "foo" (fromArray objects) ] ``` -The `decodeJson` and `.?` functions provided in this module make it straightforward to interrogate the `Json` object: +The `decodeJson`, `.:`, `.:?`, and `.!=` functions provided in this module make it straightforward to interrogate the `Json` object: ```purescript -main = - log $ show $ getBars someObject - -getBars :: Json -> Either String (Array String) -getBars json = do - obj <- decodeJson json - foo <- obj .? "foo" - for foo \itemJson -> do - itemObj <- decodeJson itemJson - itemObj .? "bar" +newtype MyType = MyType + { foo :: String + , bar :: Maybe Int + , baz :: Boolean + } + +-- create a `DecodeJson` instance +instance decodeJsonMyType :: DecodeJson MyType where + decodeJson json = do + x <- decodeJson json + foo <- x .: "foo" -- mandatory field + bar <- x .:? "bar" -- optional field + baz <- x .:? "baz" .!= false -- optional field with default value of `false` + pure $ MyType { foo, bar, baz } + +-- or pass a function +decodeMyTypes :: Json -> Either String (Array MyType) +decodeMyTypes json = do + x <- decodeJson json + arr <- x .: "myTypes" + for arr decodeJson + +-- create a `EncodeJson` instance +instance encodeJsonMyType :: EncodeJson MyType where + encodeJson (MyType x) = + "foo" := x.foo ~> + "bar" :=? x.bar ~>? -- optional field + "baz" := x.baz ~> + jsonEmptyObject ``` ## Contributing diff --git a/package-lock.json b/package-lock.json index c09e073..e4ab46f 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1129,12 +1129,14 @@ "balanced-match": { "version": "1.0.0", "bundled": true, - "dev": true + "dev": true, + "optional": true }, "brace-expansion": { "version": "1.1.11", "bundled": true, "dev": true, + "optional": true, "requires": { "balanced-match": "^1.0.0", "concat-map": "0.0.1" @@ -1149,17 +1151,20 @@ "code-point-at": { "version": "1.1.0", "bundled": true, - "dev": true + "dev": true, + "optional": true }, "concat-map": { "version": "0.0.1", "bundled": true, - "dev": true + "dev": true, + "optional": true }, "console-control-strings": { "version": "1.1.0", "bundled": true, - "dev": true + "dev": true, + "optional": true }, "core-util-is": { "version": "1.0.2", @@ -1276,7 +1281,8 @@ "inherits": { "version": "2.0.3", "bundled": true, - "dev": true + "dev": true, + "optional": true }, "ini": { "version": "1.3.5", @@ -1288,6 +1294,7 @@ "version": "1.0.0", "bundled": true, "dev": true, + "optional": true, "requires": { "number-is-nan": "^1.0.0" } @@ -1302,6 +1309,7 @@ "version": "3.0.4", "bundled": true, "dev": true, + "optional": true, "requires": { "brace-expansion": "^1.1.7" } @@ -1309,12 +1317,14 @@ "minimist": { "version": "0.0.8", "bundled": true, - "dev": true + "dev": true, + "optional": true }, "minipass": { "version": "2.2.4", "bundled": true, "dev": true, + "optional": true, "requires": { "safe-buffer": "^5.1.1", "yallist": "^3.0.0" @@ -1333,6 +1343,7 @@ "version": "0.5.1", "bundled": true, "dev": true, + "optional": true, "requires": { "minimist": "0.0.8" } @@ -1413,7 +1424,8 @@ "number-is-nan": { "version": "1.0.1", "bundled": true, - "dev": true + "dev": true, + "optional": true }, "object-assign": { "version": "4.1.1", @@ -1425,6 +1437,7 @@ "version": "1.4.0", "bundled": true, "dev": true, + "optional": true, "requires": { "wrappy": "1" } @@ -1546,6 +1559,7 @@ "version": "1.0.2", "bundled": true, "dev": true, + "optional": true, "requires": { "code-point-at": "^1.0.0", "is-fullwidth-code-point": "^1.0.0", diff --git a/src/Data/Argonaut/Decode.purs b/src/Data/Argonaut/Decode.purs index f73f177..78d16c3 100644 --- a/src/Data/Argonaut/Decode.purs +++ b/src/Data/Argonaut/Decode.purs @@ -4,4 +4,4 @@ module Data.Argonaut.Decode ) where import Data.Argonaut.Decode.Class (class DecodeJson, decodeJson) -import Data.Argonaut.Decode.Combinators (getField, (.?), getFieldOptional, (.??), defaultField, (.?=)) +import Data.Argonaut.Decode.Combinators ( getField, getFieldDeprecated, getFieldOptional, getFieldOptionalDeprecated, getFieldOptional', defaultField, defaultFieldDeprecated, (.:), (.?), (.:!), (.:?), (.??), (.!=), (.?=)) diff --git a/src/Data/Argonaut/Decode/Class.purs b/src/Data/Argonaut/Decode/Class.purs index e154872..e581bbb 100644 --- a/src/Data/Argonaut/Decode/Class.purs +++ b/src/Data/Argonaut/Decode/Class.purs @@ -2,7 +2,6 @@ module Data.Argonaut.Decode.Class where import Prelude -import Control.Alternative (class Plus) import Data.Argonaut.Core (Json, isNull, caseJsonNull, caseJsonBoolean, caseJsonNumber, caseJsonString, toArray, toObject, toString, stringify) import Data.Array as Arr import Data.Bifunctor (lmap, rmap) @@ -12,7 +11,7 @@ import Data.List (List(..), (:), fromFoldable) import Data.List as L import Data.Map as M import Data.Maybe (maybe, Maybe(..)) -import Data.NonEmpty (NonEmpty, singleton, (:|)) +import Data.NonEmpty (NonEmpty, (:|)) import Data.String (CodePoint, codePointAt) import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol) import Data.Traversable (traverse) diff --git a/src/Data/Argonaut/Decode/Combinators.purs b/src/Data/Argonaut/Decode/Combinators.purs index 61b2326..bf748ba 100644 --- a/src/Data/Argonaut/Decode/Combinators.purs +++ b/src/Data/Argonaut/Decode/Combinators.purs @@ -1,21 +1,34 @@ module Data.Argonaut.Decode.Combinators ( getField + , getFieldDeprecated , getFieldOptional + , getFieldOptionalDeprecated + , getFieldOptional' , defaultField + , defaultFieldDeprecated + , (.:) , (.?) + , (.:!) + , (.:?) , (.??) + , (.!=) , (.?=) ) where import Prelude -import Data.Argonaut.Core (Json) +import Data.Argonaut.Core (Json, isNull) import Data.Argonaut.Decode.Class (class DecodeJson, decodeJson) import Data.Bifunctor (lmap) import Data.Either (Either(..)) import Data.Maybe (Maybe(..), fromMaybe, maybe) import Foreign.Object as FO +import Prim.TypeError (class Warn, Text) +-- | Attempt to get the value for a given key on an `Object Json`. +-- | +-- | Use this accessor if the key and value *must* be present in your object. +-- | If the key and value are optional, use `getFieldOptional'` (`.:?`) instead. getField :: forall a. DecodeJson a => FO.Object Json -> String -> Either String a getField o s = maybe @@ -23,8 +36,47 @@ getField o s = (elaborateFailure s <<< decodeJson) (FO.lookup s o) -infix 7 getField as .? +infix 7 getField as .: +getFieldDeprecated + :: forall a. Warn ( Text "`.?` is deprecated, use `.:` instead" ) + => DecodeJson a + => FO.Object Json + -> String + -> Either String a +getFieldDeprecated = getField + +infix 7 getFieldDeprecated as .? + +-- | Attempt to get the value for a given key on an `Object Json`. +-- | +-- | The result will be `Right Nothing` if the key and value are not present, +-- | or if the key is present and the value is `null`. +-- | +-- | Use this accessor if the key and value are optional in your object. +-- | If the key and value are mandatory, use `getField` (`.:`) instead. +getFieldOptional' :: forall a. DecodeJson a => FO.Object Json -> String -> Either String (Maybe a) +getFieldOptional' o s = + maybe + (pure Nothing) + decode + (FO.lookup s o) + where + decode json = + if isNull json + then pure Nothing + else Just <$> decodeJson json + +infix 7 getFieldOptional' as .:? + +-- | Attempt to get the value for a given key on an `Object Json`. +-- | +-- | The result will be `Right Nothing` if the key and value are not present, +-- | but will fail if the key is present but the value cannot be converted to the right type. +-- | +-- | This function will treat `null` as a value and attempt to decode it into your desired type. +-- | If you would like to treat `null` values the same as absent values, use +-- | `getFieldOptional` (`.:?`) instead. getFieldOptional :: forall a. DecodeJson a => FO.Object Json -> String -> Either String (Maybe a) getFieldOptional o s = maybe @@ -34,12 +86,48 @@ getFieldOptional o s = where decode json = Just <$> (elaborateFailure s <<< decodeJson) json -infix 7 getFieldOptional as .?? +infix 7 getFieldOptional as .:! + +getFieldOptionalDeprecated + :: forall a. Warn ( Text "`.??` is deprecated, use `.:!` or `.:?` instead" ) + => DecodeJson a + => FO.Object Json + -> String + -> Either String (Maybe a) +getFieldOptionalDeprecated = getFieldOptional +infix 7 getFieldOptionalDeprecated as .?? + +-- | Helper for use in combination with `.:?` to provide default values for optional +-- | `Object Json` fields. +-- | +-- | Example usage: +-- | ```purescript +-- | newtype MyType = MyType +-- | { foo :: String +-- | , bar :: Maybe Int +-- | , baz :: Boolean +-- | } +-- | +-- | instance decodeJsonMyType :: DecodeJson MyType where +-- | decodeJson json = do +-- | x <- decodeJson json +-- | foo <- x .: "foo" -- mandatory field +-- | bar <- x .:? "bar" -- optional field +-- | baz <- x .:? "baz" .!= false -- optional field with default value of `false` +-- | pure $ MyType { foo, bar, baz } +-- | ``` defaultField :: forall a. Either String (Maybe a) -> a -> Either String a defaultField parser default = fromMaybe default <$> parser -infix 6 defaultField as .?= +infix 6 defaultField as .!= + +defaultFieldDeprecated + :: forall a. Warn ( Text "`.?=` is deprecated, use `.!=` instead" ) + => Either String (Maybe a) -> a -> Either String a +defaultFieldDeprecated = defaultField + +infix 6 defaultFieldDeprecated as .?= elaborateFailure :: ∀ a. String -> Either String a -> Either String a elaborateFailure s e = diff --git a/test/Test/Main.purs b/test/Test/Main.purs index fedf330..aa5c42b 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -4,7 +4,7 @@ import Prelude import Control.Monad.Gen.Common (genMaybe) import Data.Argonaut.Core (Json, isObject, stringify, toObject) -import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.?)) +import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.:), (.:!), (.:?), (.!=)) import Data.Argonaut.Encode (encodeJson, (:=), (:=?), (~>), (~>?)) import Data.Argonaut.Gen (genJson) import Data.Argonaut.Parser (jsonParser) @@ -21,7 +21,7 @@ import Foreign.Object as FO import Test.QuickCheck (Result(..), (), (===)) import Test.QuickCheck.Arbitrary (arbitrary) import Test.QuickCheck.Gen (Gen, resize, suchThat) -import Test.Unit (TestSuite, test, suite, failure) +import Test.Unit (TestSuite, failure, success, suite, test) import Test.Unit.Assert as Assert import Test.Unit.Main (runTest) import Test.Unit.QuickCheck (quickCheck) @@ -34,6 +34,7 @@ main = runTest do suite "Encode/Decode Checks" encodeDecodeCheck suite "Encode/Decode Record Checks" encodeDecodeRecordCheck suite "Combinators Checks" combinatorsCheck + suite "Manual Combinators Checks" manualRecordDecode suite "Error Message Checks" errorMsgCheck @@ -56,7 +57,7 @@ encodeDecodeRecordCheck = do rec <- genTestRecord let redecoded = decodeJson (encodeJson rec) pure $ Right rec == redecoded (show redecoded <> " /= Right " <> show rec) - + genTestJson :: Gen Json genTestJson = resize 5 genJson @@ -97,7 +98,7 @@ combinatorsCheck = do quickCheck prop_assoc_append test "Check JAssoc appendOptional `~>?`" do quickCheck prop_assoc_append_optional - test "Check get field `obj .? 'foo'`" do + test "Check get field `obj .: 'foo'`" do -- this doesn't really test .: quickCheck prop_get_jobject_field where @@ -160,6 +161,109 @@ eitherCheck = do Left err -> false err +manualRecordDecode :: TestSuite +manualRecordDecode = do + test "Test that decoding custom record is successful" do + case decodeJson =<< jsonParser fooJson of + Right (Foo _) -> success + 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 = do + test "Empty Json should decode to FooNested" do + case decodeJson =<< jsonParser fooNestedEmptyJson of + Right (FooNested { bar: Nothing, baz: false }) -> success + _ -> 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 + test "Empty Json should decode to FooNested'" do + case decodeJson =<< jsonParser fooNestedEmptyJson of + Right (FooNested' { bar: Nothing, baz: false }) -> success + _ -> 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 + _ -> failure ("Failed to properly decode JSON string: " <> fooNestedEmptyJsonNull) + + testBarCases :: TestSuite + testBarCases = do + test "Missing 'bar' key should decode to FooNested" do + case decodeJson =<< jsonParser fooNestedBazJson of + Right (FooNested { bar: Nothing, baz: true }) -> success + _ -> 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 + test "Missing 'bar' key should decode to FooNested'" do + case decodeJson =<< jsonParser fooNestedBazJson of + Right (FooNested' { bar: Nothing, baz: true }) -> success + _ -> 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 + _ -> failure ("Failed to properly decode JSON string: " <> fooNestedBazJsonNull) + + testBazCases :: TestSuite + testBazCases = do + test "Missing 'baz' key should decode to FooNested" do + case decodeJson =<< jsonParser fooNestedBarJson of + Right (FooNested { bar: Just [1], baz: false }) -> success + _ -> 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 + test "Missing 'baz' key should decode to FooNested'" do + case decodeJson =<< jsonParser fooNestedBarJson of + Right (FooNested' { bar: Just [1], baz: false }) -> success + _ -> 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 + _ -> failure ("Failed to properly decode JSON string: " <> fooNestedBarJsonNull) + + testFullCases :: TestSuite + testFullCases = do + test "Json should decode to FooNested" do + case decodeJson =<< jsonParser fooNestedFullJson of + Right (FooNested { bar: Just [1], baz: true }) -> success + _ -> 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 + _ -> failure ("Failed to properly decode JSON string: " <> fooNestedFullJson) + + fooJson :: String + fooJson = """{ "bar": [1, 2, 3], "baz": true }""" + + fooNestedEmptyJson :: String + fooNestedEmptyJson = "{ }" + + fooNestedEmptyJsonNull :: String + fooNestedEmptyJsonNull = """{ "bar": null, "baz": null }""" + + fooNestedBazJson :: String + fooNestedBazJson = """{ "baz": true }""" + + fooNestedBazJsonNull :: String + fooNestedBazJsonNull = """{ "bar": null, "baz": true }""" + + fooNestedBarJson :: String + fooNestedBarJson = """{ "bar": [1] }""" + + fooNestedBarJsonNull :: String + fooNestedBarJsonNull = """{ "bar": [1], "baz": null }""" + + fooNestedFullJson :: String + fooNestedFullJson = """{ "bar": [1], "baz": true }""" + nonEmptyCheck :: TestSuite nonEmptyCheck = do test "Test EncodeJson/DecodeJson on NonEmpty Array" do @@ -189,23 +293,23 @@ errorMsgCheck = do case notBaz of Left err -> Assert.equal bazErr err _ -> failure "Should have failed to decode" - where + barErr :: String + barErr = + "Failed to decode key 'bar': " + <> "Couldn't decode Array (Failed at index 1): " + <> "Value is not a Number" - barErr :: String - barErr = "Failed to decode key 'bar': " - <> "Couldn't decode Array (Failed at index 1): " - <> "Value is not a Number" - - bazErr :: String - bazErr = "Failed to decode key 'baz': " - <> "Value is not a Boolean" + bazErr :: String + bazErr = + "Failed to decode key 'baz': " + <> "Value is not a Boolean" - notBar :: Either String Foo - notBar = decodeJson =<< jsonParser "{ \"bar\": [1, true, 3], \"baz\": false }" + notBar :: Either String Foo + notBar = decodeJson =<< jsonParser """{ "bar": [1, true, 3], "baz": false }""" - notBaz :: Either String Foo - notBaz = decodeJson =<< jsonParser "{ \"bar\": [1, 2, 3], \"baz\": 42 }" + notBaz :: Either String Foo + notBaz = decodeJson =<< jsonParser """{ "bar": [1, 2, 3], "baz": 42 }""" newtype Foo = Foo { bar :: Array Int @@ -215,6 +319,30 @@ newtype Foo = Foo instance decodeJsonFoo :: DecodeJson Foo where decodeJson json = do x <- decodeJson json - bar <- x .? "bar" - baz <- x .? "baz" + bar <- x .: "bar" + baz <- x .: "baz" pure $ Foo { bar, baz } + +newtype FooNested = FooNested + { bar :: Maybe (Array Int) + , baz :: Boolean + } + +instance decodeJsonFooNested :: DecodeJson FooNested where + decodeJson json = do + x <- decodeJson json + bar <- x .:! "bar" + baz <- x .:! "baz" .!= false + pure $ FooNested { bar, baz } + +newtype FooNested' = FooNested' + { bar :: Maybe (Array Int) + , baz :: Boolean + } + +instance decodeJsonFooNested' :: DecodeJson FooNested' where + decodeJson json = do + x <- decodeJson json + bar <- x .:? "bar" + baz <- x .:? "baz" .!= false + pure $ FooNested' { bar, baz }