autodocodec 0.2.0.4 → 0.2.0.5

raw patch · 7 files changed

+152/−38 lines, 7 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• autodocodec.cabal +2/−2
• src/Autodocodec.hs +10/−0
• src/Autodocodec/Aeson.hs +10/−0
• src/Autodocodec/Aeson/Decode.hs +19/−1
• src/Autodocodec/Aeson/Encode.hs +60/−34
• src/Autodocodec/Codec.hs +44/−1

@@ -1,5 +1,12 @@ # Changelog +## [0.2.0.5] - 2023-08-27++### Added++* JSON Object-specific versions of encoding and decoding functions+* Documentation about how 'parseAlternative' and 'optionalField' together can be a pitfall.+ ## [0.2.0.4] - 2023-07-31  ### Added

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           autodocodec-version:        0.2.0.4+version:        0.2.0.5 synopsis:       Self-documenting encoder and decoder homepage:       https://github.com/NorfairKing/autodocodec#readme bug-reports:    https://github.com/NorfairKing/autodocodec/issues@@ -65,7 +65,7 @@       base >=4.7 && <5     , doctest   default-language: Haskell2010-  if impl(GHC < 9.0)+  if impl(GHC > 9.2)     buildable: True   else     buildable: False

@@ -11,9 +11,19 @@     toEncodingViaCodec,     toEncodingVia, +    -- ** JSON Objects+    toJSONObjectViaCodec,+    toJSONObjectVia,+    toSeriesViaCodec,+    toSeriesVia,+     -- * Instantiating 'Aeson.FromJSON'     parseJSONViaCodec,     parseJSONVia,++    -- ** JSON Objects+    parseJSONObjectViaCodec,+    parseJSONObjectVia,      -- * Codec     JSONCodec,

@@ -11,9 +11,19 @@     toEncodingViaCodec,     toEncodingVia, +    -- ** JSON Objects+    toJSONObjectViaCodec,+    toJSONObjectVia,+    toSeriesViaCodec,+    toSeriesVia,+     -- * Instantiating @FromJSON@     parseJSONViaCodec,     parseJSONVia,++    -- ** JSON Objects+    parseJSONObjectViaCodec,+    parseJSONObjectVia,      -- * To makes sure we definitely export everything.     module Autodocodec.Aeson.Decode,

