aeson 2.2.5.1 → 2.3.2.0

raw patch · 35 files changed

Files

• LICENSE +1/−1
• README.markdown +0/−3
• aeson.cabal +13/−11
• changelog.md +24/−3
• src/Data/Aeson.hs +25/−3
• src/Data/Aeson/Decoding.hs +1/−1
• src/Data/Aeson/Decoding/ByteString.hs +1/−1
• src/Data/Aeson/Decoding/ByteString/Lazy.hs +1/−1
• src/Data/Aeson/Decoding/Conversion.hs +1/−1
• src/Data/Aeson/Decoding/Text.hs +1/−1
• src/Data/Aeson/Encoding/Internal.hs +1/−2
• src/Data/Aeson/Internal/Prelude.hs +0/−1
• src/Data/Aeson/Internal/Unescape.hs +1/−1
• src/Data/Aeson/Internal/UnescapeFromText.hs +1/−1
• src/Data/Aeson/Key.hs +2/−8
• src/Data/Aeson/KeyMap.hs +6/−7
• src/Data/Aeson/TH.hs +3/−3
• src/Data/Aeson/Text.hs +3/−3
• src/Data/Aeson/Types.hs +1/−0
• src/Data/Aeson/Types/FromJSON.hs +36/−16
• src/Data/Aeson/Types/Internal.hs +17/−11
• src/Data/Aeson/Types/ToJSON.hs +15/−1
• tests/DoubleToScientific.hs +1/−1
• tests/ErrorMessages.hs +5/−1
• tests/JSONTestSuite/results/n_array_spaces_vertical_tab_formfeed.tok +1/−1
• tests/JSONTestSuite/results/n_string_unescaped_ctrl_char.tok +1/−1
• tests/JSONTestSuite/results/n_string_unescaped_newline.tok +1/−1
• tests/JSONTestSuite/results/n_string_unescaped_tab.tok +1/−1
• tests/PropUtils.hs +1/−1
• tests/PropertyKeys.hs +3/−0
• tests/PropertyRoundTrip.hs +3/−0
• tests/Types.hs +7/−8
• tests/UnitTests.hs +2/−1
• tests/UnitTests/FromJSONKey.hs +25/−14
• tests/golden/simple.expected +2/−0

@@ -1,4 +1,4 @@-Copyright (c) 2011, MailRank, Inc. 2014-2021 Aeson project contributors+Copyright (c) 2011, MailRank, Inc. 2014-2026 Aeson project contributors  All rights reserved. 

@@ -20,9 +20,6 @@  * https://github.com/haskell/aeson/blob/master/changelog.md -(You can create and contribute changes using either git or Mercurial.)-- # Authors  This library was originally written by Bryan O'Sullivan.

@@ -1,16 +1,18 @@ cabal-version:      2.2 name:               aeson-version:            2.2.5.1+version:            2.3.2.0 license:            BSD-3-Clause license-file:       LICENSE category:           Text, Web, JSON copyright:-  (c) 2011-2016 Bryan O'Sullivan-  (c) 2011 MailRank, Inc.-+  2014-2026 Aeson project contributors,+  2011-2016 Bryan O'Sullivan,+  2011 MailRank, Inc. author:             Bryan O'Sullivan <bos@serpentine.com>-maintainer:         Adam Bergmark <adam@bergmark.nl>-stability:          experimental+maintainer:+  Li-yao Xia <lysxia@gmail.com>,+  Core Libraries Committee+stability:          stable tested-with:   GHC ==8.6.5    || ==8.8.4@@ -36,12 +38,12 @@   below.   .   (A note on naming: in Greek mythology, Aeson was the father of Jason.)-+extra-doc-files:+  README.markdown+  changelog.md extra-source-files:   *.yaml   benchmarks/json-data/*.json-  changelog.md-  README.markdown   tests/golden/*.expected   tests/JSONTestSuite/results/*.tok   tests/JSONTestSuite/results/*.txt@@ -130,7 +132,7 @@     , semialign             ^>=1.3      || ^>=1.4     , strict                ^>=0.5     , tagged                ^>=0.8.7-    , text-iso8601          ^>=0.1.1+    , text-iso8601          >=0.1.1 && < 0.3     , text-short            ^>=0.1.5     , th-abstraction        ^>=0.5.0.0  || ^>=0.6.0.0 || ^>=0.7.0.0     , these                 ^>=1.2@@ -238,7 +240,7 @@     build-depends: integer-gmp    if impl(ghc >=9.2 && <9.7)-    build-depends: nothunks >=0.1.4 && <0.3+    build-depends: nothunks >=0.1.4 && <0.4  source-repository head   type:     git

