From 34ffbf6026cd712086cd990dd3b8dfd7d155da82 Mon Sep 17 00:00:00 2001 From: autonym8 Date: Tue, 11 Jun 2024 14:11:34 +0200 Subject: [PATCH 1/2] FromJSON and ToJSON instances for Sum, Product, Any, All --- src/Data/Aeson/Types/FromJSON.hs | 10 ++++++++++ src/Data/Aeson/Types/ToJSON.hs | 12 +++++++++++- 2 files changed, 21 insertions(+), 1 deletion(-) diff --git a/src/Data/Aeson/Types/FromJSON.hs b/src/Data/Aeson/Types/FromJSON.hs index ca13b7e9..61450fd8 100644 --- a/src/Data/Aeson/Types/FromJSON.hs +++ b/src/Data/Aeson/Types/FromJSON.hs @@ -2342,6 +2342,16 @@ deriving via (a :: Type) instance FromJSON a => FromJSON (Semigroup.Last a) deriving via Identity instance FromJSON1 Semigroup.WrappedMonoid deriving via (a :: Type) instance FromJSON a => FromJSON (Semigroup.WrappedMonoid a) +deriving via Identity instance FromJSON1 Semigroup.Sum +deriving via (a :: Type) instance FromJSON a => FromJSON (Semigroup.Sum a) + +deriving via Identity instance FromJSON1 Semigroup.Product +deriving via (a :: Type) instance FromJSON a => FromJSON (Semigroup.Product a) + +deriving via Bool instance FromJSON Semigroup.All + +deriving via Bool instance FromJSON Semigroup.Any + #if !MIN_VERSION_base(4,16,0) deriving via Maybe instance FromJSON1 Semigroup.Option deriving via Maybe a instance FromJSON a => FromJSON (Semigroup.Option a) diff --git a/src/Data/Aeson/Types/ToJSON.hs b/src/Data/Aeson/Types/ToJSON.hs index 4aba277f..4aeaf575 100644 --- a/src/Data/Aeson/Types/ToJSON.hs +++ b/src/Data/Aeson/Types/ToJSON.hs @@ -367,7 +367,7 @@ instance (key ~ Key, value ~ Value) => KeyValue Value (key, value) where instance value ~ Value => KeyValue Value (KM.KeyMap value) where (.=) = explicitToField toJSON {-# INLINE (.=) #-} - + explicitToField f name value = KM.singleton name (f value) {-# INLINE explicitToField #-} @@ -2104,6 +2104,16 @@ deriving via (a :: Type) instance ToJSON a => ToJSON (Semigroup.Last a) deriving via Identity instance ToJSON1 Semigroup.WrappedMonoid deriving via (a :: Type) instance ToJSON a => ToJSON (Semigroup.WrappedMonoid a) +deriving via Identity instance ToJSON1 Semigroup.Sum +deriving via (a :: Type) instance ToJSON a => ToJSON (Semigroup.Sum a) + +deriving via Identity instance ToJSON1 Semigroup.Product +deriving via (a :: Type) instance ToJSON a => ToJSON (Semigroup.Product a) + +deriving via Bool instance ToJSON Semigroup.All + +deriving via Bool instance ToJSON Semigroup.Any + #if !MIN_VERSION_base(4,16,0) deriving via Maybe instance ToJSON1 Semigroup.Option deriving via Maybe a instance ToJSON a => ToJSON (Semigroup.Option a) From 9d26976a1aca4bb55fc7dc0cabc2276383b87050 Mon Sep 17 00:00:00 2001 From: autonym8 Date: Tue, 11 Jun 2024 17:49:33 +0200 Subject: [PATCH 2/2] Tests for Sum, Product, All and Any --- tests/PropertyRoundTrip.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/tests/PropertyRoundTrip.hs b/tests/PropertyRoundTrip.hs index f21a3da8..cdd4ba39 100644 --- a/tests/PropertyRoundTrip.hs +++ b/tests/PropertyRoundTrip.hs @@ -29,6 +29,7 @@ import Test.Tasty (TestTree, testGroup) import Test.Tasty.QuickCheck (testProperty) import Types import qualified Data.Monoid as Monoid +import qualified Data.Semigroup as Semigroup import qualified Data.Text as T import qualified Data.Text.Lazy as LT import qualified Data.Text.Short as ST @@ -87,6 +88,10 @@ roundTripTests = , testProperty "Nu" $ roundTripEq @(F.Nu (These Char)) , testProperty "Maybe" $ roundTripEq @(Maybe Int) , testProperty "Monoid.First" $ roundTripEq @(Monoid.First Int) + , testProperty "Semigroup.Sum" $ roundTripEq @(Semigroup.Sum Int) + , testProperty "Semigroup.Product" $ roundTripEq @(Semigroup.Product Int) + , testProperty "Semigroup.All" $ roundTripEq @Semigroup.All + , testProperty "Semigroup.Any" $ roundTripEq @Semigroup.Any , testProperty "Strict Pair" $ roundTripEq @(S.Pair Int Char) , testProperty "Strict Either" $ roundTripEq @(S.Either Int Char) , testProperty "Strict These" $ roundTripEq @(S.These Int Char)