diff --git a/aeson.cabal b/aeson.cabal --- a/aeson.cabal +++ b/aeson.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: aeson -version: 2.2.2.0 +version: 2.2.3.0 license: BSD-3-Clause license-file: LICENSE category: Text, Web, JSON @@ -115,7 +115,7 @@ , character-ps ^>=0.1 , data-fix ^>=0.3.2 , dlist ^>=1.0 - , hashable ^>=1.4.2.0 + , hashable ^>=1.4.6.0 , indexed-traversable ^>=0.1.2 , integer-conversion ^>=0.1 , integer-logarithms ^>=1.0.3.1 @@ -127,14 +127,14 @@ , semialign ^>=1.3 , strict ^>=0.5 , tagged ^>=0.8.7 - , text-iso8601 ^>=0.1 + , text-iso8601 ^>=0.1.1 , text-short ^>=0.1.5 , th-abstraction ^>=0.5.0.0 || ^>=0.6.0.0 || ^>=0.7.0.0 , these ^>=1.2 , unordered-containers ^>=0.2.10.0 , uuid-types ^>=1.0.5 , vector ^>=0.13.0.0 - , witherable ^>=0.4.2 + , witherable ^>=0.4.2 || ^>=0.5 ghc-options: -Wall diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,12 @@ For the latest version of this document, please see [https://github.com/haskell/aeson/blob/master/changelog.md](https://github.com/haskell/aeson/blob/master/changelog.md). +### 2.2.3.0 + +* Support `hashable-1.4.6.0`. +* Fix an issue where `Hashable Key` wasn't newtype instance over underlying `Text`, + so with `-ordered-keymap` there were correctness issues. +* Add instances for `Data.Semigroup.Sum`, `Product`, `Any`, `All` + ### 2.2.2.0 * Support GHC-8.6.5...9.10.1 diff --git a/src/Data/Aeson.hs b/src/Data/Aeson.hs --- a/src/Data/Aeson.hs +++ b/src/Data/Aeson.hs @@ -557,5 +557,5 @@ -- -- For more information, see -- , --- and +-- and -- (where the relevant parsers are defined). diff --git a/src/Data/Aeson/Decoding.hs b/src/Data/Aeson/Decoding.hs --- a/src/Data/Aeson/Decoding.hs +++ b/src/Data/Aeson/Decoding.hs @@ -96,7 +96,7 @@ -- Decoding: strict text ------------------------------------------------------------------------------- --- | Efficiently deserialize a JSON value from a strict 'B.ByteString'. +-- | Efficiently deserialize a JSON value from a strict 'T.Text'. -- If this fails due to incomplete or invalid input, 'Nothing' is -- returned. -- diff --git a/src/Data/Aeson/Key.hs b/src/Data/Aeson/Key.hs --- a/src/Data/Aeson/Key.hs +++ b/src/Data/Aeson/Key.hs @@ -1,6 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskellQuotes #-} -- | @@ -39,7 +42,7 @@ import qualified Test.QuickCheck as QC newtype Key = Key { unKey :: Text } - deriving (Eq, Ord, Typeable, Data) + deriving (Typeable, Data) fromString :: String -> Key fromString = Key . T.pack @@ -58,7 +61,7 @@ -- -- Using 'coercing' we can make more efficient implementations -- when 'Key' is backed up by 'Text' without exposing internals. --- +-- coercionToText :: Maybe (Coercion Key Text) coercionToText = Just Coercion {-# INLINE coercionToText #-} @@ -79,13 +82,14 @@ readPrec = fromString <$> readPrec instance Show Key where - showsPrec d (Key k) = showsPrec d k + showsPrec d (Key k) = showsPrec d k instance Data.String.IsString Key where fromString = fromString -instance Hashable Key where - hashWithSalt salt (Key k) = hashWithSalt salt k +deriving newtype instance Eq Key +deriving newtype instance Ord Key +deriving newtype instance Hashable Key instance NFData Key where rnf (Key k) = rnf k diff --git a/src/Data/Aeson/Types/FromJSON.hs b/src/Data/Aeson/Types/FromJSON.hs --- a/src/Data/Aeson/Types/FromJSON.hs +++ b/src/Data/Aeson/Types/FromJSON.hs @@ -1,18 +1,20 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ViewPatterns #-} @@ -86,12 +88,12 @@ import Data.Aeson.Internal.Prelude import Control.Monad (zipWithM, guard) +import Data.Aeson.Decoding.ByteString.Lazy +import Data.Aeson.Decoding.Conversion (unResult, toResultValue, lbsSpace) import Data.Aeson.Internal.Functions (mapKey, mapKeyO) import Data.Aeson.Internal.Scientific import Data.Aeson.Types.Generic import Data.Aeson.Types.Internal -import Data.Aeson.Decoding.ByteString.Lazy -import Data.Aeson.Decoding.Conversion (unResult, toResultValue, lbsSpace) import Data.Bits (unsafeShiftR) import Data.Fixed (Fixed, HasResolution (resolution), Nano) import Data.Functor.Compose (Compose(..)) @@ -100,6 +102,7 @@ import Data.Functor.Sum (Sum(..)) import Data.Functor.These (These1 (..)) import Data.Hashable (Hashable(..)) +import Data.Kind (Type) import Data.List.NonEmpty (NonEmpty(..)) import Data.Ord (Down (..)) import Data.Ratio ((%), Ratio) @@ -1922,17 +1925,10 @@ instance FromJSON1 Identity where liftParseJSON _ p _ a = coerce (p a) - liftParseJSONList _ _ p a = coerce (p a) - liftOmittedField = coerce -instance (FromJSON a) => FromJSON (Identity a) where - parseJSON = parseJSON1 - - parseJSONList = liftParseJSONList omittedField parseJSON parseJSONList - - omittedField = coerce (omittedField @a) +deriving via (a :: Type) instance FromJSON a => FromJSON (Identity a) instance (FromJSONKey a) => FromJSONKey (Identity a) where fromJSONKey = coerceFromJSONKeyFunction (fromJSONKey :: FromJSONKeyFunction a) @@ -2313,114 +2309,58 @@ ------------------------------------------------------------------------------- -- | @since 2.2.0.0 -instance FromJSON1 Down where - liftParseJSON _ p _ = coerce p - - liftOmittedField = coerce +deriving via Identity instance FromJSON1 Down -- | @since 2.2.0.0 -instance FromJSON a => FromJSON (Down a) where - parseJSON = parseJSON1 +deriving via (a :: Type) instance FromJSON a => FromJSON (Down a) ------------------------------------------------------------------------------- -- base Monoid/Semigroup ------------------------------------------------------------------------------- -instance FromJSON1 Monoid.Dual where - liftParseJSON _ p _ = coerce p - - liftOmittedField = coerce - -instance FromJSON a => FromJSON (Monoid.Dual a) where - parseJSON = parseJSON1 - - -instance FromJSON1 Monoid.First where - liftParseJSON o = coerce (liftParseJSON @Maybe o) - liftOmittedField _ = Just (Monoid.First Nothing) - -instance FromJSON a => FromJSON (Monoid.First a) where - parseJSON = parseJSON1 - omittedField = omittedField1 - -instance FromJSON1 Monoid.Last where - liftParseJSON o = coerce (liftParseJSON @Maybe o) - liftOmittedField _ = Just (Monoid.Last Nothing) - -instance FromJSON a => FromJSON (Monoid.Last a) where - parseJSON = parseJSON1 - omittedField = omittedField1 - -instance FromJSON1 Semigroup.Min where - liftParseJSON _ p _ a = coerce (p a) - - liftParseJSONList _ _ p a = coerce (p a) - - 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) - - 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) - - liftParseJSONList _ _ p a = coerce (p a) - liftOmittedField = coerce +deriving via Identity instance FromJSON1 Monoid.Dual +deriving via (a :: Type) instance FromJSON a => FromJSON (Monoid.Dual a) -instance (FromJSON a) => FromJSON (Semigroup.First a) where - parseJSON = parseJSON1 +deriving via Maybe instance FromJSON1 Monoid.First +deriving via Maybe a instance FromJSON a => FromJSON (Monoid.First a) - parseJSONList = liftParseJSONList omittedField parseJSON parseJSONList +deriving via Maybe instance FromJSON1 Monoid.Last +deriving via Maybe a instance FromJSON a => FromJSON (Monoid.Last a) +deriving via Identity instance FromJSON1 Semigroup.Min +deriving via (a :: Type) instance FromJSON a => FromJSON (Semigroup.Min a) -instance FromJSON1 Semigroup.Last where - liftParseJSON _ p _ a = coerce (p a) +deriving via Identity instance FromJSON1 Semigroup.Max +deriving via (a :: Type) instance FromJSON a => FromJSON (Semigroup.Max a) - liftParseJSONList _ _ p a = coerce (p a) - liftOmittedField = coerce +deriving via Identity instance FromJSON1 Semigroup.First +deriving via (a :: Type) instance FromJSON a => FromJSON (Semigroup.First a) -instance (FromJSON a) => FromJSON (Semigroup.Last a) where - parseJSON = parseJSON1 +deriving via Identity instance FromJSON1 Semigroup.Last +deriving via (a :: Type) instance FromJSON a => FromJSON (Semigroup.Last a) - parseJSONList = liftParseJSONList omittedField parseJSON parseJSONList - omittedField = omittedField1 +deriving via Identity instance FromJSON1 Semigroup.WrappedMonoid +deriving via (a :: Type) instance FromJSON a => FromJSON (Semigroup.WrappedMonoid a) -instance FromJSON1 Semigroup.WrappedMonoid where - liftParseJSON _ p _ a = coerce (p a) +-- | @since 2.2.3.0 +deriving via Identity instance FromJSON1 Semigroup.Sum +-- | @since 2.2.3.0 +deriving via (a :: Type) instance FromJSON a => FromJSON (Semigroup.Sum a) - liftParseJSONList _ _ p a = coerce (p a) - liftOmittedField = coerce +-- | @since 2.2.3.0 +deriving via Identity instance FromJSON1 Semigroup.Product +-- | @since 2.2.3.0 +deriving via (a :: Type) instance FromJSON a => FromJSON (Semigroup.Product a) -instance (FromJSON a) => FromJSON (Semigroup.WrappedMonoid a) where - parseJSON = parseJSON1 +-- | @since 2.2.3.0 +deriving via Bool instance FromJSON Semigroup.All - parseJSONList = liftParseJSONList omittedField parseJSON parseJSONList - omittedField = omittedField1 +-- | @since 2.2.3.0 +deriving via Bool instance FromJSON Semigroup.Any #if !MIN_VERSION_base(4,16,0) -instance FromJSON1 Semigroup.Option where - liftParseJSON o = coerce (liftParseJSON @Maybe o) - liftOmittedField _ = Just (Semigroup.Option Nothing) - -instance FromJSON a => FromJSON (Semigroup.Option a) where - parseJSON = parseJSON1 - omittedField = omittedField1 +deriving via Maybe instance FromJSON1 Semigroup.Option +deriving via Maybe a instance FromJSON a => FromJSON (Semigroup.Option a) #endif ------------------------------------------------------------------------------- diff --git a/src/Data/Aeson/Types/ToJSON.hs b/src/Data/Aeson/Types/ToJSON.hs --- a/src/Data/Aeson/Types/ToJSON.hs +++ b/src/Data/Aeson/Types/ToJSON.hs @@ -1,18 +1,20 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DerivingVia #-} {-# LANGUAGE EmptyCase #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} module Data.Aeson.Types.ToJSON @@ -76,6 +78,7 @@ import Data.Functor.Product (Product(..)) import Data.Functor.Sum (Sum(..)) import Data.Functor.These (These1 (..)) +import Data.Kind (Type) import Data.List (intersperse) import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe (isNothing) @@ -364,7 +367,7 @@ instance value ~ Value => KeyValue Value (KM.KeyMap value) where (.=) = explicitToField toJSON {-# INLINE (.=) #-} - + explicitToField f name value = KM.singleton name (f value) {-# INLINE explicitToField #-} @@ -1641,14 +1644,7 @@ liftOmitField o (Identity a) = o a -instance (ToJSON a) => ToJSON (Identity a) where - toJSON = toJSON1 - toJSONList = liftToJSONList omitField toJSON toJSONList - - toEncoding = toEncoding1 - toEncodingList = liftToEncodingList omitField toEncoding toEncodingList - - omitField (Identity x) = omitField x +deriving via (a :: Type) instance ToJSON a => ToJSON (Identity a) instance (ToJSONKey a) => ToJSONKey (Identity a) where toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey @@ -2075,115 +2071,58 @@ ------------------------------------------------------------------------------- -- | @since 2.2.0.0 -instance ToJSON1 Down where - liftToJSON _ t _ = coerce t - liftToEncoding _ t _ = coerce t - liftOmitField = coerce +deriving via Identity instance ToJSON1 Down -- | @since 2.2.0.0 -instance ToJSON a => ToJSON (Down a) where - toJSON = toJSON1 - toEncoding = toEncoding1 - omitField = omitField1 +deriving via (a :: Type) instance ToJSON a => ToJSON (Down a) ------------------------------------------------------------------------------- -- base Monoid/Semigroup ------------------------------------------------------------------------------- -instance ToJSON1 Monoid.Dual where - liftToJSON _ t _ = t . Monoid.getDual - liftToEncoding _ t _ = t . Monoid.getDual - liftOmitField = coerce - -instance ToJSON a => ToJSON (Monoid.Dual a) where - toJSON = toJSON1 - toEncoding = toEncoding1 - omitField = omitField1 - -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 - omitField = omitField1 - -instance ToJSON1 Monoid.Last where - liftToJSON o t to' = liftToJSON o t to' . Monoid.getLast - liftToEncoding o t to' = liftToEncoding o t to' . Monoid.getLast - - liftOmitField :: forall a. (a -> Bool) -> Monoid.Last a -> Bool - liftOmitField _ = coerce (isNothing @a) +deriving via Identity instance ToJSON1 Monoid.Dual +deriving via (a :: Type) instance ToJSON a => ToJSON (Monoid.Dual a) -instance ToJSON a => ToJSON (Monoid.Last a) where - toJSON = toJSON1 - toEncoding = toEncoding1 - omitField = omitField1 +deriving via Maybe instance ToJSON1 Monoid.First +deriving via Maybe a instance ToJSON a => ToJSON (Monoid.First a) -instance ToJSON1 Semigroup.Min where - liftToJSON _ t _ (Semigroup.Min x) = t x - liftToEncoding _ t _ (Semigroup.Min x) = t x - liftOmitField = coerce +deriving via Maybe instance ToJSON1 Monoid.Last +deriving via Maybe a instance ToJSON a => ToJSON (Monoid.Last a) -instance ToJSON a => ToJSON (Semigroup.Min a) where - toJSON = toJSON1 - toEncoding = toEncoding1 - omitField = omitField1 +deriving via Identity instance ToJSON1 Semigroup.Min +deriving via (a :: Type) instance ToJSON a => ToJSON (Semigroup.Min a) +deriving via Identity instance ToJSON1 Semigroup.Max +deriving via (a :: Type) instance ToJSON a => ToJSON (Semigroup.Max a) -instance ToJSON1 Semigroup.Max where - liftToJSON _ t _ (Semigroup.Max x) = t x - liftToEncoding _ t _ (Semigroup.Max x) = t x - liftOmitField = coerce +deriving via Identity instance ToJSON1 Semigroup.First +deriving via (a :: Type) instance ToJSON a => ToJSON (Semigroup.First a) -instance ToJSON a => ToJSON (Semigroup.Max a) where - toJSON = toJSON1 - toEncoding = toEncoding1 - omitField = omitField1 +deriving via Identity instance ToJSON1 Semigroup.Last +deriving via (a :: Type) instance ToJSON a => ToJSON (Semigroup.Last a) -instance ToJSON1 Semigroup.First where - liftToJSON _ t _ (Semigroup.First x) = t x - liftToEncoding _ t _ (Semigroup.First x) = t x - liftOmitField = coerce +deriving via Identity instance ToJSON1 Semigroup.WrappedMonoid +deriving via (a :: Type) instance ToJSON a => ToJSON (Semigroup.WrappedMonoid a) -instance ToJSON a => ToJSON (Semigroup.First a) where - toJSON = toJSON1 - toEncoding = toEncoding1 - omitField = omitField1 +-- | @since 2.2.3.0 +deriving via Identity instance ToJSON1 Semigroup.Sum +-- | @since 2.2.3.0 +deriving via (a :: Type) instance ToJSON a => ToJSON (Semigroup.Sum a) -instance ToJSON1 Semigroup.Last where - liftToJSON _ t _ (Semigroup.Last x) = t x - liftToEncoding _ t _ (Semigroup.Last x) = t x - liftOmitField = coerce +-- | @since 2.2.3.0 +deriving via Identity instance ToJSON1 Semigroup.Product +-- | @since 2.2.3.0 +deriving via (a :: Type) instance ToJSON a => ToJSON (Semigroup.Product a) -instance ToJSON a => ToJSON (Semigroup.Last a) where - toJSON = toJSON1 - toEncoding = toEncoding1 - omitField = omitField1 +-- | @since 2.2.3.0 +deriving via Bool instance ToJSON Semigroup.All -instance ToJSON1 Semigroup.WrappedMonoid where - liftToJSON _ t _ (Semigroup.WrapMonoid x) = t x - liftToEncoding _ t _ (Semigroup.WrapMonoid x) = t x - liftOmitField = coerce - -instance ToJSON a => ToJSON (Semigroup.WrappedMonoid a) where - toJSON = toJSON1 - toEncoding = toEncoding1 - omitField = omitField1 +-- | @since 2.2.3.0 +deriving via Bool instance ToJSON Semigroup.Any #if !MIN_VERSION_base(4,16,0) -instance ToJSON1 Semigroup.Option where - liftToJSON o t to' = liftToJSON o t to' . Semigroup.getOption - liftToEncoding o t to' = liftToEncoding o t to' . Semigroup.getOption - liftOmitField _ = isNothing . Semigroup.getOption - -instance ToJSON a => ToJSON (Semigroup.Option a) where - toJSON = toJSON1 - toEncoding = toEncoding1 - omitField = omitField1 +deriving via Maybe instance ToJSON1 Semigroup.Option +deriving via Maybe a instance ToJSON a => ToJSON (Semigroup.Option a) #endif ------------------------------------------------------------------------------- diff --git a/tests/PropertyRoundTrip.hs b/tests/PropertyRoundTrip.hs --- a/tests/PropertyRoundTrip.hs +++ b/tests/PropertyRoundTrip.hs @@ -29,6 +29,7 @@ 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 @@ , 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)