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.

Sign up for GitHub

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

Add instances for Data.Monoid #1101

Closed
wants to merge 6 commits into from
Closed

Add instances for Data.Monoid #1101

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
98d8b56
Instances for Sum and Product monoid wrappers
AliceRixte Jun 4, 2024
57cd653
Instances for Any and All
AliceRixte Jun 4, 2024
afe5ae3
Matching Down instance instead of Min
AliceRixte Jun 6, 2024
e37d60e
Using coerce instead of getters
AliceRixte Jun 6, 2024
562a8f2
Uniformize instances for newtype monoids
AliceRixte Jun 6, 2024
b93b092
Uniformize fromJSON instances for newtype monoids
AliceRixte Jun 9, 2024
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
78 changes: 52 additions & 26 deletions src/Data/Aeson/Types/FromJSON.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2316,6 +2316,8 @@ instance FromJSONKey Month where
instance FromJSON1 Down where
liftParseJSON _ p _ = coerce p

liftParseJSONList _ _ p = coerce p

liftOmittedField = coerce

-- | @since 2.2.0.0
Expand All @@ -2329,11 +2331,47 @@ instance FromJSON a => FromJSON (Down a) where
instance FromJSON1 Monoid.Dual where
liftParseJSON _ p _ = coerce p

liftParseJSONList _ _ p = coerce p

liftOmittedField = coerce

instance FromJSON a => FromJSON (Monoid.Dual a) where
parseJSON = parseJSON1

instance FromJSON1 Monoid.Sum where
liftParseJSON _ p _ = coerce p

liftParseJSONList _ _ p = coerce p

liftOmittedField = coerce

instance (FromJSON a) => FromJSON (Monoid.Sum a) where
parseJSON = parseJSON1

instance FromJSON1 Monoid.Product where
liftParseJSON _ p _ = coerce p

liftParseJSONList _ _ p = coerce p

liftOmittedField = coerce

instance (FromJSON a) => FromJSON (Monoid.Product a) where
parseJSON = parseJSON1

instance FromJSON Monoid.All where
parseJSON = coerce . (parseJSON :: Value -> Parser Bool)

parseJSONList = coerce . (parseJSONList :: Value -> Parser [Bool])

omittedField = coerce (omittedField :: Maybe Bool)

instance FromJSON Monoid.Any where
parseJSON v = coerce (parseJSON v :: Parser Bool)

parseJSONList v = coerce (parseJSONList v :: Parser [Bool])

omittedField = coerce (omittedField :: Maybe Bool)


instance FromJSON1 Monoid.First where
liftParseJSON o = coerce (liftParseJSON @Maybe o)
Expand All @@ -2352,67 +2390,55 @@ instance FromJSON a => FromJSON (Monoid.Last a) where
omittedField = omittedField1

instance FromJSON1 Semigroup.Min where
liftParseJSON _ p _ a = coerce (p a)
liftParseJSON _ p _ = coerce p

liftParseJSONList _ _ p a = coerce (p a)
liftParseJSONList _ _ p = coerce p

liftOmittedField = coerce

instance (FromJSON a) => FromJSON (Semigroup.Min a) where
parseJSON = parseJSON1

parseJSONList = liftParseJSONList omittedField parseJSON parseJSONList

omittedField = omittedField1

instance FromJSON1 Semigroup.Max where
liftParseJSON _ p _ a = coerce (p a)
liftParseJSON _ p _ = coerce p

liftParseJSONList _ _ p = coerce p

liftParseJSONList _ _ p a = coerce (p a)
liftOmittedField = coerce

instance (FromJSON a) => FromJSON (Semigroup.Max a) where
parseJSON = parseJSON1

parseJSONList = liftParseJSONList omittedField parseJSON parseJSONList
omittedField = omittedField1

instance FromJSON1 Semigroup.First where
liftParseJSON _ p _ a = coerce (p a)
liftParseJSON _ p _ = coerce p

liftParseJSONList _ _ p = coerce p

liftParseJSONList _ _ p a = coerce (p a)
liftOmittedField = coerce

instance (FromJSON a) => FromJSON (Semigroup.First a) where
parseJSON = parseJSON1

parseJSONList = liftParseJSONList omittedField parseJSON parseJSONList


instance FromJSON1 Semigroup.Last where
liftParseJSON _ p _ a = coerce (p a)
liftParseJSON _ p _ = coerce p

liftParseJSONList _ _ p = coerce p

liftParseJSONList _ _ p a = coerce (p a)
liftOmittedField = coerce

instance (FromJSON a) => FromJSON (Semigroup.Last a) where
parseJSON = parseJSON1

parseJSONList = liftParseJSONList omittedField parseJSON parseJSONList
omittedField = omittedField1

instance FromJSON1 Semigroup.WrappedMonoid where
liftParseJSON _ p _ a = coerce (p a)
liftParseJSON _ p _ = coerce p

liftParseJSONList _ _ p = coerce p

liftParseJSONList _ _ p a = coerce (p a)
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

this removals are wrong.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I added it back, and made it coherent with the rest of the code

Copy link
Contributor Author

@AliceRixte AliceRixte Jun 9, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I also think it would make sense that these two lines

parseJSONList = liftParseJSONList omittedField parseJSON parseJSONList
omittedField = omittedField1

should be added to all the FromJSON instances from Data.Monoid. They were initially there in the First and Last and WrappedMonoid instances, but not in the Down instance. If you agree I can do this.

liftOmittedField = coerce

instance (FromJSON a) => FromJSON (Semigroup.WrappedMonoid a) where
parseJSON = parseJSON1

parseJSONList = liftParseJSONList omittedField parseJSON parseJSONList
omittedField = omittedField1