@@ -1,15 +1,36 @@ 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.3.2.0 - 2026-09-12++* Remove unsound rewrite rule on `FromJSONKey` (`fmap coerce = coerce`)+* Fix `listParser` to include list indices in error traces++### 2.3.1.0 - 2026-07-05++* Add `FromJSONKey` instance for `Data.Fixed`.+* Add `ToJSON` and `FromJSON` instances for `Data.Complex`.+* Export `isEmptyArray` from `Data.Aeson.Types` module.+* Document that file decoding functions throw an exception when the file is missing.++### 2.3.0.0 - 2026-05-21++* Fix DoS vulnerabilities caused by parsing large numbers (advisory [HSEC-2026-0007](https://haskell.github.io/security-advisories/advisory/HSEC-2026-0007.html)). Backported to 2.2.5.1, see below.+* Fix typo in error message: "~~Unespected~~ Unexpected control character while parsing string literal".+* Support nothunks 0.3.+* Unset executable permissions in some test files and remove a broken symlink.+* In `text-iso8601-0.2.0.0`:+    - Accept 24:00:00 time of day.+ ### 2.2.5.1 - 2026-08-29  Fix a DoS vulnerability caused by parsing large numbers (advisory [HSEC-2026-0007](https://haskell.github.io/security-advisories/advisory/HSEC-2026-0007.html)). Backported from 2.3.0.0 to ease migration. -* Fix parsing of fractional numbers to reject exponents smaller than -1024.+* (HSEC-2026-0007) Fix parsing of fractional numbers to reject exponents smaller than -1024.   This change affects `FromJSON` instances of `Fixed`, `DiffTime`, and `NominalDiffTime`,   rejecting more inputs. Error messages for `Ratio` and integral types are also slightly different   due to reusing the same bounding logic.-* In `text-iso8601-0.1.1.2`:-    - Reject years of more than 15 digits.+* In `text-iso8601-0.1.1.2` (backported from 0.2.0.0):+    - (HSEC-2026-0007) Reject years of more than 15 digits.  ### 2.2.5.0 

@@ -199,6 +199,11 @@ -- -- This function parses immediately, but defers conversion.  See -- 'json' for details.+--+-- Throws an exception when the file cannot be accessed+-- (e.g., it is missing or permissions are invalid).+-- This function uses 'Data.ByteString.readFile' without handling+-- any of its exceptions. decodeFileStrict :: (FromJSON a) => FilePath -> IO (Maybe a) decodeFileStrict = fmap decodeStrict . B.readFile @@ -226,12 +231,21 @@ -- If this fails due to incomplete or invalid input, 'Nothing' is -- returned. ----- Since @2.2.0.0@ an alias for 'decodeFileStrict'.+-- Throws an exception when the file cannot be accessed+-- (e.g., it is missing or permissions are invalid).+-- This function uses 'Data.ByteString.readFile' without handling+-- any of its exceptions. --+-- Since @2.2.0.0@ an alias for 'decodeFileStrict'. decodeFileStrict' :: (FromJSON a) => FilePath -> IO (Maybe a) decodeFileStrict' = decodeFileStrict  -- | Like 'decodeFileStrict' but returns an error message when decoding fails.+--+-- Throws an exception when the file cannot be accessed+-- (e.g., it is missing or permissions are invalid).+-- This function uses 'Data.ByteString.readFile' without handling+-- any of its exceptions. eitherDecodeFileStrict :: (FromJSON a) => FilePath -> IO (Either String a) eitherDecodeFileStrict =   fmap eitherDecodeStrict . B.readFile@@ -253,6 +267,11 @@  -- | Like 'decodeFileStrict'' but returns an error message when decoding fails. --+-- Throws an exception when the file cannot be accessed+-- (e.g., it is missing or permissions are invalid).+-- This function uses 'Data.ByteString.readFile' without handling+-- any of its exceptions.+-- -- Since @2.2.0.0@ an alias for 'eitherDecodeFileStrict'. eitherDecodeFileStrict' :: (FromJSON a) => FilePath -> IO (Either String a) eitherDecodeFileStrict' = eitherDecodeFileStrict@@ -367,7 +386,7 @@ -- --     \-- this encodes directly to a bytestring Builder --     'toEncoding' (Person name age) =---         'pairs' (\"name\" '.=' 'name' '<>' \"age\" '.=' age)+--         'pairs' (\"name\" '.=' name '<>' \"age\" '.=' age) -- @ -- -- We can now encode a value like so:@@ -517,7 +536,7 @@ -- -- @ --     'toEncoding' (Person name age) =---         'pairs' (\"name\" '.=' 'name' '<>' \"age\" '.=' age)+--         'pairs' (\"name\" '.=' name '<>' \"age\" '.=' age) -- @ -- -- Any container type that implements 'Foldable' can be encoded to a@@ -559,3 +578,6 @@ -- <https://hackage.haskell.org/package/time time>, -- and <https://hackage.haskell.org/package/text-iso8601 text-iso8601> -- (where the relevant parsers are defined).++-- $optionsFields+-- The functions here are in fact record fields of the 'Options' type.

