diff --git a/CHANGELOG.md b/CHANGELOG.md index 6db72d3..5b96648 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,6 +8,8 @@ Breaking changes (😱!!!): New features: +- Added support for decoding missing record fields to `Nothing` (#93 by @jvliwanag) + Bugfixes: Other improvements: @@ -181,4 +183,4 @@ Updated dependencies ## [v0.1.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v0.1.0) - 2015-07-13 -- Initial release \ No newline at end of file +- Initial release diff --git a/src/Data/Argonaut/Decode/Class.purs b/src/Data/Argonaut/Decode/Class.purs index d9cd695..d769043 100644 --- a/src/Data/Argonaut/Decode/Class.purs +++ b/src/Data/Argonaut/Decode/Class.purs @@ -18,7 +18,7 @@ import Data.String (CodePoint) import Data.Symbol (class IsSymbol, reflectSymbol) import Data.Tuple (Tuple) import Foreign.Object as FO -import Prelude (class Ord, Unit, Void, bind, ($), (<<<)) +import Prelude (class Ord, Unit, Void, bind, ($), (<$>)) import Prim.Row as Row import Prim.RowList as RL import Record as Record @@ -107,7 +107,7 @@ instance gDecodeJsonNil :: GDecodeJson () RL.Nil where gDecodeJson _ _ = Right {} instance gDecodeJsonCons - :: ( DecodeJson value + :: ( DecodeJsonField value , GDecodeJson rowTail tail , IsSymbol field , Row.Cons field value rowTail row @@ -118,12 +118,27 @@ instance gDecodeJsonCons let _field = Proxy :: Proxy field fieldName = reflectSymbol _field + fieldValue = FO.lookup fieldName object - case FO.lookup fieldName object of - Just jsonVal -> do - val <- lmap (AtKey fieldName) <<< decodeJson $ jsonVal + case decodeJsonField fieldValue of + Just fieldVal -> do + val <- lmap (AtKey fieldName) fieldVal rest <- gDecodeJson object (Proxy :: Proxy tail) Right $ Record.insert _field val rest Nothing -> Left $ AtKey fieldName MissingValue + +class DecodeJsonField a where + decodeJsonField :: Maybe Json -> Maybe (Either JsonDecodeError a) + +instance decodeFieldMaybe + :: DecodeJson a + => DecodeJsonField (Maybe a) where + decodeJsonField Nothing = Just $ Right Nothing + decodeJsonField (Just j) = Just $ decodeJson j + +else instance decodeFieldId + :: DecodeJson a + => DecodeJsonField a where + decodeJsonField j = decodeJson <$> j diff --git a/test/Test/Main.purs b/test/Test/Main.purs index b377b20..e2bb912 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -72,6 +72,7 @@ main = flip runReaderT 0 do suite "Encode/Decode NonEmpty Check" nonEmptyCheck suite "Encode/Decode Checks" encodeDecodeCheck suite "Encode/Decode Record Checks" encodeDecodeRecordCheck + suite "Decode Optional Field Check" decodeOptionalFieldCheck suite "Combinators Checks" combinatorsCheck suite "Manual Combinators Checks" manualRecordDecode suite "Error Message Checks" errorMsgCheck @@ -91,6 +92,27 @@ encodeDecodeRecordCheck = do let redecoded = decodeJson (encodeJson rec) pure $ Right rec == redecoded (show redecoded <> " /= Right " <> show rec) +decodeOptionalFieldCheck :: Test +decodeOptionalFieldCheck = do + barMissingJson <- jsonParser' """{ }""" + barNullJson <- jsonParser' """{ "bar": null }""" + barPresentJson <- jsonParser' """{ "bar": [] }""" + + test "Decode missing field" do + case decodeJson barMissingJson of + Right ({ bar: Nothing } :: FooRecord) -> pure unit + _ -> failure ("Failed to properly decode JSON string: " <> stringify barMissingJson) + + test "Decode null field" do + case decodeJson barNullJson of + Right ({ bar: Nothing } :: FooRecord) -> pure unit + _ -> failure ("Failed to properly decode JSON string: " <> stringify barNullJson) + + test "Decode present field" do + case decodeJson barPresentJson of + Right ({ bar: Just [] } :: FooRecord) -> pure unit + _ -> failure ("Failed to properly decode JSON string: " <> stringify barPresentJson) + genTestJson :: Gen Json genTestJson = resize 5 genJson @@ -417,3 +439,7 @@ instance decodeJsonFooNested' :: DecodeJson FooNested' where bar <- x .:? "bar" baz <- x .:? "baz" .!= false pure $ FooNested' { bar, baz } + +type FooRecord = + { bar :: Maybe (Array Int) + }