composite-aeson 0.7.5.0 → 0.8.0.0

raw patch · 5 files changed

+103/−41 lines, 5 filesdep ~aesondep ~basedep ~composite-basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson, base, composite-base, generic-deriving, lens, profunctors, template-haskell, time, vinyl

API changes (from Hackage documentation)

Files

• composite-aeson.cabal +65/−23
• src/Composite/Aeson/Formats/Default.hs +0/−1
• src/Composite/Aeson/Formats/Generic.hs +19/−12
• src/Composite/Aeson/Formats/InternalTH.hs +16/−3
• src/Composite/Aeson/Record.hs +3/−2

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.3.+-- This file has been generated from package.yaml by hpack version 0.34.5. -- -- see: https://github.com/sol/hpack ----- hash: 684ff7558a2f16e5bba77f441093b403df9653bd523915ff4733380484d28c1d+-- hash: 15940f55e4ff012339686c8d68ef398a5eb7acbcd09b10646b4b1f92cf09604f  name:           composite-aeson-version:        0.7.5.0+version:        0.8.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@@ -36,29 +36,50 @@       Paths_composite_aeson   hs-source-dirs:       src-  default-extensions: DataKinds FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses MultiWayIf OverloadedStrings PatternSynonyms PolyKinds QuasiQuotes RankNTypes ScopedTypeVariables StandaloneDeriving StrictData TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators ViewPatterns+  default-extensions:+      DataKinds+      FlexibleContexts+      FlexibleInstances+      GeneralizedNewtypeDeriving+      LambdaCase+      MultiParamTypeClasses+      MultiWayIf+      OverloadedStrings+      PatternSynonyms+      PolyKinds+      QuasiQuotes+      RankNTypes+      ScopedTypeVariables+      StandaloneDeriving+      StrictData+      TemplateHaskell+      TupleSections+      TypeApplications+      TypeFamilies+      TypeOperators+      ViewPatterns   ghc-options: -Wall -O2   build-depends:-      aeson >=1.1.2.0 && <1.6+      aeson >=1.1.2.0 && <2.1     , aeson-better-errors >=0.9.1.0 && <0.10-    , base >=4.7 && <5-    , composite-base >=0.7 && <0.8+    , base >=4.12 && <5+    , composite-base ==0.8.*     , containers >=0.5.7.0 && <0.7     , contravariant >=1.4 && <1.6-    , generic-deriving >=1.11.2 && <1.14+    , generic-deriving >=1.11.2 && <1.15     , hashable >=1.2.6.1 && <1.4-    , lens >=4.15.4 && <5.1+    , lens >=4.15.4 && <5.2     , mmorph >=1.0.9 && <1.2     , mtl >=2.2.1 && <2.3-    , profunctors >=5.2.1 && <5.6+    , profunctors >=5.2.1 && <5.7     , scientific >=0.3.5.1 && <0.4     , tagged >=0.8.5 && <0.9-    , template-haskell >=2.11.1.0 && <2.17+    , template-haskell >=2.11.1.0 && <2.19     , text >=1.2.2.2 && <1.3-    , time >=1.6.0.1 && <1.10+    , time >=1.6.0.1 && <1.12     , unordered-containers >=0.2.8.0 && <0.3     , vector >=0.12.0.1 && <0.13-    , vinyl >=0.5.3 && <0.14+    , vinyl >=0.5.3 && <0.15   default-language: Haskell2010  test-suite composite-aeson-test@@ -74,31 +95,52 @@       Paths_composite_aeson   hs-source-dirs:       test-  default-extensions: DataKinds FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses MultiWayIf OverloadedStrings PatternSynonyms PolyKinds QuasiQuotes RankNTypes ScopedTypeVariables StandaloneDeriving StrictData TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators ViewPatterns+  default-extensions:+      DataKinds+      FlexibleContexts+      FlexibleInstances+      GeneralizedNewtypeDeriving+      LambdaCase+      MultiParamTypeClasses+      MultiWayIf+      OverloadedStrings+      PatternSynonyms+      PolyKinds+      QuasiQuotes+      RankNTypes+      ScopedTypeVariables+      StandaloneDeriving+      StrictData+      TemplateHaskell+      TupleSections+      TypeApplications+      TypeFamilies+      TypeOperators+      ViewPatterns   ghc-options: -Wall -O2 -threaded -rtsopts -with-rtsopts=-N -fno-warn-orphans   build-depends:       QuickCheck-    , aeson >=1.1.2.0 && <1.6+    , aeson >=1.1.2.0 && <2.1     , aeson-better-errors >=0.9.1.0 && <0.10     , aeson-qq-    , base >=4.7 && <5+    , base >=4.12 && <5     , composite-aeson-    , composite-base >=0.7 && <0.8+    , composite-base ==0.8.*     , containers >=0.5.7.0 && <0.7     , contravariant >=1.4 && <1.6-    , generic-deriving >=1.11.2 && <1.14+    , generic-deriving >=1.11.2 && <1.15     , hashable >=1.2.6.1 && <1.4     , hspec-    , lens >=4.15.4 && <5.1+    , lens >=4.15.4 && <5.2     , mmorph >=1.0.9 && <1.2     , mtl >=2.2.1 && <2.3-    , profunctors >=5.2.1 && <5.6+    , profunctors >=5.2.1 && <5.7     , scientific >=0.3.5.1 && <0.4     , tagged >=0.8.5 && <0.9-    , template-haskell >=2.11.1.0 && <2.17+    , template-haskell >=2.11.1.0 && <2.19     , text >=1.2.2.2 && <1.3-    , time >=1.6.0.1 && <1.10+    , time >=1.6.0.1 && <1.12     , unordered-containers >=0.2.8.0 && <0.3     , vector >=0.12.0.1 && <0.13-    , vinyl >=0.5.3 && <0.14+    , vinyl >=0.5.3 && <0.15   default-language: Haskell2010