@@ -1,6 +1,6 @@ {-# LANGUAGE RankNTypes          #-} {-# LANGUAGE ScopedTypeVariables #-}--- | Convertion to and from @aeson@ 'A.Value'.+-- | Conversion to and from @aeson@ 'A.Value'. --  module Data.Aeson.Decoding (     decode,

@@ -163,7 +163,7 @@         Just (_, bs') -> goEsc (n + 1) bs'      errEnd = err "Unexpected end-of-input while parsing string literal"-    errCC  = err "Unespected control character while parsing string literal"+    errCC  = err "Unexpected control character while parsing string literal"  ------------------------------------------------------------------------------- -- Number

@@ -169,7 +169,7 @@         Just (_, bs') -> goEsc (n + 1) bs'      errEnd = err "Unexpected end-of-input while parsing string literal"-    errCC  = err "Unespected control character while parsing string literal"+    errCC  = err "Unexpected control character while parsing string literal"  ------------------------------------------------------------------------------- -- Number

@@ -87,7 +87,7 @@         -> (e -> r)         -> ([(Key, A.Value)] -> k -> r)         -> r-    -- here we don't stricly need bang on !v as KM is a Strict (in values) map.+    -- here we don't strictly need bang on !v as KM is a Strict (in values) map.     -- but we force the value sooner.     goR !acc (TkPair t toks) g f = convert toks g $ \ !v k -> goR ((t , v) : acc) k g f     goR !acc (TkRecordEnd k) _ f = f acc k

@@ -173,7 +173,7 @@         Just (_, bs') -> goEsc (n + 1) bs'      errEnd = err "Unexpected end-of-input while parsing string literal"-    errCC  = err "Unespected control character while parsing string literal"+    errCC  = err "Unexpected control character while parsing string literal"  ------------------------------------------------------------------------------- -- Number

@@ -82,7 +82,7 @@ newtype Encoding' tag = Encoding {       fromEncoding :: Builder       -- ^ Acquire the underlying bytestring builder.-    } deriving (Typeable)+    }  -- | Often used synonym for 'Encoding''. type Encoding = Encoding' Value@@ -128,7 +128,6 @@ -- > toEncoding (Person name age) = pairs ("name" .= name <> "age" .= age) data Series = Empty             | Value (Encoding' Series)-            deriving (Typeable)  pair :: Key -> Encoding -> Series pair name val = pair' (key name) val

@@ -21,7 +21,6 @@ import Data.String as X (IsString(..)) import Data.Text as X (Text) import Data.Time as X (UTCTime)-import Data.Typeable as X (Typeable) import Data.Vector as X (Vector) import Data.Void as X (Void, absurd) import Data.Word as X (Word8, Word16, Word32, Word64)

@@ -29,7 +29,7 @@  -- | Unescape JSON text literal. ----- This function is exporeted mostly for testing and benchmarking purposes.+-- This function is exported mostly for testing and benchmarking purposes. unescapeText :: ByteString -> Either UnicodeException Text unescapeText = unsafeDupablePerformIO . try . unescapeTextIO 

@@ -24,7 +24,7 @@  -- | Unescape JSON text literal. ----- This function is exporeted mostly for testing and benchmarking purposes.+-- This function is exported mostly for testing and benchmarking purposes. unescapeFromText :: Text -> Either UnicodeException Text unescapeFromText = unsafeDupablePerformIO . try . unescapeFromTextIO 

@@ -32,7 +32,6 @@ import Data.Semigroup (Semigroup((<>))) import Data.Text (Text) import Data.Type.Coercion (Coercion (..))-import Data.Typeable (Typeable) import Text.Read (Read (..))  import qualified Data.String@@ -42,7 +41,7 @@ import qualified Test.QuickCheck as QC  newtype Key = Key { unKey :: Text }-  deriving (Typeable, Data)+  deriving (Data)  fromString :: String -> Key fromString = Key . T.pack@@ -56,12 +55,7 @@ toText :: Key -> Text toText = unKey --- | @'coercing r1 r2'@ will evaluate to @r1@ if 'Key' is 'Coercible' to  'Text',--- and to @r2@ otherwise.------ Using 'coercing' we can make more efficient implementations--- when 'Key' is backed up by 'Text' without exposing internals.---+-- | Partially exposed coercion for forwards compatibility. coercionToText :: Maybe (Coercion Key Text) coercionToText = Just Coercion {-# INLINE coercionToText #-}

@@ -114,7 +114,6 @@ import Data.Text (Text) import Data.These (These (..)) import Data.Type.Coercion (Coercion (..))-import Data.Typeable (Typeable) import Text.Read (Read (..), Lexeme(..), readListPrecDefault, prec, lexP, parens)  import qualified Data.Aeson.Key as Key@@ -139,9 +138,9 @@ -- Map ------------------------------------------------------------------------------- --- | A map from JSON key type 'Key' to 'v'.+-- | A map from JSON key type 'Key' to @v@. newtype KeyMap v = KeyMap { unKeyMap :: Map Key v }-  deriving (Eq, Ord, Typeable, Data, Functor)+  deriving (Eq, Ord, Data, Functor)   -- | Construct an empty map.@@ -269,7 +268,7 @@ difference tm1 tm2 = KeyMap (M.difference (unKeyMap tm1) (unKeyMap tm2))  -- | The (left-biased) union of two maps. It prefers the first map when duplicate--- keys are encountered, i.e. ('union' == 'unionWith' 'const').+-- keys are encountered, i.e. ('union' == 'unionWith' 'Prelude.const'). union :: KeyMap v -> KeyMap v -> KeyMap v union (KeyMap x) (KeyMap y) = KeyMap (M.union x y) @@ -353,9 +352,9 @@ import Data.Ord (comparing) import Prelude (fst) --- | A map from JSON key type 'Key' to 'v'.+-- | A map from JSON key type 'Key' to @v@. newtype KeyMap v = KeyMap { unKeyMap :: HashMap Key v }-  deriving (Eq, Ord, Typeable, Data, Functor)+  deriving (Eq, Ord, Data, Functor)  -- | Construct an empty map. empty :: KeyMap v@@ -478,7 +477,7 @@ difference tm1 tm2 = KeyMap (H.difference (unKeyMap tm1) (unKeyMap tm2))  -- | The (left-biased) union of two maps. It prefers the first map when duplicate--- keys are encountered, i.e. ('union' == 'unionWith' 'const').+-- keys are encountered, i.e. ('union' == 'unionWith' 'Prelude.const'). union :: KeyMap v -> KeyMap v -> KeyMap v union (KeyMap x) (KeyMap y) = KeyMap (H.union x y) 

@@ -591,7 +591,7 @@ deriveFromJSON2 :: Options                 -- ^ Encoding options.                 -> Name-                -- ^ Name of the type for which to generate a 'FromJSON3' instance+                -- ^ Name of the type for which to generate a 'FromJSON2' instance                 -- declaration.                 -> Q [Dec] deriveFromJSON2 = deriveFromJSONCommon fromJSON2Class@@ -955,7 +955,7 @@              | (field, argTy) <- zip fields argTys              ] --- A hack, as I'm too lazy to changge code to not assume fields are non empty.+-- A hack, as I'm too lazy to change code to not assume fields are non empty. nonEmpty :: [a] -> (a, [a]) nonEmpty (x:xs) = (x,xs) nonEmpty []     = error "unexpected empty list"@@ -1276,7 +1276,7 @@     varE $ case M.lookup tyName tvMap of                 Just (tfjoExp, tfjExp, tfjlExp) -> case list of                     Omit -> tfjoExp-                    Single -> tfjExp +                    Single -> tfjExp                     Plural -> tfjlExp                 Nothing                   -> jsonFunValOrListName list jf Arity0 dispatchFunByType jc jf conName tvMap list (SigT ty _) =

@@ -10,7 +10,7 @@ -- Portability: portable -- -- Most frequently, you'll probably want to encode straight to UTF-8--- (the standard JSON encoding) using 'encode'.+-- (the standard JSON encoding) using 'Data.Aeson.encode'. -- -- You can use the conversions to 'Builder's when embedding JSON messages as -- parts of a protocol.@@ -47,8 +47,8 @@ -- embedded efficiently in a text-based protocol. -- -- If you are going to immediately encode straight to a--- 'L.ByteString', it is more efficient to use 'encode' (lazy ByteString)--- or @'fromEncoding' . 'toEncoding'@ (ByteString.Builder) instead.+-- 'Data.ByteString.Lazy.ByteString', it is more efficient to use 'Data.Aeson.encode' (lazy ByteString)+-- or @'Data.Aeson.fromEncoding' . 'toEncoding'@ ('Builder') instead. -- -- /Note:/ Uses 'toJSON' encodeToTextBuilder :: ToJSON a => a -> Builder

@@ -20,6 +20,7 @@     , Series     , Array     , emptyArray+    , isEmptyArray     , Pair     , Object     , emptyObject

@@ -95,6 +95,7 @@ import Data.Aeson.Types.Generic import Data.Aeson.Types.Internal import Data.Bits (unsafeShiftR)+import Data.Complex (Complex(..)) import Data.Fixed (Fixed, HasResolution (resolution), Nano) import Data.Functor.Compose (Compose(..)) import Data.Functor.Identity (Identity(..))@@ -216,16 +217,22 @@     (\sci rest -> if T.null rest then return sci else fail $ "Expecting end-of-input, got " ++ show (T.take 10 rest))     fail -parseIntegralText :: Integral a => String -> Text -> Parser a-parseIntegralText name t =+parseBoundedScientificTextTo :: (Scientific -> Parser a) -> String -> Text -> Parser a+parseBoundedScientificTextTo toResultType name t =     prependContext name $             parseScientificText t         >>= rejectLargeExponent-        >>= parseIntegralFromScientific+        >>= toResultType   where     rejectLargeExponent :: Scientific -> Parser Scientific     rejectLargeExponent s = withBoundedScientific' pure (Number s) +parseBoundedScientificText :: String -> Text -> Parser Scientific+parseBoundedScientificText = parseBoundedScientificTextTo pure++parseIntegralText :: Integral a => String -> Text -> Parser a+parseIntegralText = parseBoundedScientificTextTo parseIntegralFromScientific+ parseBoundedIntegralText :: (Bounded a, Integral a) => String -> Text -> Parser a parseBoundedIntegralText name t =     prependContext name $@@ -463,11 +470,10 @@     fmap h (FromJSONKeyValue f)      = FromJSONKeyValue (fmap h . f)  -- | Construct 'FromJSONKeyFunction' for types coercible from 'Text'. This--- conversion is still unsafe, as 'Hashable' and 'Eq' instances of @a@ should be+-- conversion is still unsafe, as 'Hashable', 'Eq', and 'Ord' instances of @a@ should be -- compatible with 'Text' i.e. hash values should be equal for wrapped values as well.--- This property will always be maintained if the 'Hashable' and 'Eq' instances+-- This property will always be maintained if the 'Hashable', 'Eq', and 'Ord' instances -- are derived with generalized newtype deriving.--- compatible with 'Text' i.e. hash values be equal for wrapped values as well. -- -- On pre GHC 7.8 this is unconstrained function. fromJSONKeyCoerce ::@@ -475,19 +481,16 @@     FromJSONKeyFunction a fromJSONKeyCoerce = FromJSONKeyCoerce --- | Semantically the same as @coerceFromJSONKeyFunction = fmap coerce = coerce@.+-- | Coerce the result of a 'FromJSONKeyFunction'. ----- See note on 'fromJSONKeyCoerce'.+-- __Warning__: This function is unsafe when the argument is+-- 'fromJSONKeyCoerce'. It can break internal invariants of maps.+-- See also the note on 'fromJSONKeyCoerce'. coerceFromJSONKeyFunction ::     Coercible a b =>     FromJSONKeyFunction a -> FromJSONKeyFunction b coerceFromJSONKeyFunction = coerce -{-# RULES-  "FromJSONKeyCoerce: fmap coerce" forall x .-                                   fmap coerce x = coerceFromJSONKeyFunction x-  #-}- -- | Same as 'fmap'. Provided for the consistency with 'ToJSONKeyFunction'. mapFromJSONKeyFunction :: (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b mapFromJSONKeyFunction = fmap@@ -683,7 +686,7 @@  -- | Helper function to use with 'liftParseJSON'. See 'Data.Aeson.ToJSON.listEncoding'. listParser :: (Value -> Parser a) -> Value -> Parser [a]-listParser f (Array xs) = fmap V.toList (V.mapM f xs)+listParser f (Array xs) = fmap V.toList (V.imapM (\i x -> f x <?> Index i) xs) listParser _ v          = typeMismatch "Array" v {-# INLINE listParser #-} @@ -1315,7 +1318,7 @@ --------------------------------------------------------------------------------  -- | Constructors need to be decoded differently depending on whether they're--- a record or not. This distinction is made by 'ConsParseJSON'.+-- a record or not. This distinction is made by 'ConsFromJSON'. class ConsFromJSON arity f where     consParseJSON         :: ConName :* TypeName :* Options :* FromArgs arity a@@ -1718,6 +1721,17 @@             then fail "Ratio denominator was 0"             else pure $ numerator % denominator +-- | A complex number @x+iy@ is encoded as an array @[x, y]@.+--+-- @since 2.3.1.0+instance FromJSON a => FromJSON (Complex a) where+    parseJSON = withArray "Complex" $ \c ->+        let n = V.length c+        in if n == 2+           then (:+) <$> parseJSONElemAtIndex parseJSON 0 c+                     <*> parseJSONElemAtIndex parseJSON 1 c+           else fail $ "cannot unpack array of length " ++ show n ++ "into a Complex"+ -- | This instance includes a bounds check to prevent maliciously -- large inputs to fill up the memory of the target system. You can -- newtype 'Scientific' and provide your own instance using@@ -1725,6 +1739,12 @@ instance HasResolution a => FromJSON (Fixed a) where     parseJSON = prependContext "Fixed" . withBoundedScientific' (pure . realToFrac) +-- |+-- @since 2.3.1.0+instance HasResolution a => FromJSONKey (Fixed a) where+  fromJSONKey = FromJSONKeyTextParser $ \t ->+      realToFrac <$> parseBoundedScientificText "Fixed" t+ instance FromJSON Int where     parseJSON = parseBoundedIntegral "Int" @@ -2467,7 +2487,7 @@  instance FromJSONKey b => FromJSONKey (Tagged a b) where     fromJSONKey = coerceFromJSONKeyFunction (fromJSONKey :: FromJSONKeyFunction b)-    fromJSONKeyList = (fmap . fmap) Tagged fromJSONKeyList+    fromJSONKeyList = coerce (fromJSONKeyList @b)  ------------------------------------------------------------------------------- -- these

@@ -112,18 +112,18 @@                      | Index {-# UNPACK #-} !Int                        -- ^ JSON path element of an index into an                        -- array, \"array[index]\".-                       deriving (Eq, Show, Typeable, Ord)+                       deriving (Eq, Show, Ord) type JSONPath = [JSONPathElement]  -- | The internal result of running a 'Parser'. data IResult a = IError JSONPath String                | ISuccess a-               deriving (Eq, Show, Typeable)+               deriving (Eq, Show)  -- | The result of running a 'Parser'. data Result a = Error String               | Success a-                deriving (Eq, Show, Typeable)+                deriving (Eq, Show)  instance NFData JSONPathElement where   rnf (Key t)   = rnf t@@ -277,7 +277,7 @@ -- i.e. a parser to which the input has already been applied. newtype Parser a = Parser {       runParser :: forall f r.-                   JSONPath+                   JSONPath       -- Note: the path is accumulated in reverse: <?> cons new elements, however `fail` (and other functions) will reverse the path before calling the failure continuation.                 -> Failure f r                 -> Success a f r                 -> f r@@ -369,7 +369,7 @@            | Number !Scientific            | Bool !Bool            | Null-             deriving (Eq, Read, Typeable, Data, Generic)+             deriving (Eq, Read, Data, Generic)  -- | Since version 1.5.6.0 version object values are printed in lexicographic key order --@@ -488,7 +488,9 @@ -- The ordering is total, consistent with 'Eq' instance. -- However, nothing else about the ordering is specified, -- and it may change from environment to environment and version to version--- of either this package or its dependencies ('hashable' and 'unordered-containers').+-- of either this package or its dependencies+-- (<https://hackage.haskell.org/package/hashable hashable> and+-- <https://hackage.haskell.org/package/unordered-containers unordered-containers>). -- -- @since 1.5.2.0 deriving instance Ord Value@@ -505,7 +507,7 @@ newtype DotNetTime = DotNetTime {       fromDotNetTime :: UTCTime       -- ^ Acquire the underlying value.-    } deriving (Eq, Ord, Read, Show, Typeable, FormatTime)+    } deriving (Eq, Ord, Read, Show, FormatTime)  instance NFData Value where     rnf (Object o) = rnf o@@ -552,8 +554,12 @@ emptyArray :: Value emptyArray = Array V.empty --- | Determines if the 'Value' is an empty 'Array'.--- Note that: @isEmptyArray 'emptyArray'@.+-- | Determines whether the 'Value' is an empty 'Array'.+--+-- Do note that if this is `False`, the `Value` may be a non-empty+-- array, or it may not even be an array.+--+-- @since 2.3.1.0 isEmptyArray :: Value -> Bool isEmptyArray (Array arr) = V.null arr isEmptyArray _ = False@@ -727,7 +733,7 @@       -- 'allowOmittedFieds' controls parsing behavior.     , allowOmittedFields :: Bool       -- ^ If 'True', missing fields of a record will be filled-      -- with 'omittedField' values (if they are 'Just').+      -- with 'Data.Aeson.FromJSON.omittedField' values (if they are 'Just').       -- If 'False', all fields will required to present in the record object.     , sumEncoding :: SumEncoding       -- ^ Specifies how to encode constructors of a sum datatype.@@ -881,7 +887,7 @@ -- | Converts from CamelCase to another lower case, interspersing --   the character between all capital letters and their previous --   entries, except those capital letters that appear together,---   like 'API'.+--   like \"API\". -- --   For use by Aeson template haskell calls. --

@@ -69,6 +69,7 @@ import qualified Data.Aeson.Key as Key import qualified Data.Aeson.KeyMap as KM import Data.Bits (unsafeShiftR)+import Data.Complex (Complex(..)) import Data.DList (DList) import Data.Fixed (Fixed, HasResolution, Nano) import Data.Foldable (toList)@@ -466,7 +467,7 @@ --   >   deriving (Show,Read,Eq,Ord) -- --   It is possible to get the 'ToJSONKey' instance for free as we did---   with 'Foo'. However, in this case, we have a natural way to go to+--   with @Foo@. However, in this case, we have a natural way to go to --   and from 'Text' that does not require any escape sequences. So --   'ToJSONKeyText' can be used instead of 'ToJSONKeyValue' to encode maps --   as objects instead of arrays of pairs. This instance may be@@ -1424,6 +1425,19 @@         "numerator" .= numerator r <>         "denominator" .= denominator r +-- | A complex number @x+iy@ is encoded as an array @[x, y]@.+--+-- @since 2.3.1.0+instance ToJSON a => ToJSON (Complex a) where+    toJSON (i :+ q) = Array $ V.create $ do+        mv <- VM.unsafeNew 2+        VM.unsafeWrite mv 0 (toJSON i)+        VM.unsafeWrite mv 1 (toJSON q)+        return mv+    toEncoding (i :+ q) = E.list id+        [ toEncoding i+        , toEncoding q+        ]  instance HasResolution a => ToJSON (Fixed a) where     toJSON = Number . realToFrac

@@ -114,7 +114,7 @@     (s, e, lower_boundary_is_closer) = decodeFloat' v     lowerBoundaryCloser' = if lower_boundary_is_closer then lowerBoundaryCloser else id --- | return significant, exponent and whether lower boundery is closer.+-- | return significand, exponent and whether lower boundary is closer. -- -- GHC's decodeFloat does "weird" stuff to denormal doubles, -- that messes up our delta calculation.

@@ -11,7 +11,7 @@ import Prelude.Compat  import Data.Aeson (FromJSON(..), Value, eitherDecode)-import Data.Aeson.Types (Parser, parseEither)+import Data.Aeson.Types (Parser, listParser, parseEither) import Data.Algorithm.Diff (PolyDiff (..), getGroupedDiff) import Data.Proxy (Proxy(..)) @@ -75,6 +75,10 @@     -- issue #358   , testFor "Seq" (Proxy :: Proxy (Seq Int))       [ "[0,1,true]"+      ]++  , testWith "listParser" (listParser parseJSON :: Value -> Parser [Int])+      [ "[true]"       ]   ] 

@@ -1,3 +1,3 @@ TkArrayOpen TkItem-TkErr "Unespected control character while parsing string literal"+TkErr "Unexpected control character while parsing string literal"

@@ -1,3 +1,3 @@ TkArrayOpen TkItem-TkErr "Unespected control character while parsing string literal"+TkErr "Unexpected control character while parsing string literal"

@@ -1,3 +1,3 @@ TkArrayOpen TkItem-TkErr "Unespected control character while parsing string literal"+TkErr "Unexpected control character while parsing string literal"

@@ -1,3 +1,3 @@ TkArrayOpen TkItem-TkErr "Unespected control character while parsing string literal"+TkErr "Unexpected control character while parsing string literal"

@@ -31,7 +31,7 @@  import Data.Aeson (eitherDecode, encode) import Data.Aeson.Encoding (encodingToLazyByteString)-import Data.Aeson.Types+import Data.Aeson.Types hiding (isEmptyArray) import qualified Data.Aeson.Key as Key import qualified Data.Aeson.KeyMap as KM import Data.HashMap.Strict (HashMap)

@@ -6,6 +6,7 @@ import Prelude.Compat  import Control.Applicative (Const)+import Data.Fixed (Fixed, E3, E6) import Data.Time.Compat (Day, LocalTime, TimeOfDay, UTCTime) import Data.Time.Calendar.Compat (DayOfWeek) import Data.Time.Calendar.Month.Compat (Month)@@ -47,4 +48,6 @@     , testProperty "Lazy Text"     $ roundTripKey @LT.Text     , testProperty "UUID"          $ roundTripKey @UUID.UUID     , testProperty "Const Text"    $ roundTripKey @(Const T.Text ())+    , testProperty "Fixed E3"      $ roundTripKey @(Fixed E3)+    , testProperty "Fixed E6"      $ roundTripKey @(Fixed E6)     ]

@@ -7,6 +7,7 @@  import Control.Applicative (Const) import Data.Aeson.Types+import Data.Complex (Complex(..)) import Data.DList (DList) import Data.List.NonEmpty (NonEmpty) import Data.Map (Map)@@ -81,6 +82,8 @@     , testProperty "Seq" $ roundTripEq @(Seq Int)     , testProperty "Rational" $ roundTripEq @Rational     , testProperty "Ratio Int" $ roundTripEq @(Ratio Int)+    , testProperty "Complex Float" $ roundTripEq @(Complex Float)+    , testProperty "Complex Double" $ roundTripEq @(Complex Double)     , testProperty "UUID" $ roundTripEq @UUID.UUID     , testProperty "These" $ roundTripEq @(These Char Bool)     , testProperty "Fix" $ roundTripEq @(F.Fix (These Char))

@@ -41,32 +41,32 @@     -- This definition causes an infinite loop in genericTo and genericFrom!     -- , fooMap :: Map.Map String Foo     , fooMap :: Map.Map String (Text,Int)-    } deriving (Show, Typeable, Data)+    } deriving (Show, Data)  data UFoo = UFoo {       _UFooInt :: Int     , uFooInt :: Int-    } deriving (Show, Eq, Data, Typeable)+    } deriving (Show, Eq, Data)  data NoConstructors  data OneConstructor = OneConstructor-                      deriving (Show, Eq, Typeable, Data)+                      deriving (Show, Eq, Data)  data Product2 a b = Product2 a b-                    deriving (Show, Eq, Typeable, Data)+                    deriving (Show, Eq, Data)  data Product6 a b c d e f = Product6 a b c d e f-                    deriving (Show, Eq, Typeable, Data)+                    deriving (Show, Eq, Data)  data Sum4 a b c d = Alt1 a | Alt2 b | Alt3 c | Alt4 d-                    deriving (Show, Eq, Typeable, Data)+                    deriving (Show, Eq, Data)  class ApproxEq a where     (=~) :: a -> a -> Bool  newtype Approx a = Approx { fromApprox :: a }-    deriving (Show, Data, Typeable, ApproxEq, Num)+    deriving (Show, Data, ApproxEq, Num)  instance (ApproxEq a) => Eq (Approx a) where     Approx a == Approx b = a =~ b@@ -93,7 +93,6 @@  data GADT a where     GADT :: { gadt :: String } -> GADT String-  deriving Typeable  deriving instance Data (GADT String) deriving instance Eq   (GADT a)

