aeson 2.2.3.0 → 2.3.1.0
raw patch · 33 files changed
Files
- LICENSE +1/−1
- README.markdown +1/−4
- aeson.cabal +33/−31
- changelog.md +32/−4
- src/Data/Aeson.hs +9/−2
- src/Data/Aeson/Decoding.hs +1/−1
- src/Data/Aeson/Decoding/ByteString.hs +4/−2
- src/Data/Aeson/Decoding/ByteString/Lazy.hs +4/−2
- src/Data/Aeson/Decoding/Conversion.hs +1/−1
- src/Data/Aeson/Decoding/Text.hs +5/−3
- 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 +1/−2
- src/Data/Aeson/KeyMap.hs +8/−3
- src/Data/Aeson/TH.hs +9/−4
- src/Data/Aeson/Types.hs +1/−0
- src/Data/Aeson/Types/FromJSON.hs +32/−13
- src/Data/Aeson/Types/Internal.hs +11/−7
- src/Data/Aeson/Types/ToJSON.hs +15/−1
- tests/DoubleToScientific.hs +1/−1
- tests/Instances.hs +10/−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/Regression/Issue1138.hs +23/−0
- tests/Types.hs +7/−8
- tests/UnitTests.hs +19/−10
LICENSE view
@@ -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.
README.markdown view
@@ -14,14 +14,11 @@ Master [git repository](http://github.com/haskell/aeson): -* `git clone git://github.com/haskell/aeson.git`+* `git clone https://github.com/haskell/aeson.git` See what's changed in recent (and upcoming) releases: * https://github.com/haskell/aeson/blob/master/changelog.md--(You can create and contribute changes using either git or Mercurial.)- # Authors
aeson.cabal view
@@ -1,16 +1,18 @@ cabal-version: 2.2 name: aeson-version: 2.2.3.0+version: 2.3.1.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@@ -18,9 +20,11 @@ || ==9.0.2 || ==9.2.8 || ==9.4.8- || ==9.6.5- || ==9.8.2- || ==9.10.1+ || ==9.6.6+ || ==9.8.4+ || ==9.10.3+ || ==9.12.4+ || ==9.14.1 synopsis: Fast JSON parsing and encoding homepage: https://github.com/haskell/aeson@@ -34,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@@ -94,19 +98,20 @@ build-depends: , base >=4.12.0.0 && <5 , bytestring >=0.10.8.2 && <0.13- , containers >=0.6.0.1 && <0.8+ , containers >=0.6.0.1 && <0.9 , deepseq >=1.4.4.0 && <1.6 , exceptions >=0.10.4 && <0.11- , ghc-prim >=0.5.0.0 && <0.12- , template-haskell >=2.14.0.0 && <2.23+ , template-haskell >=2.14.0.0 && <2.25 , text >=1.2.3.0 && <1.3 || >=2.0 && <2.2- , time >=1.8.0.2 && <1.13+ , time >=1.8.0.2 && <1.16 -- Compat build-depends:- , generically >=0.1 && <0.2 , time-compat >=1.9.6 && <1.10 + if !impl(ghc >=9.4)+ build-depends: generically >=0.1 && <0.2+ if !impl(ghc >=9.0) build-depends: integer-gmp @@ -115,26 +120,26 @@ , character-ps ^>=0.1 , data-fix ^>=0.3.2 , dlist ^>=1.0- , hashable ^>=1.4.6.0+ , hashable ^>=1.4.6.0 || ^>=1.5.0.0 , indexed-traversable ^>=0.1.2 , integer-conversion ^>=0.1 , integer-logarithms ^>=1.0.3.1 , network-uri ^>=2.6.4.1 , OneTuple ^>=0.4.1.1 , primitive ^>=0.8.0.0 || ^>=0.9.0.0- , QuickCheck ^>=2.14.3 || ^>=2.15+ , QuickCheck ^>=2.14.3 || ^>=2.15 || ^>=2.16.0.0 || ^>=2.17.1.0 || ^>=2.18.0.0 , scientific ^>=0.3.7.0- , semialign ^>=1.3+ , 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 , unordered-containers ^>=0.2.10.0 , uuid-types ^>=1.0.5 , vector ^>=0.13.0.0- , witherable ^>=0.4.2 || ^>=0.5+ , witherable ^>=0.4.2 || ^>=0.5 ghc-options: -Wall @@ -174,6 +179,7 @@ Regression.Issue571 Regression.Issue687 Regression.Issue967+ Regression.Issue1138 RFC8785 SerializationFormatSpec Types@@ -201,22 +207,19 @@ , bytestring , containers , data-fix- , deepseq- , Diff >=0.4 && <0.6+ , Diff >=0.4 && <0.6 || ^>=1.0.2 , directory , dlist , filepath , generic-deriving >=1.10 && <1.15 , generically- , ghc-prim >=0.2 , hashable , indexed-traversable , integer-logarithms >=1 && <1.1 , network-uri , OneTuple- , primitive- , QuickCheck >=2.14.2 && <2.16- , quickcheck-instances >=0.3.29 && <0.4+ , QuickCheck+ , quickcheck-instances >=0.3.29 && <0.5 , scientific , strict , tagged@@ -224,7 +227,6 @@ , tasty-golden , tasty-hunit , tasty-quickcheck- , template-haskell , text , text-short , these@@ -238,8 +240,8 @@ 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- location: git://github.com/haskell/aeson.git+ location: https://github.com/haskell/aeson.git
changelog.md view
@@ -1,5 +1,33 @@ 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.1.0++* 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 parsing of fractional numbers to reject exponents smaller than -1024.+ This breaking 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.+* 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`:+ - Reject years of more than 15 digits.+ - Accept 24:00:00 time of day.++### 2.2.5.0++* Support `semialign-1.4`++### 2.2.4.0++* Check for control characters in text literals everywhere+ ### 2.2.3.0 * Support `hashable-1.4.6.0`.@@ -26,7 +54,7 @@ One gotcha is that internal `Text` values (in `Key`s or `Value` `String`s) will most likely retain the original input `Text` value (its underlying `Array`). It shouldn't be an issue if the `Value` is then decoded to something else so these- `Text` values disapper, but if not (e.g. `Object` keys survive)+ `Text` values disappear, but if not (e.g. `Object` keys survive) then users might want to use `Data.Text.copy`. ### 2.2.0.0@@ -46,7 +74,7 @@ In addition to `Maybe` (and `Option`) fields the `Data.Monoid.First` and `Data.Monoid.Last` are also omitted, as well as the most newtype wrappers, when their wrap omittable type (e.g. newtypes in `Data.Monoid` and `Data.Semigroup`, `Identity`, `Const`, `Tagged`, `Compose`).- Additionall "boring" types like `()` and `Proxy` are omitted as well.+ Additionally "boring" types like `()` and `Proxy` are omitted as well. As the omitting is now uniform, type arguments are also omitted (also in `Generic1` derived instance). Resolves issues:@@ -64,7 +92,7 @@ * Move `Data.Aeson.Parser` module into separate [`attoparsec-aeson`](https://hackage.haskell.org/package/attoparsec-aeson) package, as these parsers are not used by `aeson` itself anymore. * Use [`text-iso8601`](https://hackage.haskell.org/package/text-iso8601) package for parsing `time` types. These are slightly faster than previously used (copy of) `attoparsec-iso8601`. Formats accepted is slightly changed:- - The space between time and timezone offset (in `UTCTime` and `ZonedTime`) is disallowed. ISO8601 explictly forbidds it.+ - The space between time and timezone offset (in `UTCTime` and `ZonedTime`) is disallowed. ISO8601 explicitly forbids it. - The timezone offsets can be in range -23:59..23:59. This is how Python, joda-time etc seems to do. (Previously the range was -12..+14) * Remove internal `Data.Aeson.Internal` and `Data.Aeson.Internal.Time` modules. Everything from the former is exported elsewhere (`Data.Aeson.Types`), the latter was truly internal.@@ -227,7 +255,7 @@ parseJSON = gParseJSON defaultOptions { rejectUnknownFields = True } ``` -* `FromJSON` instance of `Ratio a` now parses numbers in addtion to+* `FromJSON` instance of `Ratio a` now parses numbers in addition to standard `{numerator=..., denumerator=...}` encoding. Thanks to Aleksey Khudyakov.
src/Data/Aeson.hs view
@@ -199,6 +199,8 @@ -- -- This function parses immediately, but defers conversion. See -- 'json' for details.+--+-- Throws an 'Exception' when the file is missing. decodeFileStrict :: (FromJSON a) => FilePath -> IO (Maybe a) decodeFileStrict = fmap decodeStrict . B.readFile @@ -226,12 +228,15 @@ -- 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 is missing. --+-- 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 is missing. eitherDecodeFileStrict :: (FromJSON a) => FilePath -> IO (Either String a) eitherDecodeFileStrict = fmap eitherDecodeStrict . B.readFile@@ -253,7 +258,9 @@ -- | Like 'decodeFileStrict'' but returns an error message when decoding fails. ----- Since @2.2.0.0@ an alias for 'eitherDecodeFileStrict''.+-- Throws an 'Exception' when the file is missing.+--+-- Since @2.2.0.0@ an alias for 'eitherDecodeFileStrict'. eitherDecodeFileStrict' :: (FromJSON a) => FilePath -> IO (Either String a) eitherDecodeFileStrict' = eitherDecodeFileStrict {-# INLINE eitherDecodeFileStrict' #-}
src/Data/Aeson/Decoding.hs view
@@ -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,
src/Data/Aeson/Decoding/ByteString.hs view
@@ -153,7 +153,9 @@ Right t -> ok t (BS.drop (n + 1) bs0) Left e -> err (show e) Just (92, bs') -> goSlash (n + 1) bs'- Just (_, bs') -> goEsc (n + 1) bs'+ Just (w8, bs')+ | w8 < 0x20 -> errCC+ | otherwise -> goEsc (n + 1) bs' goSlash :: Int -> ByteString -> r goSlash !n !bs = case BS.uncons bs of@@ -161,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
src/Data/Aeson/Decoding/ByteString/Lazy.hs view
@@ -159,7 +159,9 @@ Right t -> ok t (lbsDrop (n + 1) bs0) Left e -> err (show e) Just (92, bs') -> goSlash (n + 1) bs'- Just (_, bs') -> goEsc (n + 1) bs'+ Just (w8, bs')+ | w8 < 0x20 -> errCC+ | otherwise -> goEsc (n + 1) bs' goSlash :: Int -> ByteString -> r goSlash !n !bs = case LBS.uncons bs of@@ -167,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
src/Data/Aeson/Decoding/Conversion.hs view
@@ -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
src/Data/Aeson/Decoding/Text.hs view
@@ -36,7 +36,7 @@ #endif --- | Lex (and parse) strict 'ByteString' into 'Tokens' stream.+-- | Lex (and parse) strict 'Text' into 'Tokens' stream. -- -- @since 2.2.1.0 --@@ -163,7 +163,9 @@ Right t -> ok t (unsafeDropPoints (n + 1) bs0) Left e -> err (show e) Just (92, bs') -> goSlash (n + 1) bs'- Just (_, bs') -> goEsc (n + 1) bs'+ Just (w8, bs')+ | w8 < 0x20 -> errCC+ | otherwise -> goEsc (n + 1) bs' goSlash :: Int -> Text -> r goSlash !n !bs = case unconsPoint bs of@@ -171,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
src/Data/Aeson/Encoding/Internal.hs view
@@ -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
src/Data/Aeson/Internal/Prelude.hs view
@@ -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)
src/Data/Aeson/Internal/Unescape.hs view
@@ -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
src/Data/Aeson/Internal/UnescapeFromText.hs view
@@ -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
src/Data/Aeson/Key.hs view
@@ -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
src/Data/Aeson/KeyMap.hs view
@@ -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@@ -141,7 +140,7 @@ -- | 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.@@ -355,7 +354,7 @@ -- | 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@@ -689,6 +688,12 @@ ------------------------------------------------------------------------------- -- semialign -------------------------------------------------------------------------------++-- |+--+-- @since 2.2.5.0+instance SA.Unzip KeyMap where+ unzip = SA.unzipDefault instance SA.Zip KeyMap where zipWith = intersectionWith
src/Data/Aeson/TH.hs view
@@ -945,7 +945,7 @@ (appE [|show|] (varE unknownFields))) [] ]- x:xs = [ lookupField argTy+ (x,xs) = nonEmpty [ lookupField argTy `appE` dispatchParseJSON jc conName tvMap argTy `appE` litE (stringL $ show tName) `appE` litE (stringL $ constructorTagModifier opts $ nameBase conName)@@ -955,6 +955,11 @@ | (field, argTy) <- zip fields argTys ] +-- 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"+ getValField :: Name -> String -> [MatchQ] -> Q Exp getValField obj valFieldName matches = do val <- newName "val"@@ -1056,12 +1061,12 @@ -> [Type] -- ^ The argument types of the constructor. -> Name -- ^ Name of the type to which the constructor belongs. -> Name -- ^ 'Con'structor name.- -> Integer -- ^ 'Con'structor arity.+ -> Integer -- ^ 'Con'structor arity. >= 1 -> [Q Match] parseProduct jc tvMap argTys tName conName numArgs = [ do arr <- newName "arr" -- List of: "parseJSON (arr `V.unsafeIndex` <IX>)"- let x:xs = [ dispatchParseJSON jc conName tvMap argTy+ let (x,xs) = nonEmpty [ dispatchParseJSON jc conName tvMap argTy `appE` infixApp (varE arr) [|V.unsafeIndex|]@@ -1271,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 _) =
src/Data/Aeson/Types.hs view
@@ -20,6 +20,7 @@ , Series , Array , emptyArray+ , isEmptyArray , Pair , Object , emptyObject
src/Data/Aeson/Types/FromJSON.hs view
@@ -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 $@@ -796,11 +803,13 @@ withBoundedScientific_ :: (Parser a -> Parser a) -> (Scientific -> Parser a) -> Value -> Parser a withBoundedScientific_ whenFail f (Number scientific) = if exp10 > 1024- then whenFail (fail msg)+ then whenFail (fail (msg "greater than 1024"))+ else if exp10 < -1024+ then whenFail (fail (msg "less than -1024")) else f scientific where exp10 = base10Exponent scientific- msg = "found a number with exponent " ++ show exp10 ++ ", but it must not be greater than 1024"+ msg req = "found a number with exponent " ++ show exp10 ++ ", but it must not be " ++ req withBoundedScientific_ whenFail _ v = whenFail (typeMismatch "Number" v) @@ -1706,14 +1715,7 @@ _ -> Scientific.toRealFloat <$> parseScientificText t instance (FromJSON a, Integral a) => FromJSON (Ratio a) where- parseJSON (Number x)- | exp10 <= 1024- , exp10 >= -1024 = return $! realToFrac x- | otherwise = prependContext "Ratio" $ fail msg- where- exp10 = base10Exponent x- msg = "found a number with exponent " ++ show exp10- ++ ", but it must not be greater than 1024 or less than -1024"+ parseJSON n@(Number _) = withBoundedScientific "Ratio" (($!) pure . realToFrac) n parseJSON o = objParser o where objParser = withObject "Rational" $ \obj -> do@@ -1723,12 +1725,29 @@ 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 -- 'withScientific' if you want to allow larger inputs. 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"
src/Data/Aeson/Types/Internal.hs view
@@ -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@@ -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 --@@ -505,7 +505,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 +552,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
src/Data/Aeson/Types/ToJSON.hs view
@@ -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)@@ -371,7 +372,7 @@ explicitToField f name value = KM.singleton name (f value) {-# INLINE explicitToField #-} --- | An optional key-value pair for envoding to a JSON object+-- | An optional key-value pair for encoding to a JSON object -- -- @since 2.2.0.0 --@@ -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
tests/DoubleToScientific.hs view
@@ -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.
tests/Instances.hs view
@@ -28,6 +28,11 @@ import Data.Orphans () import Test.QuickCheck.Instances () +#if !MIN_VERSION_base(4,16,0)+import Data.Semigroup (Option (..))+import Data.Tuple.Solo (Solo (..))+#endif+ -- "System" types. instance Arbitrary DotNetTime where@@ -157,9 +162,13 @@ #if !MIN_VERSION_base(4,16,0) instance Arbitrary OptionField where- arbitrary = OptionField <$> arbitrary+ arbitrary = OptionField . Option <$> arbitrary #endif +#if !MIN_VERSION_base(4,16,0) && MIN_VERSION_QuickCheck(2,17,0)+instance Arbitrary a => Arbitrary (Solo a) where+ arbitrary = MkSolo <$> arbitrary+#endif instance ApproxEq Char where (=~) = (==)
tests/JSONTestSuite/results/n_array_spaces_vertical_tab_formfeed.tok view
@@ -1,3 +1,3 @@ TkArrayOpen TkItem-TkErr "Unespected control character while parsing string literal"+TkErr "Unexpected control character while parsing string literal"
tests/JSONTestSuite/results/n_string_unescaped_ctrl_char.tok view
@@ -1,3 +1,3 @@ TkArrayOpen TkItem-TkErr "Unespected control character while parsing string literal"+TkErr "Unexpected control character while parsing string literal"
tests/JSONTestSuite/results/n_string_unescaped_newline.tok view
@@ -1,3 +1,3 @@ TkArrayOpen TkItem-TkErr "Unespected control character while parsing string literal"+TkErr "Unexpected control character while parsing string literal"
tests/JSONTestSuite/results/n_string_unescaped_tab.tok view
@@ -1,3 +1,3 @@ TkArrayOpen TkItem-TkErr "Unespected control character while parsing string literal"+TkErr "Unexpected control character while parsing string literal"
tests/PropUtils.hs view
@@ -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)
tests/PropertyKeys.hs view
@@ -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) ]
tests/PropertyRoundTrip.hs view
@@ -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))
+ tests/Regression/Issue1138.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE OverloadedStrings #-}+module Regression.Issue1138 (issue1138) where++import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, assertFailure)++import Data.Aeson++assertDecodeFailure :: Either String Value -> IO ()+assertDecodeFailure (Right v) = assertFailure $ "Unexpected success: " ++ show v+assertDecodeFailure (Left _) = return ()++issue1138 :: TestTree+issue1138 = testGroup "Issue #1138" $ map (testCase "-")+ [ assertDecodeFailure $ eitherDecode "\"\t\""+ , assertDecodeFailure $ eitherDecode "\"\\\\\t\""++ , assertDecodeFailure $ eitherDecodeStrict "\"\t\""+ , assertDecodeFailure $ eitherDecodeStrict "\"\\\\\t\""++ , assertDecodeFailure $ eitherDecodeStrictText "\"\t\""+ , assertDecodeFailure $ eitherDecodeStrictText "\"\\\\\t\""+ ]
tests/Types.hs view
@@ -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)
tests/UnitTests.hs view
@@ -38,6 +38,7 @@ , Value(..), camelTo, camelTo2 , defaultOptions, formatPath, formatRelativePath, omitNothingFields, parse) import Data.Char (toUpper, GeneralCategory(Control,Surrogate), generalCategory)+import Data.Fixed (Nano) import Data.HashMap.Strict (HashMap) import Data.Kind (Type) import Data.List (isSuffixOf)@@ -64,6 +65,7 @@ import Regression.Issue571 import Regression.Issue687 import Regression.Issue967+import Regression.Issue1138 import UnitTests.OmitNothingFieldsNote import UnitTests.FromJSONKey import UnitTests.Hashable@@ -86,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 {@@ -457,17 +460,22 @@ (eitherDecode "1.37" :: Either String Rational) bigRationalDecoding :: Assertion-bigRationalDecoding =- assertEqual "Decoding an Integer with a large exponent should fail"- (Left "Error in $: parsing Ratio failed, found a number with exponent 2000, but it must not be greater than 1024 or less than -1024")+bigRationalDecoding = do+ assertEqual "Decoding a Rational with a large exponent should fail"+ (Left "Error in $: parsing Ratio failed, found a number with exponent 2000, but it must not be greater than 1024") ((eitherDecode :: L.ByteString -> Either String Rational) "1e2000")--smallRationalDecoding :: Assertion-smallRationalDecoding =- assertEqual "Decoding an Integer with a large exponent should fail"- (Left "Error in $: parsing Ratio failed, found a number with exponent -2000, but it must not be greater than 1024 or less than -1024")+ assertEqual "Decoding a Rational with a small exponent should fail"+ (Left "Error in $: parsing Ratio failed, found a number with exponent -2000, but it must not be less than -1024") ((eitherDecode :: L.ByteString -> Either String Rational) "1e-2000") +bigFixedDecoding :: Assertion+bigFixedDecoding = do+ assertEqual "Decoding a Fixed with a large exponent should fail"+ (Left "Error in $: parsing Fixed failed, found a number with exponent 9999, but it must not be greater than 1024")+ ((eitherDecode :: L.ByteString -> Either String Nano) "1e9999")+ assertEqual "Decoding a Fixed with a small exponent should fail"+ (Left "Error in $: parsing Fixed failed, found a number with exponent -9999, but it must not be less than -1024")+ ((eitherDecode :: L.ByteString -> Either String Nano) "1e-9999") bigScientificExponent :: Assertion bigScientificExponent =@@ -554,7 +562,7 @@ , testCase "Ratio with denominator 0" ratioDenominator0 , testCase "Rational parses number" rationalNumber , testCase "Big rational" bigRationalDecoding- , testCase "Small rational" smallRationalDecoding+ , testCase "Big fixed" bigFixedDecoding , testCase "Big scientific exponent" bigScientificExponent , testCase "Big integer decoding" bigIntegerDecoding , testCase "Big natural decoding" bigNaturalDecoding@@ -568,6 +576,7 @@ , issue571 , issue687 , issue967+ , issue1138 , keyMapInsertWithTests , omitNothingFieldsNoteTests , noThunksTests