composite-aeson 0.6.2.0 → 0.7.0.0

raw patch · 2 files changed

+93/−27 lines, 2 filesdep ~composite-basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: composite-base

API changes (from Hackage documentation)

Files

• composite-aeson.cabal +9/−9
• src/Composite/Aeson/Record.hs +84/−18

@@ -4,17 +4,17 @@ -- -- see: https://github.com/sol/hpack ----- hash: 558192f05fee7b3d7b5d3e22fa0ba2518c6856933614ac66c4fc31325d45a1ed+-- hash: 063cebc00b21d00793a2b94c8665f3dab675e7035434cce92187f5d8b06b25dc  name:           composite-aeson-version:        0.6.2.0-synopsis:       JSON for Vinyl/Frames records-description:    Integration between Aeson and Vinyl/Frames records allowing records to be easily converted to JSON using automatic derivation, explicit formats, or a mix of both.+version:        0.7.0.0+synopsis:       JSON for Vinyl records+description:    Integration between Aeson and Vinyl records allowing records to be easily converted to JSON using automatic derivation, explicit formats, or a mix of both. category:       Records-homepage:       https://github.com/ConferHealth/composite#readme+homepage:       https://github.com/ConferOpenSource/composite#readme author:         Confer Health, Inc-maintainer:     oss@confer.health-copyright:      2017 Confer Health, Inc.+maintainer:     oss@vitalbio.com+copyright:      2017 Confer Health, Inc., 2020 Vital Biosciences license:        BSD3 build-type:     Simple @@ -42,7 +42,7 @@       aeson >=1.1.2.0 && <1.5     , aeson-better-errors >=0.9.1.0 && <0.10     , base >=4.7 && <5-    , composite-base >=0.5.3.0 && <0.7+    , composite-base >=0.7 && <0.8     , containers >=0.5.7.0 && <0.7     , contravariant >=1.4 && <1.6     , generic-deriving >=1.11.2 && <1.13@@ -83,7 +83,7 @@     , aeson-qq     , base >=4.7 && <5     , composite-aeson-    , composite-base >=0.5.3.0 && <0.7+    , composite-base >=0.7 && <0.8     , containers >=0.5.7.0 && <0.7     , contravariant >=1.4 && <1.6     , generic-deriving >=1.11.2 && <1.13

