composite-aeson 0.4.2.0 → 0.5.0.0

raw patch · 9 files changed

+320/−69 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• composite-aeson.cabal +6/−2
• src/Composite/Aeson/Formats/Generic.hs +8/−0
• src/Composite/Aeson/Formats/Provided.hs +1/−1
• src/Composite/Aeson/Record.hs +49/−43
• src/Composite/Aeson/TH.hs +126/−17
• test/FieldSpec.hs +33/−0
• test/Main.hs +6/−3
• test/RecordSpec.hs +3/−3
• test/THSpec.hs +88/−0

@@ -1,9 +1,9 @@--- This file has been generated from package.yaml by hpack version 0.17.0.+-- This file has been generated from package.yaml by hpack version 0.18.1. -- -- see: https://github.com/sol/hpack  name:           composite-aeson-version:        0.4.2.0+version:        0.5.0.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. category:       Records@@ -55,6 +55,8 @@       Composite.Aeson.Formats.Provided       Composite.Aeson.Record       Composite.Aeson.TH+  other-modules:+      Paths_composite_aeson   default-language: Haskell2010  test-suite composite-aeson-test@@ -92,6 +94,8 @@     , hspec   other-modules:       EnumSpec+      FieldSpec       RecordSpec+      THSpec       TupleSpec   default-language: Haskell2010

@@ -16,6 +16,7 @@ import Data.Monoid ((<>)) import Data.Text (Text, intercalate, unpack) import qualified Data.Vector as Vector+import Language.Haskell.TH.Syntax (Lift, lift, liftString)  -- |Produce an explicit 'JsonFormat' by using the implicit Aeson 'ToJSON' instance and an explicit @aeson-better-errors@ 'ABE.Parse'. abeJsonFormat :: ToJSON a => ABE.Parse e a -> JsonFormat e a@@ -140,6 +141,13 @@   -- ^Map to a two-field object with fixed field names, the first being the type field and the second beind the value field.   | SumStyleMergeType Text   -- ^Given that each sum branch maps to a JSON object, add/parse an additional field to that object with the given name.+  deriving (Eq, Show)++instance Lift SumStyle where+  lift = \ case+    SumStyleFieldName     -> [| SumStyleFieldName |]+    SumStyleTypeValue a b -> [| SumStyleTypeValue $(liftString $ unpack a) $(liftString $ unpack b) |]+    SumStyleMergeType a   -> [| SumStyleMergeType $(liftString $ unpack a) |]  -- |Helper used by the various sum format functions which takes a list of input format pairs and makes an oxford comma list of them. expectedFieldsForInputs :: NonEmpty (Text, x) -> String

@@ -140,7 +140,7 @@ -- |'JsonFormat' for 'Scientific', mapping to a JSON number. -- -- __Warning:__ some JSON parsing libraries do not accept the scientific number notation even though it's part of the JSON standard, and this format--- uses 'Data.ByteString.Builder.Scientific.scientificBuilder' transitively which encodes very small (< 0.1) and large (> 9,999,999.0) fractional numbers+-- uses 'Data.ByteString.Builder.Scientific.scientificBuilder' transitively which encodes very small (\< 0.1) and large (> 9,999,999.0) fractional numbers -- using scientific notation. scientificJsonFormat :: JsonFormat e Scientific scientificJsonFormat = abeJsonFormat ABE.asScientific