#if !MIN_VERSION_base(4,16,0)
instance FromJSON1 Semigroup.Option where
liftParseJSON o = coerce (liftParseJSON @Maybe o)
Expand Down
61 changes: 46 additions & 15 deletions src/Data/Aeson/Types/ToJSON.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -364,7 +364,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 @@ -2091,21 +2091,52 @@ instance ToJSON a => ToJSON (Down a) where
-------------------------------------------------------------------------------

instance ToJSON1 Monoid.Dual where
liftToJSON _ t _ = t . Monoid.getDual
liftToEncoding _ t _ = t . Monoid.getDual
liftToJSON _ t _ = coerce t
liftToEncoding _ t _ = coerce t
liftOmitField = coerce

instance ToJSON a => ToJSON (Monoid.Dual a) where
toJSON = toJSON1
toEncoding = toEncoding1
omitField = omitField1

instance ToJSON1 Monoid.Sum where
liftToJSON _ t _ = coerce t
liftToEncoding _ t _ = coerce t
liftOmitField = coerce


instance ToJSON a => ToJSON (Monoid.Sum a) where
toJSON = toJSON1
toEncoding = toEncoding1
omitField = omitField1

instance ToJSON1 Monoid.Product where
liftToJSON _ t _ = coerce t
liftToEncoding _ t _ = coerce t
liftOmitField = coerce

instance ToJSON a => ToJSON (Monoid.Product a) where
toJSON = toJSON1
toEncoding = toEncoding1
omitField = omitField1

instance ToJSON Monoid.All where
toJSON = (toJSON :: Bool -> Value) . coerce
toEncoding = (toEncoding :: Bool -> Encoding) . coerce
omitField = (omitField :: Bool -> Bool) . coerce

instance ToJSON Monoid.Any where
toJSON = (toJSON :: Bool -> Value) . coerce
toEncoding = (toEncoding :: Bool -> Encoding) . coerce
omitField = (omitField :: Bool -> Bool) . coerce

instance ToJSON1 Monoid.First where
liftToJSON o t to' = liftToJSON o t to' . Monoid.getFirst
liftToEncoding o t to' = liftToEncoding o t to' . Monoid.getFirst
liftOmitField :: forall a. (a -> Bool) -> Monoid.First a -> Bool
liftOmitField _ = coerce (isNothing @a)

instance ToJSON a => ToJSON (Monoid.First a) where
toJSON = toJSON1
toEncoding = toEncoding1
Expand All @@ -2124,8 +2155,8 @@ instance ToJSON a => ToJSON (Monoid.Last a) where
omitField = omitField1

instance ToJSON1 Semigroup.Min where
liftToJSON _ t _ (Semigroup.Min x) = t x
liftToEncoding _ t _ (Semigroup.Min x) = t x
liftToJSON _ t _ = coerce t
liftToEncoding _ t _ = coerce t
liftOmitField = coerce

instance ToJSON a => ToJSON (Semigroup.Min a) where
Expand All @@ -2135,8 +2166,8 @@ instance ToJSON a => ToJSON (Semigroup.Min a) where


instance ToJSON1 Semigroup.Max where
liftToJSON _ t _ (Semigroup.Max x) = t x
liftToEncoding _ t _ (Semigroup.Max x) = t x
liftToJSON _ t _ = coerce t
liftToEncoding _ t _ = coerce t
liftOmitField = coerce

instance ToJSON a => ToJSON (Semigroup.Max a) where
Expand All @@ -2145,8 +2176,8 @@ instance ToJSON a => ToJSON (Semigroup.Max a) where
omitField = omitField1

instance ToJSON1 Semigroup.First where
liftToJSON _ t _ (Semigroup.First x) = t x
liftToEncoding _ t _ (Semigroup.First x) = t x
liftToJSON _ t _ = coerce t
liftToEncoding _ t _ = coerce t
liftOmitField = coerce

instance ToJSON a => ToJSON (Semigroup.First a) where
Expand All @@ -2155,8 +2186,8 @@ instance ToJSON a => ToJSON (Semigroup.First a) where
omitField = omitField1

instance ToJSON1 Semigroup.Last where
liftToJSON _ t _ (Semigroup.Last x) = t x
liftToEncoding _ t _ (Semigroup.Last x) = t x
liftToJSON _ t _ = coerce t
liftToEncoding _ t _ = coerce t
liftOmitField = coerce

instance ToJSON a => ToJSON (Semigroup.Last a) where
Expand All @@ -2165,10 +2196,10 @@ instance ToJSON a => ToJSON (Semigroup.Last a) where
omitField = omitField1

instance ToJSON1 Semigroup.WrappedMonoid where
liftToJSON _ t _ (Semigroup.WrapMonoid x) = t x
liftToEncoding _ t _ (Semigroup.WrapMonoid x) = t x
liftToJSON _ t _ = coerce t
liftToEncoding _ t _ = coerce t
liftOmitField = coerce

instance ToJSON a => ToJSON (Semigroup.WrappedMonoid a) where
toJSON = toJSON1
toEncoding = toEncoding1
Expand Down
4 changes: 4 additions & 0 deletions tests/PropertyRoundTrip.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -87,6 +87,10 @@ roundTripTests =
, testProperty "Nu" $ roundTripEq @(F.Nu (These Char))
, testProperty "Maybe" $ roundTripEq @(Maybe Int)
, testProperty "Monoid.First" $ roundTripEq @(Monoid.First Int)
, testProperty "Monoid.Sum" $ roundTripEq @(Monoid.Sum Int)
, testProperty "Monoid.Product" $ roundTripEq @(Monoid.Product Int)
, testProperty "Monoid.All" $ roundTripEq @Monoid.All
, testProperty "Monoid.Any" $ roundTripEq @Monoid.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