@@ -1,6 +1,9 @@ module Composite.Aeson.Record-  ( ToField(..), FromField(..), JsonField(..), field, field', optionalField, optionalField'-  , JsonFormatRecord, DefaultJsonFormatRecord, defaultJsonFormatRecord+  ( ToJsonField(..), FromJsonField(..), JsonField(..)+  , field, field', fromField, fromField', toField, toField'+  , optionalField, optionalField', fromOptionalField, fromOptionalField', toOptionalField, toOptionalField'+  , JsonFormatRecord, ToJsonFormatRecord, FromJsonFormatRecord, zipJsonFormatRecord, toJsonFormatRecord, fromJsonFormatRecord+  , DefaultJsonFormatRecord, defaultJsonFormatRecord   , RecordToJsonObject, recordToJsonObject, recordToJson   , RecordFromJson, recordFromJson   , recordJsonFormat@@ -13,7 +16,7 @@   ) import Composite.Aeson.Formats.Default (DefaultJsonFormat(defaultJsonFormat)) import Composite.Record ((:->))-import Control.Lens (Wrapped(type Unwrapped, _Wrapped'), from, view)+import Control.Lens (Wrapped(type Unwrapped, _Wrapped'), from, review, view) import Control.Monad (join) import qualified Data.Aeson as Aeson import qualified Data.Aeson.BetterErrors as ABE@@ -22,20 +25,20 @@ import qualified Data.HashMap.Strict as HM import Data.Proxy (Proxy(Proxy)) import Data.Text (Text, pack)-import Data.Vinyl (RMap, Rec((:&), RNil), rmap)+import Data.Vinyl (RApply, RMap, Rec((:&), RNil), rmap, rzipWith) import GHC.TypeLits (KnownSymbol, symbolVal)  -- |Function to encode a single field of a record, possibly choosing to elide the field with @Nothing@.-newtype ToField a = ToField { unToField :: a -> Maybe Aeson.Value }+newtype ToJsonField a = ToJsonField { unToJsonField :: a -> Maybe Aeson.Value } -instance Contravariant ToField where-  contramap f (ToField g) = ToField (g . f)+instance Contravariant ToJsonField where+  contramap f (ToJsonField g) = ToJsonField (g . f)  -- |Function to decode a single field of a record.-newtype FromField e a = FromField { unFromField :: Text -> ABE.Parse e a }+newtype FromJsonField e a = FromJsonField { unFromJsonField :: Text -> ABE.Parse e a } -instance Functor (FromField e) where-  fmap f (FromField g) = FromField (fmap f . g)+instance Functor (FromJsonField e) where+  fmap f (FromJsonField g) = FromJsonField (fmap f . g)  -- |Descriptor of how to handle a single record field with functions to parse and emit the field which can handle missing fields on parse and elide fields on -- encode.@@ -49,6 +52,22 @@ field' :: JsonFormat e a -> JsonField e a field' (JsonFormat (JsonProfunctor o i)) = JsonField (Just . o) (`ABE.key` i) +-- |Given a parser for @'Unwrapped' a@, produce a @'FromField' e a@.+fromField :: Wrapped a => ABE.Parse e (Unwrapped a) -> FromJsonField e a+fromField = FromJsonField . flip ABE.key . fmap (review _Wrapped')++-- |Given a parser for @a@, produce a @'FromField' e a@.+fromField' :: ABE.Parse e a -> FromJsonField e a+fromField' = FromJsonField . flip ABE.key++-- |Given a parser for @'Unwrapped' a@, produce a @'FromField' e a@.+toField :: (Wrapped a', Unwrapped a' ~ a) => (a -> Aeson.Value) -> ToJsonField a'+toField o = ToJsonField $ Just . o . view _Wrapped'++-- |Given a parser for @a@, produce a @'ToField' a@.+toField' :: (a -> Aeson.Value) -> ToJsonField a+toField' = ToJsonField . fmap Just+ -- |Given a 'JsonFormat' for some type @a@, produce a 'JsonField' for fields of type @Maybe a@ which substitutes @Nothing@ for either @null@ or missing field, -- and which elides the field on @Nothing@. optionalField :: (Wrapped a', Unwrapped a' ~ Maybe a) => JsonFormat e a -> JsonField e a'@@ -65,8 +84,29 @@     (fmap o)     (\ k -> join <$> ABE.keyMay k (ABE.perhaps i)) --- |Type of a Vinyl/Frames record which describes how to map fields of a record to JSON and back.+-- |Given a parser for @a@, produce a @'FromField' e b@ where @b@ is a 'Wrapped' around @Maybe a@.+fromOptionalField :: (Wrapped a', Unwrapped a' ~ Maybe a) => ABE.Parse e a -> FromJsonField e a'+fromOptionalField i = FromJsonField f+  where+    f k = view (from _Wrapped') . join <$> ABE.keyMay k (ABE.perhaps i)++-- |Given a parser for @a@, produce a @'FromField' e (Maybe a)@ which represents an optional field.+fromOptionalField' :: ABE.Parse e a -> FromJsonField e (Maybe a)+fromOptionalField' i = FromJsonField f+  where+    f k = join <$> ABE.keyMay k (ABE.perhaps i)++-- |Given an encoding function for some type @a@, produce a 'ToField' for fields of type @Maybe a@ which elides the field on @Nothing@.+toOptionalField :: (Wrapped a', Unwrapped a' ~ Maybe a) => (a -> Aeson.Value) -> ToJsonField a'+toOptionalField o = ToJsonField (fmap o . view _Wrapped')++-- |Given an encoding function for some type @a@, produce a 'ToField' for fields of type @Maybe a@ which elides the field on @Nothing@.+toOptionalField' :: (a -> Aeson.Value) -> ToJsonField (Maybe a)+toOptionalField' o = ToJsonField (fmap o)++-- |Type of a Vinyl record which describes how to map fields of a record to JSON and back. --+-- -- This record type has the same field names and types as a regular record with 'Identity' but instead of 'Identity' uses 'JsonFormat e'. -- -- For example, given:@@ -108,34 +148,60 @@ -- Once you've produced an appropriate 'JsonFormatRecord' for your case, use 'recordJsonFormat' to make a @'JsonFormat' e (Record '[…])@ of it. type JsonFormatRecord e rs = Rec (JsonField e) rs +-- |Zip up a matching 'FromJsonFormatRecord' and 'ToJsonFormatRecord' into a 'JsonFormatRecord'.+--+-- Reverse operation of 'fromJsonFormatRecord' and 'toJsonFormatRecord'.+zipJsonFormatRecord :: (RMap rs, RApply rs) => ToJsonFormatRecord rs -> FromJsonFormatRecord e rs -> JsonFormatRecord e rs+zipJsonFormatRecord = rzipWith (\ (ToJsonField o) (FromJsonField i) -> JsonField o i)++-- |Type of a Vinyl record which describes how to map fields of a record from a JSON object.+--+-- 'fromJsonFrmaOnce you've produced an appropriate 'FromJsonFormatRecord' for your case, use recordFromJson' to make a @'FromJson' e (Record '[…])@ of it.+type FromJsonFormatRecord e rs = Rec (FromJsonField e) rs++-- |Given a @'JsonFormatRecord' rs@ which describes how to encode or decode a record, produce a @'FromJsonFormatRecord' rs@ which describes+-- only how to decode the record.+fromJsonFormatRecord :: RMap rs => JsonFormatRecord e rs -> FromJsonFormatRecord e rs+fromJsonFormatRecord = rmap (\ (JsonField _ i) -> FromJsonField i)++-- |Type of a Vinyl record which describes how to map fields of a record from a JSON object.+--+-- Once you've produced an appropriate 'ToJsonFormatRecord' for your case, use recordToJson' to make a @'ToJson' (Record '[…])@ of it.+type ToJsonFormatRecord rs = Rec ToJsonField rs++-- |Given a @'Rec' ('JsonField' e) rs@ which describes how to encode or decode a record, produce a @'Rec' 'ToField' rs@ which describes+-- only how to encode the record.+toJsonFormatRecord :: RMap rs => JsonFormatRecord e rs -> ToJsonFormatRecord rs+toJsonFormatRecord = rmap (\ (JsonField o _) -> ToJsonField o)+ -- |Helper class which induces over the structure of a record, reflecting the name of each field and applying each 'ToJson' to its corresponding value to -- produce JSON. class RecordToJsonObject rs where   -- |Given a record of 'ToField' functions for each field in @rs@, convert an 'Identity' record to 'Aeson.Object'.-  recordToJsonObject :: Rec ToField rs -> Rec Identity rs -> Aeson.Object+  recordToJsonObject :: Rec ToJsonField rs -> Rec Identity rs -> Aeson.Object  instance RecordToJsonObject '[] where   recordToJsonObject _ = const mempty  instance forall s a rs. (KnownSymbol s, RecordToJsonObject rs) => RecordToJsonObject (s :-> a ': rs) where-  recordToJsonObject (ToField aToField :& fs) (Identity a :& as) =+  recordToJsonObject (ToJsonField aToField :& fs) (Identity a :& as) =     maybe id (HM.insert (pack . symbolVal $ (Proxy :: Proxy s))) (aToField a) $       recordToJsonObject fs as  -- |Given a record of 'ToField' functions for each field in @rs@, convert an 'Identity' record to JSON. Equivalent to @Aeson.Object . 'recordToJsonObject' fmt@-recordToJson :: RecordToJsonObject rs => Rec ToField rs -> Rec Identity rs -> Aeson.Value+recordToJson :: RecordToJsonObject rs => Rec ToJsonField rs -> Rec Identity rs -> Aeson.Value recordToJson = fmap Aeson.Object . recordToJsonObject  -- |Class which induces over the structure of a record, parsing fields using a record of 'FromJson' and assembling an 'Identity' record. class RecordFromJson rs where   -- |Given a record of 'FromJson' parsers for each field in @rs@, produce an 'ABE.Parse' to make an 'Identity' record.-  recordFromJson :: Rec (FromField e) rs -> ABE.Parse e (Rec Identity rs)+  recordFromJson :: Rec (FromJsonField e) rs -> ABE.Parse e (Rec Identity rs)  instance RecordFromJson '[] where   recordFromJson _ = pure RNil  instance forall s a rs. (KnownSymbol s, RecordFromJson rs) => RecordFromJson (s :-> a ': rs) where-  recordFromJson (FromField aFromField :& fs) =+  recordFromJson (FromJsonField aFromField :& fs) =     (:&)       <$> (Identity <$> aFromField (pack . symbolVal $ (Proxy :: Proxy s)))       <*> recordFromJson fs@@ -146,8 +212,8 @@ recordJsonFormat :: (RMap rs, RecordToJsonObject rs, RecordFromJson rs) => JsonFormatRecord e rs -> JsonFormat e (Rec Identity rs) recordJsonFormat formatRec =   JsonFormat $ JsonProfunctor-    (recordToJson   . rmap (\ (JsonField o _) -> ToField o  ) $ formatRec)-    (recordFromJson . rmap (\ (JsonField _ i) -> FromField i) $ formatRec)+    (recordToJson   . toJsonFormatRecord   $ formatRec)+    (recordFromJson . fromJsonFormatRecord $ formatRec)  -- |Class to make a 'JsonFormatRecord' with 'defaultJsonFormat' for each field. class DefaultJsonFormatRecord rs where