@@ -4,8 +4,20 @@ {-# LANGUAGE PartialTypeSignatures #-} {-# OPTIONS_GHC -fno-warn-partial-type-signatures -fno-warn-orphans #-} -module Autodocodec.Aeson.Decode where+module Autodocodec.Aeson.Decode+  ( -- * Decoding JSON Values+    parseJSONViaCodec,+    parseJSONVia, +    -- ** Decoding JSON Objects+    parseJSONObjectViaCodec,+    parseJSONObjectVia,++    -- ** Internal+    parseJSONContextVia,+  )+where+ import qualified Autodocodec.Aeson.Compat as Compat import Autodocodec.Class import Autodocodec.Codec@@ -27,6 +39,12 @@ -- | Implement 'JSON.parseJSON' via a given codec. parseJSONVia :: ValueCodec void a -> JSON.Value -> JSON.Parser a parseJSONVia = parseJSONContextVia++parseJSONObjectViaCodec :: HasObjectCodec a => JSON.Object -> JSON.Parser a+parseJSONObjectViaCodec = parseJSONObjectVia objectCodec++parseJSONObjectVia :: ObjectCodec void a -> JSON.Object -> JSON.Parser a+parseJSONObjectVia = parseJSONContextVia  -- | Parse via a general codec. --

@@ -3,8 +3,21 @@ {-# LANGUAGE PartialTypeSignatures #-} {-# OPTIONS_GHC -fno-warn-partial-type-signatures -fno-warn-orphans #-} -module Autodocodec.Aeson.Encode where+module Autodocodec.Aeson.Encode+  ( -- * Encoding JSON Values+    toJSONViaCodec,+    toJSONVia,+    toEncodingViaCodec,+    toEncodingVia, +    -- * Encoding JSON Objects+    toJSONObjectViaCodec,+    toJSONObjectVia,+    toSeriesViaCodec,+    toSeriesVia,+  )+where+ import qualified Autodocodec.Aeson.Compat as Compat import Autodocodec.Class import Autodocodec.Codec@@ -23,6 +36,34 @@ toJSONViaCodec :: HasCodec a => a -> JSON.Value toJSONViaCodec = toJSONVia codec +toJSONObjectViaCodec :: HasObjectCodec a => a -> JSON.Object+toJSONObjectViaCodec = toJSONObjectVia objectCodec++toJSONObjectVia :: ObjectCodec a void -> a -> JSON.Object+toJSONObjectVia = flip go+  where+    go :: a -> ObjectCodec a void -> JSON.Object+    go a = \case+      RequiredKeyCodec k c _ -> Compat.toKey k JSON..= toJSONVia c a+      OptionalKeyCodec k c _ -> case (a :: Maybe _) of+        Nothing -> mempty+        Just b -> Compat.toKey k JSON..= toJSONVia c b+      OptionalKeyWithDefaultCodec k c _ mdoc -> go (Just a) (OptionalKeyCodec k c mdoc)+      OptionalKeyWithOmittedDefaultCodec k c defaultValue mdoc ->+        if a == defaultValue+          then mempty+          else go a (OptionalKeyWithDefaultCodec k c defaultValue mdoc)+      BimapCodec _ g c -> go (g a) c+      PureCodec _ -> mempty+      EitherCodec _ c1 c2 -> case (a :: Either _ _) of+        Left a1 -> go a1 c1+        Right a2 -> go a2 c2+      DiscriminatedUnionCodec propertyName mapping _ ->+        case mapping a of+          (discriminatorValue, c) ->+            Compat.insert (Compat.toKey propertyName) (JSON.String discriminatorValue) $ go a c+      ApCodec oc1 oc2 -> go a oc1 <> go a oc2+ -- | Implement 'JSON.toJSON' via a given codec. toJSONVia :: ValueCodec a void -> a -> JSON.Value toJSONVia = flip go@@ -36,7 +77,7 @@       StringCodec _ -> toJSON (a :: Text)       NumberCodec _ _ -> toJSON (a :: Scientific)       ArrayOfCodec _ c -> toJSON (fmap (`go` c) (a :: Vector _))-      ObjectOfCodec _ oc -> JSON.Object (goObject a oc)+      ObjectOfCodec _ oc -> JSON.Object (toJSONObjectVia oc a)       HashMapCodec c -> JSON.liftToJSON (`go` c) (`go` listCodec c) (a :: HashMap _ _)       MapCodec c -> JSON.liftToJSON (`go` c) (`go` listCodec c) (a :: Map _ _)       ValueCodec -> (a :: JSON.Value)@@ -48,32 +89,38 @@       CommentCodec _ c -> go a c       ReferenceCodec _ c -> go a c -    goObject :: a -> ObjectCodec a void -> JSON.Object+-- | Implement 'JSON.toEncoding' via a type's codec.+toEncodingViaCodec :: HasCodec a => a -> JSON.Encoding+toEncodingViaCodec = toEncodingVia codec++toSeriesViaCodec :: HasObjectCodec a => a -> JSON.Series+toSeriesViaCodec = toSeriesVia objectCodec++toSeriesVia :: ObjectCodec a void -> a -> JSON.Series+toSeriesVia = flip goObject+  where+    goObject :: a -> ObjectCodec a void -> JSON.Series     goObject a = \case-      RequiredKeyCodec k c _ -> Compat.toKey k JSON..= go a c+      RequiredKeyCodec k c _ -> JSON.pair (Compat.toKey k) (toEncodingVia c a)       OptionalKeyCodec k c _ -> case (a :: Maybe _) of-        Nothing -> mempty-        Just b -> Compat.toKey k JSON..= go b c+        Nothing -> mempty :: JSON.Series+        Just b -> JSON.pair (Compat.toKey k) (toEncodingVia c b)       OptionalKeyWithDefaultCodec k c _ mdoc -> goObject (Just a) (OptionalKeyCodec k c mdoc)       OptionalKeyWithOmittedDefaultCodec k c defaultValue mdoc ->         if a == defaultValue           then mempty           else goObject a (OptionalKeyWithDefaultCodec k c defaultValue mdoc)+      PureCodec _ -> mempty :: JSON.Series       BimapCodec _ g c -> goObject (g a) c-      PureCodec _ -> mempty       EitherCodec _ c1 c2 -> case (a :: Either _ _) of         Left a1 -> goObject a1 c1         Right a2 -> goObject a2 c2       DiscriminatedUnionCodec propertyName mapping _ ->         case mapping a of           (discriminatorValue, c) ->-            Compat.insert (Compat.toKey propertyName) (JSON.String discriminatorValue) $ goObject a c+            JSON.pair (Compat.toKey propertyName) (JSON.toEncoding discriminatorValue) <> goObject a c       ApCodec oc1 oc2 -> goObject a oc1 <> goObject a oc2 --- | Implement 'JSON.toEncoding' via a type's codec.-toEncodingViaCodec :: HasCodec a => a -> JSON.Encoding-toEncodingViaCodec = toEncodingVia codec- -- | Implement 'JSON.toEncoding' via the given codec. toEncodingVia :: ValueCodec a void -> a -> JSON.Encoding toEncodingVia = flip go@@ -85,7 +132,7 @@       StringCodec _ -> JSON.text (a :: Text)       NumberCodec _ _ -> JSON.scientific (a :: Scientific)       ArrayOfCodec _ c -> JSON.list (`go` c) (V.toList (a :: Vector _))-      ObjectOfCodec _ oc -> JSON.pairs (goObject a oc)+      ObjectOfCodec _ oc -> JSON.pairs (toSeriesVia oc a)       HashMapCodec c -> JSON.liftToEncoding (`go` c) (`go` listCodec c) (a :: HashMap _ _)       MapCodec c -> JSON.liftToEncoding (`go` c) (`go` listCodec c) (a :: Map _ _)       ValueCodec -> JSON.value (a :: JSON.Value)@@ -96,27 +143,6 @@         Right a2 -> go a2 c2       CommentCodec _ c -> go a c       ReferenceCodec _ c -> go a c-    goObject :: a -> ObjectCodec a void -> JSON.Series-    goObject a = \case-      RequiredKeyCodec k c _ -> JSON.pair (Compat.toKey k) (go a c)-      OptionalKeyCodec k c _ -> case (a :: Maybe _) of-        Nothing -> mempty :: JSON.Series-        Just b -> JSON.pair (Compat.toKey k) (go b c)-      OptionalKeyWithDefaultCodec k c _ mdoc -> goObject (Just a) (OptionalKeyCodec k c mdoc)-      OptionalKeyWithOmittedDefaultCodec k c defaultValue mdoc ->-        if a == defaultValue-          then mempty-          else goObject a (OptionalKeyWithDefaultCodec k c defaultValue mdoc)-      PureCodec _ -> mempty :: JSON.Series-      BimapCodec _ g c -> goObject (g a) c-      EitherCodec _ c1 c2 -> case (a :: Either _ _) of-        Left a1 -> goObject a1 c1-        Right a2 -> goObject a2 c2-      DiscriminatedUnionCodec propertyName mapping _ ->-        case mapping a of-          (discriminatorValue, c) ->-            JSON.pair (Compat.toKey propertyName) (JSON.toEncoding discriminatorValue) <> goObject a c-      ApCodec oc1 oc2 -> goObject a oc1 <> goObject a oc2  instance HasCodec a => JSON.ToJSON (Autodocodec a) where   toJSON = toJSONViaCodec . unAutodocodec

@@ -44,7 +44,7 @@ import GHC.Generics (Generic)  -- $setup--- >>> import Autodocodec.Aeson (toJSONVia, toJSONViaCodec, parseJSONVia, parseJSONViaCodec)+-- >>> import Autodocodec.Aeson (toJSONVia, toJSONViaCodec, toJSONObjectVia, toJSONObjectViaCodec, parseJSONVia, parseJSONViaCodec, parseJSONObjectVia, parseJSONObjectViaCodec) -- >>> import qualified Autodocodec.Aeson.Compat as Compat -- >>> import Autodocodec.Class (HasCodec(codec), requiredField) -- >>> import qualified Data.Aeson as JSON@@ -1555,6 +1555,8 @@ -- Just Apple -- >>> JSON.parseMaybe (parseJSONVia c) (String "Apple") :: Maybe Fruit -- Just Apple+-- >>> JSON.parseMaybe (parseJSONVia c) (String "Tomato") :: Maybe Fruit+-- Nothing parseAlternatives ::   -- | Main codec, for parsing and rendering   Codec context input output ->@@ -1573,6 +1575,7 @@ -- -- -- === Example usage+-- ==== Values -- -- >>> data Fruit = Apple | Orange deriving (Show, Eq, Bounded, Enum) -- >>> let c = parseAlternative shownBoundedEnumCodec (stringConstCodec [(Apple, "foo"), (Orange, "bar")])@@ -1582,6 +1585,46 @@ -- Just Apple -- >>> JSON.parseMaybe (parseJSONVia c) (String "Apple") :: Maybe Fruit -- Just Apple+--+-- ==== Required object fields+--+-- >>> data Fruit = Apple | Orange deriving (Show, Eq, Bounded, Enum)+-- >>> let c = shownBoundedEnumCodec+-- >>> let o = parseAlternative (requiredFieldWith "current" c "current key for this field") (requiredFieldWith "legacy" c "legacy key for this field")+-- >>> toJSONObjectVia o Apple+-- fromList [("current",String "Apple")]+-- >>> JSON.parseMaybe (parseJSONObjectVia o) (KM.fromList [("current",String "Apple")]) :: Maybe Fruit+-- Just Apple+-- >>> JSON.parseMaybe (parseJSONObjectVia o) (KM.fromList [("legacy",String "Apple")]) :: Maybe Fruit+-- Just Apple+-- >>> JSON.parseMaybe (parseJSONObjectVia o) (KM.fromList [("current",String "Tomato")]) :: Maybe Fruit+-- Nothing+--+-- ==== Required object fields+--+-- While 'parseAlternative' works exactly like you would expect it would with 'requiredField', using 'parseAlterternative' with optional fields has some pitfalls.+--+-- >>> data Fruit = Apple | Orange deriving (Show, Eq, Bounded, Enum)+-- >>> let c = shownBoundedEnumCodec+-- >>> let o = parseAlternative (optionalFieldWith "current" c "current key for this field") (optionalFieldWith "legacy" c "legacy key for this field")+-- >>> toJSONObjectVia o (Just Apple)+-- fromList [("current",String "Apple")]+-- >>> toJSONObjectVia o Nothing+-- fromList []+-- >>> JSON.parseMaybe (parseJSONObjectVia o) (KM.fromList [("current",String "Apple")]) :: Maybe (Maybe Fruit)+-- Just (Just Apple)+--+--+-- ! This is the important result !+-- The second 'optionalFieldWith' is not tried because the first one _succeeds_ in parsing 'Nothing'+--+-- >>> JSON.parseMaybe (parseJSONObjectVia o) (KM.fromList [("legacy",String "Apple")]) :: Maybe (Maybe Fruit)+-- Just Nothing+--+-- Here the parser succeeds as well, because it fails to parse the @current@ field, so it tries to parse the @legacy@ field, which is missing.+--+-- >>> JSON.parseMaybe (parseJSONObjectVia o) (KM.fromList [("current",String "Tomato")]) :: Maybe (Maybe Fruit)+-- Just Nothing parseAlternative ::   -- | Main codec, for parsing and rendering   Codec context input output ->