Skip to content

Commit 6ae3542

Browse files
phadejphadej
authored
Merge pull request #1104 from haskell/deriving-via-sm
Use DerivingVia to derive newtype instances
2 parents 27517f0 + d247c3e commit 6ae3542

File tree

3 files changed

+56
-207
lines changed

3 files changed

+56
-207
lines changed

‎changelog.md

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,8 @@ For the latest version of this document, please see [https://github.com/haskell/
33
### 2.2.3.0
44

55
* Support `hashable-1.4.6.0`.
6+
* Fix an issue where `Hashable Key` wasn't newtype instance over underlying `Text`,
7+
so with `-ordered-keymap` there were correctness issues.
68

79
### 2.2.2.0
810

‎src/Data/Aeson/Types/FromJSON.hs

Lines changed: 28 additions & 104 deletions
Original file line numberDiff line numberDiff line change
@@ -1,18 +1,20 @@
11
{-# LANGUAGE CPP #-}
22
{-# LANGUAGE DataKinds #-}
33
{-# LANGUAGE DefaultSignatures #-}
4-
{-# LANGUAGE InstanceSigs #-}
4+
{-# LANGUAGE DerivingVia #-}
55
{-# LANGUAGE FlexibleContexts #-}
66
{-# LANGUAGE FlexibleInstances #-}
77
{-# LANGUAGE GADTs #-}
8+
{-# LANGUAGE InstanceSigs #-}
89
{-# LANGUAGE MultiParamTypeClasses #-}
910
{-# LANGUAGE OverloadedStrings #-}
1011
{-# LANGUAGE PolyKinds #-}
1112
{-# LANGUAGE RecordWildCards #-}
1213
{-# LANGUAGE ScopedTypeVariables #-}
14+
{-# LANGUAGE StandaloneDeriving #-}
15+
{-# LANGUAGE TupleSections #-}
1316
{-# LANGUAGE TypeApplications #-}
1417
{-# LANGUAGE TypeOperators #-}
15-
{-# LANGUAGE TupleSections #-}
1618
{-# LANGUAGE UndecidableInstances #-}
1719
{-# LANGUAGE ViewPatterns #-}
1820

@@ -86,12 +88,12 @@ module Data.Aeson.Types.FromJSON
8688
import Data.Aeson.Internal.Prelude
8789

8890
import Control.Monad (zipWithM, guard)
91+
import Data.Aeson.Decoding.ByteString.Lazy
92+
import Data.Aeson.Decoding.Conversion (unResult, toResultValue, lbsSpace)
8993
import Data.Aeson.Internal.Functions (mapKey, mapKeyO)
9094
import Data.Aeson.Internal.Scientific
9195
import Data.Aeson.Types.Generic
9296
import Data.Aeson.Types.Internal
93-
import Data.Aeson.Decoding.ByteString.Lazy
94-
import Data.Aeson.Decoding.Conversion (unResult, toResultValue, lbsSpace)
9597
import Data.Bits (unsafeShiftR)
9698
import Data.Fixed (Fixed, HasResolution (resolution), Nano)
9799
import Data.Functor.Compose (Compose(..))
@@ -100,6 +102,7 @@ import Data.Functor.Product (Product(..))
100102
import Data.Functor.Sum (Sum(..))
101103
import Data.Functor.These (These1 (..))
102104
import Data.Hashable (Hashable(..))
105+
import Data.Kind (Type)
103106
import Data.List.NonEmpty (NonEmpty(..))
104107
import Data.Ord (Down (..))
105108
import Data.Ratio ((%), Ratio)
@@ -1922,17 +1925,10 @@ instance (FromJSONKey a) => FromJSONKey (Solo a) where
19221925

19231926
instance FromJSON1 Identity where
19241927
liftParseJSON _ p _ a = coerce (p a)
1925-
19261928
liftParseJSONList _ _ p a = coerce (p a)
1927-
19281929
liftOmittedField = coerce
19291930

1930-
instance (FromJSON a) => FromJSON (Identity a) where
1931-
parseJSON = parseJSON1
1932-
1933-
parseJSONList = liftParseJSONList omittedField parseJSON parseJSONList
1934-
1935-
omittedField = coerce (omittedField @a)
1931+
deriving via (a :: Type) instance FromJSON a => FromJSON (Identity a)
19361932

19371933
instance (FromJSONKey a) => FromJSONKey (Identity a) where
19381934
fromJSONKey = coerceFromJSONKeyFunction (fromJSONKey :: FromJSONKeyFunction a)
@@ -2313,114 +2309,42 @@ instance FromJSONKey Month where
23132309
-------------------------------------------------------------------------------
23142310

23152311
-- | @since 2.2.0.0
2316-
instance FromJSON1 Down where
2317-
liftParseJSON _ p _ = coerce p
2318-
2319-
liftOmittedField = coerce
2312+
deriving via Identity instance FromJSON1 Down
23202313

23212314
-- | @since 2.2.0.0
2322-
instance FromJSON a => FromJSON (Down a) where
2323-
parseJSON = parseJSON1
2315+
deriving via (a :: Type) instance FromJSON a => FromJSON (Down a)
23242316

23252317
-------------------------------------------------------------------------------
23262318
-- base Monoid/Semigroup
23272319
-------------------------------------------------------------------------------
23282320

2329-
instance FromJSON1 Monoid.Dual where
2330-
liftParseJSON _ p _ = coerce p
2321+
deriving via Identity instance FromJSON1 Monoid.Dual
2322+
deriving via (a :: Type) instance FromJSON a => FromJSON (Monoid.Dual a)
23312323

2332-
liftOmittedField = coerce
2324+
deriving via Maybe instance FromJSON1 Monoid.First
2325+
deriving via Maybe a instance FromJSON a => FromJSON (Monoid.First a)
23332326

2334-
instance FromJSON a => FromJSON (Monoid.Dual a) where
2335-
parseJSON = parseJSON1
2336-
2337-
2338-
instance FromJSON1 Monoid.First where
2339-
liftParseJSON o = coerce (liftParseJSON @Maybe o)
2340-
liftOmittedField _ = Just (Monoid.First Nothing)
2341-
2342-
instance FromJSON a => FromJSON (Monoid.First a) where
2343-
parseJSON = parseJSON1
2344-
omittedField = omittedField1
2345-
2346-
instance FromJSON1 Monoid.Last where
2347-
liftParseJSON o = coerce (liftParseJSON @Maybe o)
2348-
liftOmittedField _ = Just (Monoid.Last Nothing)
2349-
2350-
instance FromJSON a => FromJSON (Monoid.Last a) where
2351-
parseJSON = parseJSON1
2352-
omittedField = omittedField1
2327+
deriving via Maybe instance FromJSON1 Monoid.Last
2328+
deriving via Maybe a instance FromJSON a => FromJSON (Monoid.Last a)
23532329

2354-
instance FromJSON1 Semigroup.Min where
2355-
liftParseJSON _ p _ a = coerce (p a)
2356-
2357-
liftParseJSONList _ _ p a = coerce (p a)
2358-
2359-
liftOmittedField = coerce
2330+
deriving via Identity instance FromJSON1 Semigroup.Min
2331+
deriving via (a :: Type) instance FromJSON a => FromJSON (Semigroup.Min a)
23602332

2361-
instance (FromJSON a) => FromJSON (Semigroup.Min a) where
2362-
parseJSON = parseJSON1
2333+
deriving via Identity instance FromJSON1 Semigroup.Max
2334+
deriving via (a :: Type) instance FromJSON a => FromJSON (Semigroup.Max a)
23632335

2364-
parseJSONList = liftParseJSONList omittedField parseJSON parseJSONList
2336+
deriving via Identity instance FromJSON1 Semigroup.First
2337+
deriving via (a :: Type) instance FromJSON a => FromJSON (Semigroup.First a)
23652338

2366-
omittedField = omittedField1
2339+
deriving via Identity instance FromJSON1 Semigroup.Last
2340+
deriving via (a :: Type) instance FromJSON a => FromJSON (Semigroup.Last a)
23672341

2368-
instance FromJSON1 Semigroup.Max where
2369-
liftParseJSON _ p _ a = coerce (p a)
2370-
2371-
liftParseJSONList _ _ p a = coerce (p a)
2372-
liftOmittedField = coerce
2373-
2374-
instance (FromJSON a) => FromJSON (Semigroup.Max a) where
2375-
parseJSON = parseJSON1
2376-
2377-
parseJSONList = liftParseJSONList omittedField parseJSON parseJSONList
2378-
omittedField = omittedField1
2379-
2380-
instance FromJSON1 Semigroup.First where
2381-
liftParseJSON _ p _ a = coerce (p a)
2382-
2383-
liftParseJSONList _ _ p a = coerce (p a)
2384-
liftOmittedField = coerce
2385-
2386-
instance (FromJSON a) => FromJSON (Semigroup.First a) where
2387-
parseJSON = parseJSON1
2388-
2389-
parseJSONList = liftParseJSONList omittedField parseJSON parseJSONList
2390-
2391-
2392-
instance FromJSON1 Semigroup.Last where
2393-
liftParseJSON _ p _ a = coerce (p a)
2394-
2395-
liftParseJSONList _ _ p a = coerce (p a)
2396-
liftOmittedField = coerce
2397-
2398-
instance (FromJSON a) => FromJSON (Semigroup.Last a) where
2399-
parseJSON = parseJSON1
2400-
2401-
parseJSONList = liftParseJSONList omittedField parseJSON parseJSONList
2402-
omittedField = omittedField1
2403-
2404-
instance FromJSON1 Semigroup.WrappedMonoid where
2405-
liftParseJSON _ p _ a = coerce (p a)
2406-
2407-
liftParseJSONList _ _ p a = coerce (p a)
2408-
liftOmittedField = coerce
2409-
2410-
instance (FromJSON a) => FromJSON (Semigroup.WrappedMonoid a) where
2411-
parseJSON = parseJSON1
2412-
2413-
parseJSONList = liftParseJSONList omittedField parseJSON parseJSONList
2414-
omittedField = omittedField1
2342+
deriving via Identity instance FromJSON1 Semigroup.WrappedMonoid
2343+
deriving via (a :: Type) instance FromJSON a => FromJSON (Semigroup.WrappedMonoid a)
24152344

24162345
#if !MIN_VERSION_base(4,16,0)
2417-
instance FromJSON1 Semigroup.Option where
2418-
liftParseJSON o = coerce (liftParseJSON @Maybe o)
2419-
liftOmittedField _ = Just (Semigroup.Option Nothing)
2420-
2421-
instance FromJSON a => FromJSON (Semigroup.Option a) where
2422-
parseJSON = parseJSON1
2423-
omittedField = omittedField1
2346+
deriving via Maybe instance FromJSON1 Semigroup.Option
2347+
deriving via Maybe a instance FromJSON a => FromJSON (Semigroup.Option a)
24242348
#endif
24252349

24262350
-------------------------------------------------------------------------------

‎src/Data/Aeson/Types/ToJSON.hs

Lines changed: 26 additions & 103 deletions
Original file line numberDiff line numberDiff line change
@@ -1,18 +1,20 @@
11
{-# LANGUAGE CPP #-}
22
{-# LANGUAGE DefaultSignatures #-}
3+
{-# LANGUAGE DerivingVia #-}
34
{-# LANGUAGE EmptyCase #-}
45
{-# LANGUAGE EmptyDataDecls #-}
56
{-# LANGUAGE FlexibleContexts #-}
67
{-# LANGUAGE FlexibleInstances #-}
78
{-# LANGUAGE FunctionalDependencies #-}
8-
{-# LANGUAGE InstanceSigs #-}
99
{-# LANGUAGE GADTs #-}
10+
{-# LANGUAGE InstanceSigs #-}
1011
{-# LANGUAGE OverloadedStrings #-}
1112
{-# LANGUAGE PolyKinds #-}
1213
{-# LANGUAGE RecordWildCards #-}
1314
{-# LANGUAGE ScopedTypeVariables #-}
14-
{-# LANGUAGE TypeOperators #-}
15+
{-# LANGUAGE StandaloneDeriving #-}
1516
{-# LANGUAGE TypeApplications #-}
17+
{-# LANGUAGE TypeOperators #-}
1618
{-# LANGUAGE UndecidableInstances #-}
1719

1820
module Data.Aeson.Types.ToJSON
@@ -76,6 +78,7 @@ import Data.Functor.Identity (Identity(..))
7678
import Data.Functor.Product (Product(..))
7779
import Data.Functor.Sum (Sum(..))
7880
import Data.Functor.These (These1 (..))
81+
import Data.Kind (Type)
7982
import Data.List (intersperse)
8083
import Data.List.NonEmpty (NonEmpty(..))
8184
import Data.Maybe (isNothing)
@@ -1641,14 +1644,7 @@ instance ToJSON1 Identity where
16411644

16421645
liftOmitField o (Identity a) = o a
16431646

1644-
instance (ToJSON a) => ToJSON (Identity a) where
1645-
toJSON = toJSON1
1646-
toJSONList = liftToJSONList omitField toJSON toJSONList
1647-
1648-
toEncoding = toEncoding1
1649-
toEncodingList = liftToEncodingList omitField toEncoding toEncodingList
1650-
1651-
omitField (Identity x) = omitField x
1647+
deriving via (a :: Type) instance ToJSON a => ToJSON (Identity a)
16521648

16531649
instance (ToJSONKey a) => ToJSONKey (Identity a) where
16541650
toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
@@ -2075,115 +2071,42 @@ instance ToJSONKey QuarterOfYear where
20752071
-------------------------------------------------------------------------------
20762072

20772073
-- | @since 2.2.0.0
2078-
instance ToJSON1 Down where
2079-
liftToJSON _ t _ = coerce t
2080-
liftToEncoding _ t _ = coerce t
2081-
liftOmitField = coerce
2074+
deriving via Identity instance ToJSON1 Down
20822075

20832076
-- | @since 2.2.0.0
2084-
instance ToJSON a => ToJSON (Down a) where
2085-
toJSON = toJSON1
2086-
toEncoding = toEncoding1
2087-
omitField = omitField1
2077+
deriving via (a :: Type) instance ToJSON a => ToJSON (Down a)
20882078

20892079
-------------------------------------------------------------------------------
20902080
-- base Monoid/Semigroup
20912081
-------------------------------------------------------------------------------
20922082

2093-
instance ToJSON1 Monoid.Dual where
2094-
liftToJSON _ t _ = t . Monoid.getDual
2095-
liftToEncoding _ t _ = t . Monoid.getDual
2096-
liftOmitField = coerce
2097-
2098-
instance ToJSON a => ToJSON (Monoid.Dual a) where
2099-
toJSON = toJSON1
2100-
toEncoding = toEncoding1
2101-
omitField = omitField1
2102-
2103-
instance ToJSON1 Monoid.First where
2104-
liftToJSON o t to' = liftToJSON o t to' . Monoid.getFirst
2105-
liftToEncoding o t to' = liftToEncoding o t to' . Monoid.getFirst
2106-
liftOmitField :: forall a. (a -> Bool) -> Monoid.First a -> Bool
2107-
liftOmitField _ = coerce (isNothing @a)
2108-
2109-
instance ToJSON a => ToJSON (Monoid.First a) where
2110-
toJSON = toJSON1
2111-
toEncoding = toEncoding1
2112-
omitField = omitField1
2113-
2114-
instance ToJSON1 Monoid.Last where
2115-
liftToJSON o t to' = liftToJSON o t to' . Monoid.getLast
2116-
liftToEncoding o t to' = liftToEncoding o t to' . Monoid.getLast
2117-
2118-
liftOmitField :: forall a. (a -> Bool) -> Monoid.Last a -> Bool
2119-
liftOmitField _ = coerce (isNothing @a)
2120-
2121-
instance ToJSON a => ToJSON (Monoid.Last a) where
2122-
toJSON = toJSON1
2123-
toEncoding = toEncoding1
2124-
omitField = omitField1
2125-
2126-
instance ToJSON1 Semigroup.Min where
2127-
liftToJSON _ t _ (Semigroup.Min x) = t x
2128-
liftToEncoding _ t _ (Semigroup.Min x) = t x
2129-
liftOmitField = coerce
2083+
deriving via Identity instance ToJSON1 Monoid.Dual
2084+
deriving via (a :: Type) instance ToJSON a => ToJSON (Monoid.Dual a)
21302085

2131-
instance ToJSON a => ToJSON (Semigroup.Min a) where
2132-
toJSON = toJSON1
2133-
toEncoding = toEncoding1
2134-
omitField = omitField1
2086+
deriving via Maybe instance ToJSON1 Monoid.First
2087+
deriving via Maybe a instance ToJSON a => ToJSON (Monoid.First a)
21352088

2089+
deriving via Maybe instance ToJSON1 Monoid.Last
2090+
deriving via Maybe a instance ToJSON a => ToJSON (Monoid.Last a)
21362091

2137-
instance ToJSON1 Semigroup.Max where
2138-
liftToJSON _ t _ (Semigroup.Max x) = t x
2139-
liftToEncoding _ t _ (Semigroup.Max x) = t x
2140-
liftOmitField = coerce
2092+
deriving via Identity instance ToJSON1 Semigroup.Min
2093+
deriving via (a :: Type) instance ToJSON a => ToJSON (Semigroup.Min a)
21412094

2142-
instance ToJSON a => ToJSON (Semigroup.Max a) where
2143-
toJSON = toJSON1
2144-
toEncoding = toEncoding1
2145-
omitField = omitField1
2095+
deriving via Identity instance ToJSON1 Semigroup.Max
2096+
deriving via (a :: Type) instance ToJSON a => ToJSON (Semigroup.Max a)
21462097

2147-
instance ToJSON1 Semigroup.First where
2148-
liftToJSON _ t _ (Semigroup.First x) = t x
2149-
liftToEncoding _ t _ (Semigroup.First x) = t x
2150-
liftOmitField = coerce
2098+
deriving via Identity instance ToJSON1 Semigroup.First
2099+
deriving via (a :: Type) instance ToJSON a => ToJSON (Semigroup.First a)
21512100

2152-
instance ToJSON a => ToJSON (Semigroup.First a) where
2153-
toJSON = toJSON1
2154-
toEncoding = toEncoding1
2155-
omitField = omitField1
2101+
deriving via Identity instance ToJSON1 Semigroup.Last
2102+
deriving via (a :: Type) instance ToJSON a => ToJSON (Semigroup.Last a)
21562103

2157-
instance ToJSON1 Semigroup.Last where
2158-
liftToJSON _ t _ (Semigroup.Last x) = t x
2159-
liftToEncoding _ t _ (Semigroup.Last x) = t x
2160-
liftOmitField = coerce
2161-
2162-
instance ToJSON a => ToJSON (Semigroup.Last a) where
2163-
toJSON = toJSON1
2164-
toEncoding = toEncoding1
2165-
omitField = omitField1
2166-
2167-
instance ToJSON1 Semigroup.WrappedMonoid where
2168-
liftToJSON _ t _ (Semigroup.WrapMonoid x) = t x
2169-
liftToEncoding _ t _ (Semigroup.WrapMonoid x) = t x
2170-
liftOmitField = coerce
2171-
2172-
instance ToJSON a => ToJSON (Semigroup.WrappedMonoid a) where
2173-
toJSON = toJSON1
2174-
toEncoding = toEncoding1
2175-
omitField = omitField1
2104+
deriving via Identity instance ToJSON1 Semigroup.WrappedMonoid
2105+
deriving via (a :: Type) instance ToJSON a => ToJSON (Semigroup.WrappedMonoid a)
21762106

21772107
#if !MIN_VERSION_base(4,16,0)
2178-
instance ToJSON1 Semigroup.Option where
2179-
liftToJSON o t to' = liftToJSON o t to' . Semigroup.getOption
2180-
liftToEncoding o t to' = liftToEncoding o t to' . Semigroup.getOption
2181-
liftOmitField _ = isNothing . Semigroup.getOption
2182-
2183-
instance ToJSON a => ToJSON (Semigroup.Option a) where
2184-
toJSON = toJSON1
2185-
toEncoding = toEncoding1
2186-
omitField = omitField1
2108+
deriving via Maybe instance ToJSON1 Semigroup.Option
2109+
deriving via Maybe a instance ToJSON a => ToJSON (Semigroup.Option a)
21872110
#endif
21882111

21892112
-------------------------------------------------------------------------------

0 commit comments

Comments
 (0)