@@ -53,7 +53,6 @@ instance DefaultJsonFormat a => DefaultJsonFormat (Semigroup.First a)         where defaultJsonFormat = wrappedJsonFormat defaultJsonFormat instance DefaultJsonFormat a => DefaultJsonFormat (Semigroup.Last a)          where defaultJsonFormat = wrappedJsonFormat defaultJsonFormat instance DefaultJsonFormat a => DefaultJsonFormat (Semigroup.WrappedMonoid a) where defaultJsonFormat = wrappedJsonFormat defaultJsonFormat-instance DefaultJsonFormat a => DefaultJsonFormat (Semigroup.Option a)        where defaultJsonFormat = wrappedJsonFormat defaultJsonFormat instance DefaultJsonFormat a => DefaultJsonFormat (Monoid.Dual a)             where defaultJsonFormat = wrappedJsonFormat defaultJsonFormat instance DefaultJsonFormat a => DefaultJsonFormat (Monoid.Sum a)              where defaultJsonFormat = wrappedJsonFormat defaultJsonFormat instance DefaultJsonFormat a => DefaultJsonFormat (Monoid.Product a)          where defaultJsonFormat = wrappedJsonFormat defaultJsonFormat

@@ -5,13 +5,14 @@   ) where  import Composite.Aeson.Base (JsonFormat(JsonFormat), JsonProfunctor(JsonProfunctor), FromJson(FromJson))-import Control.Arrow (second)+import Control.Arrow (first, second) import Control.Lens (_Wrapped, over, unsnoc) import Control.Monad.Error.Class (throwError) import Data.Aeson (FromJSON, ToJSON, (.=), toJSON) import qualified Data.Aeson as Aeson import qualified Data.Aeson.BetterErrors as ABE-import qualified Data.HashMap.Strict as StrictHashMap+import qualified Data.Aeson.Key as Aeson.Key+import qualified Data.Aeson.KeyMap as Aeson.KeyMap import Data.List.NonEmpty (NonEmpty((:|))) import qualified Data.List.NonEmpty as NEL import Data.Text (Text, intercalate, unpack)@@ -21,6 +22,9 @@ #if MIN_VERSION_template_haskell(2,16,0)   , liftTyped, TExp(TExp) #endif+#if MIN_VERSION_template_haskell(2,17,0)+  , liftCode+#endif   )  -- |Produce an explicit 'JsonFormat' by using the implicit Aeson 'ToJSON' instance and an explicit @aeson-better-errors@ 'ABE.Parse'.@@ -45,7 +49,7 @@ jsonObjectFormat :: (t -> [(Text, a)]) -> ([(Text, a)] -> ABE.Parse e t) -> JsonFormat e a -> JsonFormat e t jsonObjectFormat oToList iFromList =   over _Wrapped $ \ (JsonProfunctor o i) ->-    JsonProfunctor (Aeson.Object . StrictHashMap.fromList . map (second o) . oToList)+    JsonProfunctor (Aeson.Object . Aeson.KeyMap.fromList . map (first Aeson.Key.fromText . second o) . oToList)                    (ABE.eachInObject i >>= iFromList)  @@ -153,7 +157,9 @@     SumStyleFieldName     -> [| SumStyleFieldName |]     SumStyleTypeValue a b -> [| SumStyleTypeValue $(liftString $ unpack a) $(liftString $ unpack b) |]     SumStyleMergeType a   -> [| SumStyleMergeType $(liftString $ unpack a) |]-#if MIN_VERSION_template_haskell(2,16,0)+#if MIN_VERSION_template_haskell(2,17,0)+  liftTyped = liftCode . fmap TExp . lift+#elif MIN_VERSION_template_haskell(2,16,0)   liftTyped = fmap TExp . lift #endif @@ -186,12 +192,13 @@ -- |Map a sum type from JSON in the 'SumStyleFieldName' style. fieldNameSumFromJson :: NonEmpty (Text, FromJson e a) -> ABE.Parse e a fieldNameSumFromJson iAs = do-  fields <- ABE.withObject $ pure . StrictHashMap.keys+  fields <- ABE.withObject $ pure . Aeson.KeyMap.keys   case fields of     [f] ->-      case lookup f (NEL.toList iAs) of-        Just (FromJson iA) -> ABE.key f iA-        Nothing -> throwError $ ABE.InvalidJSON $ "unknown field " <> unpack f <> ", expected one of " <> expected+      let ft = Aeson.Key.toText f+      in case lookup ft (NEL.toList iAs) of+        Just (FromJson iA) -> ABE.key ft iA+        Nothing -> throwError $ ABE.InvalidJSON $ "unknown field " <> unpack ft <> ", expected one of " <> expected     [] ->       throwError $ ABE.InvalidJSON $ "expected an object with one field (" <> expected <> ") not an empty object"     _ ->@@ -201,7 +208,7 @@  -- |Map a sum type to JSON in the 'SumStyleFieldName' style. fieldNameSumToJson :: (a -> (Text, Aeson.Value)) -> a -> Aeson.Value-fieldNameSumToJson oA = \ (oA -> (t, v)) -> Aeson.object [t .= v]+fieldNameSumToJson oA = \ (oA -> (t, v)) -> Aeson.object [Aeson.Key.fromText t .= v]  -- |Map a sum type from JSON in the 'SumStyleTypeValue' style. typeValueSumFromJson :: Text -> Text -> NonEmpty (Text, FromJson e a) -> ABE.Parse e a@@ -216,7 +223,7 @@  -- |Map a sum type to JSON in the 'SumStyleTypeValue' style. typeValueSumToJson :: Text -> Text -> (a -> (Text, Aeson.Value)) -> a -> Aeson.Value-typeValueSumToJson typeField valueField oA = \ (oA -> (t, v)) -> Aeson.object [typeField .= t, valueField .= v]+typeValueSumToJson typeField valueField oA = \ (oA -> (t, v)) -> Aeson.object [Aeson.Key.fromText typeField .= t, Aeson.Key.fromText valueField .= v]  -- |Map a sum type from JSON in the 'SumStyleMergeType' style. mergeTypeSumFromJson :: Text -> NonEmpty (Text, FromJson e a) -> ABE.Parse e a@@ -232,11 +239,11 @@ -- |Map a sum type to JSON in the 'SumStyleMergeType' style. mergeTypeSumToJson :: Text -> (a -> (Text, Aeson.Value)) -> a -> Aeson.Value mergeTypeSumToJson typeField oA = \ a -> case oA a of-  (t, Aeson.Object fields) | StrictHashMap.member typeField fields ->+  (t, Aeson.Object fields) | Aeson.KeyMap.member (Aeson.Key.fromText typeField) fields ->     error $ "PRECONDITION VIOLATED: encoding a value with merge type sum style yielded "          <> "(" <> unpack t <> ", " <> show (Aeson.Object fields) <> ") which already contains the field " <> unpack typeField   (t, Aeson.Object fields) ->-    Aeson.Object (StrictHashMap.insert typeField (Aeson.String t) fields)+    Aeson.Object (Aeson.KeyMap.insert (Aeson.Key.fromText typeField) (Aeson.String t) fields)   (t, other) ->     error $ "PRECONDITION VIOLATED: encoding a value with merge type sum style yielded "          <> "(" <> unpack t <> ", " <> show other <> ") which isn't an object"

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} module Composite.Aeson.Formats.InternalTH   ( makeTupleDefaults, makeTupleFormats, makeNamedTupleFormats   ) where@@ -5,8 +6,9 @@ import Composite.Aeson.Base (JsonFormat(JsonFormat), JsonProfunctor(JsonProfunctor)) import Control.Monad.Except (throwError) import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Key as Aeson.Key+import qualified Data.Aeson.KeyMap as Aeson.KeyMap import qualified Data.Aeson.BetterErrors as ABE-import qualified Data.HashMap.Lazy as HM import Data.List (foldl') import Data.Text (Text) import qualified Data.Vector as V@@ -20,6 +22,9 @@   , bindS, noBindS   , Type(AppT, ArrowT, ConT, ForallT, TupleT, VarT), appT, conT, varT   , TyVarBndr(PlainTV)+#if MIN_VERSION_template_haskell(2,17,0)+  , Specificity(SpecifiedSpec)+#endif   ) import Language.Haskell.TH.Syntax (lift) @@ -64,7 +69,11 @@           tupleType = foldl' AppT (TupleT arity) (map VarT tyNames)           funType =             ForallT+#if MIN_VERSION_template_haskell(2,17,0)+              (PlainTV tyErrName SpecifiedSpec : map (flip PlainTV SpecifiedSpec) tyNames)+#else               (PlainTV tyErrName : map PlainTV tyNames)+#endif               []               (foldr (\ tyName rest -> ArrowT `AppT` (ConT ''JsonFormat `AppT` VarT tyErrName `AppT` tyName) `AppT` rest)                      (ConT ''JsonFormat `AppT` VarT tyErrName `AppT` tupleType)@@ -116,7 +125,11 @@           tupleType = foldl' AppT (TupleT arity) (map VarT tyNames)           funType =             ForallT+#if MIN_VERSION_template_haskell(2,17,0)+              (PlainTV tyErrName SpecifiedSpec : map (flip PlainTV SpecifiedSpec) tyNames)+#else               (PlainTV tyErrName : map PlainTV tyNames)+#endif               []               (foldr (\ tyName rest -> ArrowT `AppT` ConT ''Text `AppT` (ArrowT `AppT` (ConT ''JsonFormat `AppT` VarT tyErrName `AppT` tyName) `AppT` rest))                      (ConT ''JsonFormat `AppT` VarT tyErrName `AppT` tupleType)@@ -124,8 +137,8 @@           oTupImpl =             lamE               [conP (tupleDataName arity) (map varP valNames)]-              [| (Aeson.Object . HM.fromList)-                 $(listE $ map (\ (fName, varName, oName) -> [| ($(varE fName), $(varE oName) $(varE varName)) |])+              [| (Aeson.Object . Aeson.KeyMap.fromList)+                 $(listE $ map (\ (fName, varName, oName) -> [| (Aeson.Key.fromText $(varE fName), $(varE oName) $(varE varName)) |])                                (zip3 fNames valNames oNames)) |]           iTupImpl =             doE

@@ -20,9 +20,10 @@ import Control.Monad (join) import qualified Data.Aeson as Aeson import qualified Data.Aeson.BetterErrors as ABE+import qualified Data.Aeson.Key as Aeson.Key+import qualified Data.Aeson.KeyMap as Aeson.KeyMap import Data.Functor.Contravariant (Contravariant, contramap) import Data.Functor.Identity (Identity(Identity))-import qualified Data.HashMap.Strict as HM import Data.Proxy (Proxy(Proxy)) import Data.Text (Text, pack) import Data.Vinyl (RApply, RMap, Rec((:&), RNil), rmap, rzipWith)@@ -185,7 +186,7 @@  instance forall s a rs. (KnownSymbol s, RecordToJsonObject rs) => RecordToJsonObject (s :-> a ': rs) where   recordToJsonObject (ToJsonField aToField :& fs) (Identity a :& as) =-    maybe id (HM.insert (pack . symbolVal $ (Proxy :: Proxy s))) (aToField a) $+    maybe id (Aeson.KeyMap.insert (Aeson.Key.fromString . 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@