Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

FromJSON and ToJSON instances for Sum, Product, Any, All #1106

Merged
merged 2 commits into from
Jun 11, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
10 changes: 10 additions & 0 deletions src/Data/Aeson/Types/FromJSON.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
12 changes: 11 additions & 1 deletion src/Data/Aeson/Types/ToJSON.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 #-}

Expand Down Expand Up @@ -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)
Expand Down
5 changes: 5 additions & 0 deletions tests/PropertyRoundTrip.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down