@@ -1,4 +1,10 @@-module Composite.Aeson.Record where+module Composite.Aeson.Record+  ( ToField(..), FromField(..), JsonField(..), field, field', optionalField, optionalField'+  , JsonFormatRecord, DefaultJsonFormatRecord, defaultJsonFormatRecord+  , RecordToJsonObject, recordToJsonObject, recordToJson+  , RecordFromJson, recordFromJson+  , recordJsonFormat+  ) where  import Composite.Aeson.Base   ( JsonProfunctor(JsonProfunctor)@@ -69,87 +75,87 @@ -- > type FName = "name" :-> Text -- > type User = '[FId, FName] ----- A 'JsonFormatRec' for @User@ might be:+-- A 'JsonFormatRecord' for @User@ might be: -- -- @---   userFormatRec :: 'JsonFormatRec' e User+--   userFormatRec :: 'JsonFormatRecord' e User --   userFormatRec = 'field' 'Composite.Aeson.Default.integralJsonFormat'---               :^: 'field' 'Composite.Aeson.Default.textJsonFormat'---               :^: RNil+--                :& 'field' 'Composite.Aeson.Default.textJsonFormat'+--                :& RNil -- @ -- -- Or, using the default mappings for each field type: -- -- @---   userFormatRec :: 'JsonFormatRec' e User---   userFormatRec = 'defaultJsonFormatRec'+--   userFormatRec :: 'JsonFormatRecord' e User+--   userFormatRec = 'defaultJsonFormatRecord' -- @ -- -- Such a record is a first-class value like any other record, so can be composed into larger records, modified, etc. This is particularly useful in--- combination with 'defaultJsonFormatRec', where you can automatically derive a format record for all fields you want defaults for and then extend or+-- combination with 'defaultJsonFormatRecord', where you can automatically derive a format record for all fields you want defaults for and then extend or -- override formats for particular fields, e.g. -- -- @ --   fId :: Proxy FId --   fId = Proxy -----   userFormatRec :: 'JsonFormatRec' e User---   userFormatRec = 'Control.Lens.over' ('Frames.rlens' fId) ('Composite.Aeson.Base.dimapJsonFormat (+10) (subtract 10)) 'defaultJsonFormatRec'+--   userFormatRec :: 'JsonFormatRecord' e User+--   userFormatRec = 'Control.Lens.over' ('Frames.rlens' fId) ('Composite.Aeson.Base.dimapJsonFormat (+10) (subtract 10)) 'defaultJsonFormatRecord' -- @ -- -- Would use the same JSON schema as the other examples, but the @id@ field would be encoded in JSON as 10 higher. ----- Once you've produced an appropriate 'JsonFormatRec' for your case, use 'recJsonFormat' to make a @'JsonFormat' e (Record '[…])@ of it.-type JsonFormatRec e rs = Rec (JsonField e) rs+-- 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  -- |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 RecToJsonObject rs where+class RecordToJsonObject rs where   -- |Given a record of 'ToField' functions for each field in @rs@, convert an 'Identity' record to 'Aeson.Object'.-  recToJsonObject :: Rec ToField rs -> Rec Identity rs -> Aeson.Object+  recordToJsonObject :: Rec ToField rs -> Rec Identity rs -> Aeson.Object -instance RecToJsonObject '[] where-  recToJsonObject _ = const mempty+instance RecordToJsonObject '[] where+  recordToJsonObject _ = const mempty -instance forall s a rs. (KnownSymbol s, RecToJsonObject rs) => RecToJsonObject (s :-> a ': rs) where-  recToJsonObject (ToField aToField :& fs) (Identity a :& as) =+instance forall s a rs. (KnownSymbol s, RecordToJsonObject rs) => RecordToJsonObject (s :-> a ': rs) where+  recordToJsonObject (ToField aToField :& fs) (Identity a :& as) =     maybe id (HM.insert (pack . symbolVal $ (Proxy :: Proxy s))) (aToField a) $-      recToJsonObject fs as+      recordToJsonObject fs as --- |Given a record of 'ToField' functions for each field in @rs@, convert an 'Identity' record to JSON. Equivalent to @Aeson.Object . 'recToJsonObject' fmt@-recToJson :: RecToJsonObject rs => Rec ToField rs -> Rec Identity rs -> Aeson.Value-recToJson = fmap Aeson.Object . recToJsonObject+-- |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 = 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 RecFromJson rs where+class RecordFromJson rs where   -- |Given a record of 'FromJson' parsers for each field in @rs@, produce an 'ABE.Parse' to make an 'Identity' record.-  recFromJson :: Rec (FromField e) rs -> ABE.Parse e (Rec Identity rs)+  recordFromJson :: Rec (FromField e) rs -> ABE.Parse e (Rec Identity rs) -instance RecFromJson '[] where-  recFromJson _ = pure RNil+instance RecordFromJson '[] where+  recordFromJson _ = pure RNil -instance forall s a rs. (KnownSymbol s, RecFromJson rs) => RecFromJson (s :-> a ': rs) where-  recFromJson (FromField aFromField :& fs) =+instance forall s a rs. (KnownSymbol s, RecordFromJson rs) => RecordFromJson (s :-> a ': rs) where+  recordFromJson (FromField aFromField :& fs) =     (:&)       <$> (Identity <$> aFromField (pack . symbolVal $ (Proxy :: Proxy s)))-      <*> recFromJson fs+      <*> recordFromJson fs --- |Take a 'JsonFormatRec' describing how to map a record with field @rs@ to and from JSON and produce a @'JsonFormat' e (Record rs)@.+-- |Take a 'JsonFormatRecord' describing how to map a record with field @rs@ to and from JSON and produce a @'JsonFormat' e (Record rs)@. ----- See 'JsonFormatRec' for more.-recJsonFormat :: (RecToJsonObject rs, RecFromJson rs) => JsonFormatRec e rs -> JsonFormat e (Rec Identity rs)-recJsonFormat formatRec =+-- See 'JsonFormatRecord' for more.+recordJsonFormat :: (RecordToJsonObject rs, RecordFromJson rs) => JsonFormatRecord e rs -> JsonFormat e (Rec Identity rs)+recordJsonFormat formatRec =   JsonFormat $ JsonProfunctor-    (recToJson   . rmap (\ (JsonField o _) -> ToField o  ) $ formatRec)-    (recFromJson . rmap (\ (JsonField _ i) -> FromField i) $ formatRec)+    (recordToJson   . rmap (\ (JsonField o _) -> ToField o  ) $ formatRec)+    (recordFromJson . rmap (\ (JsonField _ i) -> FromField i) $ formatRec) --- |Class to make a 'JsonFormatRec' with 'defaultJsonFormat' for each field.-class DefaultJsonFormatRec rs where-  -- |Produce a 'JsonFormatRec' for a record with fields @rs@ by using the default 'JsonFormat' for each field in @rs@, as provided by 'DefaultJsonFormat'.-  defaultJsonFormatRec :: JsonFormatRec e rs+-- |Class to make a 'JsonFormatRecord' with 'defaultJsonFormat' for each field.+class DefaultJsonFormatRecord rs where+  -- |Produce a 'JsonFormatRecord' for a record with fields @rs@ by using the default 'JsonFormat' for each field in @rs@, as provided by 'DefaultJsonFormat'.+  defaultJsonFormatRecord :: JsonFormatRecord e rs -instance (KnownSymbol s, DefaultJsonFormat a, DefaultJsonFormatRec rs) => DefaultJsonFormatRec (s :-> a ': rs) where-  defaultJsonFormatRec = field defaultJsonFormat :& defaultJsonFormatRec+instance (KnownSymbol s, DefaultJsonFormat a, DefaultJsonFormatRecord rs) => DefaultJsonFormatRecord (s :-> a ': rs) where+  defaultJsonFormatRecord = field defaultJsonFormat :& defaultJsonFormatRecord -instance DefaultJsonFormatRec '[] where-  defaultJsonFormatRec = RNil+instance DefaultJsonFormatRecord '[] where+  defaultJsonFormatRecord = RNil

@@ -1,10 +1,14 @@ module Composite.Aeson.TH-  ( makeRecJsonWrapper-  , makeRecJsonWrapperExplicit+  ( makeFieldJsonWrapper, makeFieldJsonWrapperExplicit+  , makeRecordJsonWrapper, makeRecordJsonWrapperExplicit   ) where  import Composite.Aeson.Base (JsonFormat, dimapJsonFormat, parseJsonWithFormat', toJsonWithFormat)-import Composite.Aeson.Record (defaultJsonFormatRec, recJsonFormat)+import Composite.Aeson.CoRecord (defaultJsonFormatField, fieldJsonFormat)+import Composite.Aeson.Formats.Default (DefaultJsonFormat, defaultJsonFormat)+import Composite.Aeson.Formats.Generic (SumStyle)+import Composite.Aeson.Record (defaultJsonFormatRecord, recordJsonFormat)+import Composite.CoRecord (Field) import Composite.Record (Record) import Control.Lens (_head, over) import Data.Aeson (FromJSON(parseJSON), ToJSON(toJSON))@@ -20,12 +24,108 @@   , varP   , conT   )+import Language.Haskell.TH.Syntax (lift) --- |TH splice which makes it more convenient to define ToJSON / FromJSON instances for record types.+-- |TH splice which makes it more convenient to define 'DefaultJsonFormat', 'ToJSON', and 'FromJSON' instances for 'Field' types. -- -- For example: -- -- @+--   type MyField = '[FFoo, FBar]+--   makeFieldJsonWrapper "MyFieldJson" ''MyField SumStyleFieldName+-- @+--+-- is equivalent to:+--+-- @+--   newtype MyFieldJson = MyFieldJson { unMyFieldJson :: Field MyField }+--   myFieldJsonFormat :: 'Composite.Aeson.CoRecord.JsonFormatField' Void MyFieldJson+--   myFieldJsonFormat =+--     'dimapJsonFormat' unMyFieldJson MyFieldJson $+--       'fieldJsonFormat' SumStyleFieldName defaultJsonFormatField+--   instance FromJSON MyFieldJson where+--     parseJSON = 'parseJsonWithFormat'' myFieldJsonFormat+--   instance ToJSON MyFieldJson where+--     toJSON = 'toJsonWithFormat' myFieldJsonFormat+-- @+--+-- This function uses 'defaultJsonFormatField' to derive the formatting for the field. If you want to customize that formatting, use+-- 'makeFieldJsonWrapperExplicit' instead.+makeFieldJsonWrapper :: String -> Name -> SumStyle -> Q [Dec]+makeFieldJsonWrapper wrapperName tyName sumStyle =+  makeFieldJsonWrapperExplicit wrapperName tyName sumStyle [| defaultJsonFormatField |]++-- |TH splice which makes it more convenient to define 'DefaultJsonFormat', 'ToJSON', and 'FromJSON' instances for 'Field' types.+--+-- For example:+--+-- @+--   type MyField = '[FFoo, FBar]+--   makeRecJsonWrapperExplicit "MyFieldJson" ''MyField [| set (rlens fFoo_) specialFormat defaultJsonFormatRecord |]+-- @+--+-- is equivalent to:+--+-- @+--   newtype MyFieldJson = MyFieldJson { unMyFieldJson :: Record MyField }+--   myRecordJsonFormat :: 'Composite.Aeson.Record.JsonFormatRecord' Void MyFieldJson+--   myRecordJsonFormat =+--     'dimapJsonFormat' unMyFieldJson MyFieldJson $+--       'recordJsonFormat' (set (rlens fFoo_) specialFormat defaultJsonFormatRecord)+--   instance FromJSON MyFieldJson where+--     parseJSON = 'parseJsonWithFormat'' myRecordJsonFormat+--   instance ToJSON MyFieldJson where+--     toJSON = 'toJsonWithFormat' myRecordJsonFormat+-- @+makeFieldJsonWrapperExplicit :: String -> Name -> SumStyle -> Q Exp -> Q [Dec]+makeFieldJsonWrapperExplicit wrapperNameStr fieldsTyName sumStyle fieldFormatExp = do+  let wrapperName = mkName wrapperNameStr+      extractorName = mkName $ "un" <> wrapperNameStr+      fieldTy = [t| Field $(conT fieldsTyName) |]+  formatName <- newName $ over _head toLower wrapperNameStr <> "Format"+  sequence+    [ newtypeD+        (cxt [])+        wrapperName+        [] -- TyVarBndrs+        Nothing -- kind+        (recC wrapperName [varBangType extractorName (bangType (bang noSourceUnpackedness noSourceStrictness) fieldTy)])+        (cxt []) -- deriving context+    , sigD+        formatName+        [t| forall e. JsonFormat e $(conT wrapperName) |]+    , valD+        (varP formatName)+        (normalB [| dimapJsonFormat $(varE extractorName) $(conE wrapperName) (fieldJsonFormat $(lift sumStyle) $fieldFormatExp) |])+        []+    , instanceD+        (cxt [])+        [t| DefaultJsonFormat $(conT wrapperName) |]+        [ funD+            'defaultJsonFormat+            [ clause [] (normalB $ varE formatName) [] ]+        ]+    , instanceD+        (cxt [])+        [t| FromJSON $(conT wrapperName) |]+        [ funD+            'parseJSON+            [ clause [] (normalB [| parseJsonWithFormat' $(varE formatName) |]) [] ]+        ]+    , instanceD+        (cxt [])+        [t| ToJSON $(conT wrapperName) |]+        [ funD+            'toJSON+            [ clause [] (normalB [| toJsonWithFormat $(varE formatName) |]) [] ]+        ]+    ]++-- |TH splice which makes it more convenient to define 'DefaultJsonFormat', 'ToJSON', and 'FromJSON' instances for 'Record' types.+--+-- For example:+--+-- @ --   type MyRecord = '[FFoo, FBar] --   makeRecJsonWrapper "MyRecordJson" ''MyRecord -- @@@ -34,46 +134,48 @@ -- -- @ --   newtype MyRecordJson = MyRecordJson { unMyRecordJson :: Record MyRecord }---   myRecordJsonFormat :: 'Composite.Aeson.Record.JsonFormatRec' Void MyRecordJson+--   myRecordJsonFormat :: 'Composite.Aeson.Record.JsonFormatRecord' Void MyRecordJson --   myRecordJsonFormat = --     'dimapJsonFormat' unMyRecordJson MyRecordJson $---       'recJsonFormat' defaultJsonFormatRec+--       'recordJsonFormat' defaultJsonFormatRecord --   instance FromJSON MyRecordJson where --     parseJSON = 'parseJsonWithFormat'' myRecordJsonFormat --   instance ToJSON MyRecordJson where --     toJSON = 'toJsonWithFormat' myRecordJsonFormat -- @ ----- This function uses 'defaultJsonFormatRec' to derive the formatting for the record. If you want to customize that formatting, use+-- This function uses 'defaultJsonFormatRecord' to derive the formatting for the record. If you want to customize that formatting, use -- 'makeRecJsonWrapperExplicit' instead.-makeRecJsonWrapper :: String -> Name -> Q [Dec]-makeRecJsonWrapper wrapperName tyName =-  makeRecJsonWrapperExplicit wrapperName tyName [| defaultJsonFormatRec |]+makeRecordJsonWrapper :: String -> Name -> Q [Dec]+makeRecordJsonWrapper wrapperName tyName =+  makeRecordJsonWrapperExplicit wrapperName tyName [| defaultJsonFormatRecord |] --- |TH splice which makes it more convenient to define ToJSON / FromJSON instances for record types.+-- |TH splice which makes it more convenient to define 'DefaultJsonFormat', 'ToJSON', and 'FromJSON' instances for 'Record' types. -- -- For example: -- -- @ --   type MyRecord = '[FFoo, FBar]---   makeRecJsonWrapperExplicit "MyRecordJson" ''MyRecord [| set (rlens fFoo_) specialFormat defaultJsonFormatRec |]+--   makeRecordJsonWrapperExplicit "MyRecordJson" ''MyRecord [| set (rlens fFoo_) specialFormat defaultJsonFormatRecord |] -- @ -- -- is equivalent to: -- -- @ --   newtype MyRecordJson = MyRecordJson { unMyRecordJson :: Record MyRecord }---   myRecordJsonFormat :: 'Composite.Aeson.Record.JsonFormatRec' Void MyRecordJson+--   myRecordJsonFormat :: 'Composite.Aeson.Record.JsonFormatRecord' Void MyRecordJson --   myRecordJsonFormat = --     'dimapJsonFormat' unMyRecordJson MyRecordJson $---       'recJsonFormat' (set (rlens fFoo_) specialFormat defaultJsonFormatRec)+--       'recordJsonFormat' (set (rlens fFoo_) specialFormat defaultJsonFormatRecord)+--   instance DefaultJsonFormat MyRecordJson where+--     defaultJsonFormat = myRecordJsonFormat --   instance FromJSON MyRecordJson where --     parseJSON = 'parseJsonWithFormat'' myRecordJsonFormat --   instance ToJSON MyRecordJson where --     toJSON = 'toJsonWithFormat' myRecordJsonFormat -- @-makeRecJsonWrapperExplicit :: String -> Name -> Q Exp -> Q [Dec]-makeRecJsonWrapperExplicit wrapperNameStr fieldsTyName recFormatExp = do+makeRecordJsonWrapperExplicit :: String -> Name -> Q Exp -> Q [Dec]+makeRecordJsonWrapperExplicit wrapperNameStr fieldsTyName recFormatExp = do   let wrapperName = mkName wrapperNameStr       extractorName = mkName $ "un" <> wrapperNameStr       recordTy = [t| Record $(conT fieldsTyName) |]@@ -91,8 +193,15 @@         [t| forall e. JsonFormat e $(conT wrapperName) |]     , valD         (varP formatName)-        (normalB [| dimapJsonFormat $(varE extractorName) $(conE wrapperName) (recJsonFormat $recFormatExp) |])+        (normalB [| dimapJsonFormat $(varE extractorName) $(conE wrapperName) (recordJsonFormat $recFormatExp) |])         []+    , instanceD+        (cxt [])+        [t| DefaultJsonFormat $(conT wrapperName) |]+        [ funD+            'defaultJsonFormat+            [ clause [] (normalB $ varE formatName) [] ]+        ]     , instanceD         (cxt [])         [t| FromJSON $(conT wrapperName) |]