@@ -88,7 +88,8 @@   _    -> s -- shouldn't happen?   where     split c' s' = map L.unpack $ L.split c' $ L.pack s'-    capitalize t = toUpper (head t) : tail t+    capitalize []     = []+    capitalize (x:xs) = toUpper x : xs   data Wibble = Wibble {

@@ -1,8 +1,11 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DerivingVia, GADTs, GeneralizedNewtypeDeriving, OverloadedStrings #-} module UnitTests.FromJSONKey (fromJSONKeyTests) where  import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (testCase, Assertion, assertFailure)+import Test.Tasty.HUnit (testCase, Assertion, assertFailure, (@?=))+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Ord (Down(..)) import Data.Text (Text) import Data.Tagged (Tagged) import Control.Applicative (Const)@@ -18,6 +21,15 @@     fromJSONKey = fmap MyText' fromJSONKey     fromJSONKeyList = error "not used" +newtype DownText = DownText Text+  deriving (Eq, Ord) via (Down Text)+  deriving FromJSON via Text++-- Regression test for #1169: don't rewrite fmap coerce to coerce+instance FromJSONKey DownText where+  fromJSONKey = fmap w fromJSONKey+    where w = DownText ; {-# NOINLINE w #-}+ fromJSONKeyTests :: TestTree fromJSONKeyTests = testGroup "FromJSONKey" $ fmap (testCase "-") fromJSONKeyAssertions @@ -27,23 +39,22 @@     , assertIsCoerce  "Tagged Int Text" (fromJSONKey :: FromJSONKeyFunction (Tagged Int Text))     , assertIsCoerce  "MyText"          (fromJSONKey :: FromJSONKeyFunction MyText) -    , assertIsCoerce' "MyText'"         (fromJSONKey :: FromJSONKeyFunction MyText')+    , assertIsText    "MyText'"         (fromJSONKey :: FromJSONKeyFunction MyText')     , assertIsCoerce  "Const Text"      (fromJSONKey :: FromJSONKeyFunction (Const Text ()))++    , assertDecodedMapIsValid     ]   where     assertIsCoerce :: String -> FromJSONKeyFunction a -> Assertion     assertIsCoerce _ FromJSONKeyCoerce = pure ()     assertIsCoerce n _                 = assertFailure n -    assertIsCoerce' :: String -> FromJSONKeyFunction a -> Assertion-    assertIsCoerce' _ FromJSONKeyCoerce = pure ()-    assertIsCoerce' n _                 = pickWithRules (assertFailure n) (pure ())+    assertIsText :: String -> FromJSONKeyFunction a -> Assertion+    assertIsText _ (FromJSONKeyText _) = pure ()+    assertIsText n _               = assertFailure n --- | Pick the first when RULES are enabled, e.g. optimisations are on-pickWithRules-    :: a -- ^ Pick this when RULES are on-    -> a -- ^ use this otherwise-    -> a-pickWithRules _ = id-{-# NOINLINE pickWithRules #-}-{-# RULES "pickWithRules/rule" [0] forall x. pickWithRules x = const x #-}+-- Regression test for #1169 (see FromJSONKey DownText)+assertDecodedMapIsValid :: Assertion+assertDecodedMapIsValid = fmap Map.valid decodedMap @?= Just True+  where+    decodedMap = decode "{\"a\":\"a\",\"b\":\"b\"}" :: Maybe (Map DownText Text)

@@ -20,3 +20,5 @@ Error in $[1].Left[1]: expected Bool, but encountered Number Seq Error in $[2]: parsing Int failed, expected Number, but encountered Boolean+listParser+Error in $[0]: parsing Int failed, expected Number, but encountered Boolean