Skip to content

Commit

Permalink
Merge pull request #1106 from AliceRixte/monoid-instances-deriving
Browse files Browse the repository at this point in the history
FromJSON and ToJSON instances for Sum, Product, Any, All
  • Loading branch information
phadej authored Jun 11, 2024
2 parents ac5b5a4 + 9d26976 commit ae40b21
Show file tree
Hide file tree
Showing 3 changed files with 26 additions and 1 deletion.
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

0 comments on commit ae40b21

Please sign in to comment.