@@ -0,0 +1,33 @@+module FieldSpec where++import Composite (Field, (:->))+import Composite.Aeson.Base (JsonFormat, fromJsonWithFormat, toJsonWithFormat)+import Composite.Aeson.CoRecord (defaultJsonFormatField, fieldJsonFormat, optionalField)+import Composite.Aeson.Formats.Generic (SumStyle(SumStyleFieldName))+import Composite.TH (withPrismsAndProxies)+import Control.Lens (_Right, review)+import Data.Aeson.BetterErrors (parseValue)+import Data.Aeson.QQ (aesonQQ)+import Data.Void (Void)+import Test.Hspec (Spec, describe, it, shouldBe, shouldNotBe)++withPrismsAndProxies [d|+  type FFoo = "foo" :-> Int+  type FBar = "bar" :-> Maybe String+  |]+type TestField = '["foo" :-> Int, "bar" :-> Maybe String]++fieldSuite :: Spec+fieldSuite =+  describe "Field support" $ do+    let defaultFmt :: JsonFormat Void (Field TestField)+        defaultFmt = fieldJsonFormat defaultJsonFormatField SumStyleFieldName++    it "works for encoding FFoo" $ do+      toJsonWithFormat defaultFmt (review _FFoo 123) `shouldBe` [aesonQQ| {foo: 123} |]+    it "works for encoding FBar" $ do+      toJsonWithFormat defaultFmt (review _FBar (Just "hi")) `shouldBe` [aesonQQ| {bar: "hi"} |]+    it "works for decoding FFoo" $ do+      parseValue (fromJsonWithFormat defaultFmt) [aesonQQ| {foo: 123} |] `shouldBe` review (_Right . _FFoo) 123+    it "works for decoding FBar" $ do+      parseValue (fromJsonWithFormat defaultFmt) [aesonQQ| {bar: "hi"} |] `shouldBe` review (_Right . _FBar) "hi"

@@ -1,10 +1,13 @@+import Test.Hspec (hspec)++import EnumSpec (enumSuite) import RecordSpec (recordSuite)+import THSpec (thSuite) import TupleSpec (tupleSuite)-import EnumSpec (enumSuite)-import Test.Hspec (hspec)  main :: IO () main = hspec $ do+  enumSuite   recordSuite+  thSuite   tupleSuite-  enumSuite

@@ -3,7 +3,7 @@ import Composite (Rec(RNil), Record, (:->), pattern (:*:)) import Composite.Aeson.Base (JsonFormat, fromJsonWithFormat, toJsonWithFormat) import Composite.Aeson.Formats.Provided (stringJsonFormat)-import Composite.Aeson.Record (defaultJsonFormatRec, recJsonFormat, optionalField)+import Composite.Aeson.Record (defaultJsonFormatRecord, recordJsonFormat, optionalField) import Composite.TH (withLensesAndProxies) import Control.Lens (set) import Data.Aeson.BetterErrors (parseValue)@@ -22,8 +22,8 @@ recordSuite =   describe "Record support" $ do     let defaultFmt, optionalFmt :: JsonFormat Void (Record TestRec)-        defaultFmt = recJsonFormat defaultJsonFormatRec-        optionalFmt = recJsonFormat $ set (rlens fBar_) (optionalField stringJsonFormat) defaultJsonFormatRec+        defaultFmt = recordJsonFormat defaultJsonFormatRecord+        optionalFmt = recordJsonFormat $ set (rlens fBar_) (optionalField stringJsonFormat) defaultJsonFormatRecord      it "by default requires all fields" $ do       parseValue (fromJsonWithFormat defaultFmt) [aesonQQ| {foo: 123, bar: "abc"} |] `shouldBe`    Right (123 :*: Just "abc" :*: RNil)

@@ -0,0 +1,88 @@+module THSpec where++import Composite.Aeson.Base (dimapJsonFormat, fromJsonWithFormat, toJsonWithFormat)+import Composite.Aeson.CoRecord (JsonFormatField)+import Composite.Aeson.Formats.Default (defaultJsonFormat)+import Composite.Aeson.Formats.Generic (SumStyle(SumStyleFieldName))+import Composite.Aeson.Formats.Provided (integralJsonFormat)+import Composite.Aeson.Record (JsonFormatRecord, field)+import Composite.Aeson.TH (makeFieldJsonWrapper, makeFieldJsonWrapperExplicit, makeRecordJsonWrapper, makeRecordJsonWrapperExplicit)+import Composite.Record ((:->), Rec((:&), RNil), pattern (:*:))+import Composite.TH (withOpticsAndProxies)+import Control.Lens (review)+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Types as Aeson+import qualified Data.Aeson.BetterErrors  as ABE+import Data.Aeson.QQ (aesonQQ)+import Data.Void (Void)+import Test.Hspec (Spec, describe, it, shouldBe)++withOpticsAndProxies [d|+  type FFoo = "foo" :-> Int+  |]++type Foo = '[FFoo]++explicitFooJsonFormatRecord :: JsonFormatRecord e Foo+explicitFooJsonFormatRecord+  =  field (dimapJsonFormat (+10) (subtract 10) integralJsonFormat)+  :& RNil++explicitFooJsonFormatField :: JsonFormatField e Foo+explicitFooJsonFormatField+  =  dimapJsonFormat (+10) (subtract 10) integralJsonFormat+  :& RNil++makeRecordJsonWrapper "FooRecordDefaultJson" ''Foo+makeRecordJsonWrapperExplicit "FooRecordExplicitJson" ''Foo [| explicitFooJsonFormatRecord |]+makeFieldJsonWrapper "FooFieldDefaultJson" ''Foo SumStyleFieldName+makeFieldJsonWrapperExplicit "FooFieldExplicitJson" ''Foo SumStyleFieldName [| explicitFooJsonFormatField |]++deriving instance Eq FooRecordDefaultJson+deriving instance Eq FooRecordExplicitJson+deriving instance Eq FooFieldDefaultJson+deriving instance Eq FooFieldExplicitJson++deriving instance Show FooRecordDefaultJson+deriving instance Show FooRecordExplicitJson+deriving instance Show FooFieldDefaultJson+deriving instance Show FooFieldExplicitJson++thSuite :: Spec+thSuite = do+  describe "Composite.Aeson.TH" $ do+    it "decodes via FromJSON using makeRecordJsonWrapper" $ do+      Aeson.parseEither Aeson.parseJSON [aesonQQ| {foo: 123} |] `shouldBe` Right (FooRecordDefaultJson $ 123 :*: RNil)+    it "encodes via ToJSON using makeRecordJsonWrapper" $ do+      Aeson.toJSON (FooRecordDefaultJson $ 123 :*: RNil) `shouldBe` [aesonQQ| {foo: 123} |]+    it "decodes via DefaultJsonFormat using makeRecordJsonWrapper" $ do+      ABE.parseValue @Void (fromJsonWithFormat defaultJsonFormat) [aesonQQ| {foo: 123} |] `shouldBe` Right (FooRecordDefaultJson $ 123 :*: RNil)+    it "encodes via DefaultJsonFormat using makeRecordJsonWrapper" $ do+      toJsonWithFormat defaultJsonFormat (FooRecordDefaultJson $ 123 :*: RNil) `shouldBe` [aesonQQ| {foo: 123} |]++    it "decodes via FromJSON using makeRecordJsonWrapperExplicit" $ do+      Aeson.parseEither Aeson.parseJSON [aesonQQ| {foo: 123} |] `shouldBe` Right (FooRecordExplicitJson $ 113 :*: RNil)+    it "encodes via ToJSON using makeRecordJsonWrapperExplicit" $ do+      Aeson.toJSON (FooRecordExplicitJson $ 113 :*: RNil) `shouldBe` [aesonQQ| {foo: 123} |]+    it "decodes via DefaultJsonFormat using makeRecordJsonWrapperExplicit" $ do+      ABE.parseValue @Void (fromJsonWithFormat defaultJsonFormat) [aesonQQ| {foo: 123} |] `shouldBe` Right (FooRecordExplicitJson $ 113 :*: RNil)+    it "encodes via DefaultJsonFormat using makeRecordJsonWrapperExplicit" $ do+      toJsonWithFormat defaultJsonFormat (FooRecordExplicitJson $ 113 :*: RNil) `shouldBe` [aesonQQ| {foo: 123} |]++    it "decodes via FromJSON using makeFieldJsonWrapper" $ do+      Aeson.parseEither Aeson.parseJSON [aesonQQ| {foo: 123} |] `shouldBe` Right (FooFieldDefaultJson $ review _FFoo 123)+    it "encodes via ToJSON using makeFieldJsonWrapper" $ do+      Aeson.toJSON (FooFieldDefaultJson $ review _FFoo 123) `shouldBe` [aesonQQ| {foo: 123} |]+    it "decodes via DefaultJsonFormat using makeFieldJsonWrapper" $ do+      ABE.parseValue @Void (fromJsonWithFormat defaultJsonFormat) [aesonQQ| {foo: 123} |] `shouldBe` Right (FooFieldDefaultJson $ review _FFoo 123)+    it "encodes via DefaultJsonFormat using makeFieldJsonWrapper" $ do+      toJsonWithFormat defaultJsonFormat (FooFieldDefaultJson $ review _FFoo 123) `shouldBe` [aesonQQ| {foo: 123} |]++    it "decodes via FromJSON using makeFieldJsonWrapperExplicit" $ do+      Aeson.parseEither Aeson.parseJSON [aesonQQ| {foo: 123} |] `shouldBe` Right (FooFieldExplicitJson $ review _FFoo 113)+    it "encodes via ToJSON using makeFieldJsonWrapperExplicit" $ do+      Aeson.toJSON (FooFieldExplicitJson $ review _FFoo 113) `shouldBe` [aesonQQ| {foo: 123} |]+    it "decodes via DefaultJsonFormat using makeFieldJsonWrapperExplicit" $ do+      ABE.parseValue @Void (fromJsonWithFormat defaultJsonFormat) [aesonQQ| {foo: 123} |] `shouldBe` Right (FooFieldExplicitJson $ review _FFoo 113)+    it "encodes via DefaultJsonFormat using makeFieldJsonWrapperExplicit" $ do+      toJsonWithFormat defaultJsonFormat (FooFieldExplicitJson $ review _FFoo 113) `shouldBe` [aesonQQ| {foo: 123} |]