packages feed

aeson 2.1.0.0 → 2.1.1.0

raw patch · 84 files changed

+328/−183 lines, 84 filesbinary-addedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Data.Aeson.TH: instance Data.Aeson.TH.LookupField (Data.Semigroup.Option a)
+ Data.Aeson.KeyMap: (!?) :: KeyMap v -> Key -> Maybe v
+ Data.Aeson.KeyMap: insertWith :: (a -> a -> a) -> Key -> a -> KeyMap a -> KeyMap a

Files

aeson.cabal view
@@ -1,5 +1,5 @@ name:               aeson-version:            2.1.0.0+version:            2.1.1.0 license:            BSD3 license-file:       LICENSE category:           Text, Web, JSON@@ -18,7 +18,7 @@    || ==8.8.4    || ==8.10.7    || ==9.0.2-   || ==9.2.3+   || ==9.2.4    || ==9.4.1  synopsis:           Fast JSON parsing and encoding@@ -99,8 +99,8 @@     , bytestring        >=0.10.8.1 && <0.12     , containers        >=0.5.7.1  && <0.7     , deepseq           >=1.4.2.0  && <1.5-    , ghc-prim          >=0.5.0.0  && <0.9-    , template-haskell  >=2.11.0.0 && <2.19+    , ghc-prim          >=0.5.0.0  && <0.10+    , template-haskell  >=2.11.0.0 && <2.20     , text              >=1.2.3.0  && <1.3 || >=2.0 && <2.1     , time              >=1.6.0.1  && <1.13 @@ -132,7 +132,7 @@     , these                 >=1.1.1.1  && <1.2     , unordered-containers  >=0.2.10.0 && <0.3     , uuid-types            >=1.0.5    && <1.1-    , vector                >=0.12.0.1 && <0.13+    , vector                >=0.12.0.1 && <0.14     , witherable            >=0.4.2    && <0.5    ghc-options:      -Wall@@ -166,6 +166,7 @@     ErrorMessages     Functions     Instances+    JSONTestSuite     Options     Properties     PropertyGeneric@@ -175,6 +176,7 @@     PropertyRTFunctors     PropertyTH     PropUtils+    Regression.Issue967     SerializationFormatSpec     Types     UnitTests
changelog.md view
@@ -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.1.1.0++- Add `Data.Aeson.KeyMap.!?` (flipped) alias to `Data.Aeson.KeyMap.lookup`.+- Add `Data.Aeson.KeyMap.insertWith` function.+- Use `unsafeDupablePerformIO` instead of incorrect `accursedUnutterablePerformIO` in creation of keys in TH serialisation.+  This fixes a bug in TH deriving, e.g. when `Strict` pragma was enabled.+ ### 2.1.0.0  - Change time instances of types with year (`Day`, `UTCTime`) to require years with at least 4 digits.
src/Data/Aeson/Internal/ByteString.hs view
@@ -13,8 +13,8 @@ import Foreign.ForeignPtr (ForeignPtr) import Data.ByteString.Short (ShortByteString, fromShort) import GHC.Exts (Addr#, Ptr (Ptr))-import Data.ByteString.Internal (accursedUnutterablePerformIO) import Data.ByteString.Short.Internal (createFromPtr)+import System.IO.Unsafe (unsafeDupablePerformIO)  import qualified Data.ByteString as BS import qualified Language.Haskell.TH.Lib as TH@@ -82,6 +82,7 @@       bs = fromShort sbs #endif +-- this is copied verbatim from @bytestring@, but only in recent versions. unsafePackLenLiteral :: Int -> Addr# -> ShortByteString unsafePackLenLiteral len addr# =-    accursedUnutterablePerformIO $ createFromPtr (Ptr addr#) len+    unsafeDupablePerformIO $ createFromPtr (Ptr addr#) len
src/Data/Aeson/KeyMap.hs view
@@ -16,6 +16,7 @@     -- * Query     null,     lookup,+    (!?),     size,     member, @@ -25,6 +26,7 @@      -- ** Insertion     insert,+    insertWith,      -- * Deletion     delete,@@ -190,6 +192,12 @@ insert :: Key -> v -> KeyMap v -> KeyMap v insert k v tm = KeyMap (M.insert k v (unKeyMap tm)) +-- | Insert with a function combining new and old values, taken in that order.+--+-- @since 2.1.1.0+insertWith :: (a -> a -> a) -> Key -> a -> KeyMap a -> KeyMap a+insertWith f k v m = KeyMap (M.insertWith f k v (unKeyMap m))+ -- | Map a function over all values in the map. map :: (a -> b) -> KeyMap a -> KeyMap b map = fmap@@ -393,6 +401,12 @@ insert :: Key -> v -> KeyMap v -> KeyMap v insert k v tm = KeyMap (H.insert k v (unKeyMap tm)) +-- | Insert with a function combining new and old values, taken in that order.+--+-- @since 2.1.1.0+insertWith :: (a -> a -> a) -> Key -> a -> KeyMap a -> KeyMap a+insertWith f k v m = KeyMap (H.insertWith f k v (unKeyMap m))+ -- | Map a function over all values in the map. map :: (a -> b) -> KeyMap a -> KeyMap b map = fmap@@ -548,6 +562,16 @@ ------------------------------------------------------------------------------- -- combinators using existing abstractions -------------------------------------------------------------------------------++-- | Return the value to which the specified key is mapped,+-- or Nothing if this map contains no mapping for the key.+--+-- This is a flipped version of 'lookup'.+--+-- @since 2.1.1.0+--+(!?) :: KeyMap v -> Key -> Maybe v+(!?) m k = lookup k m  -- | Generalized union with combining function. alignWith :: (These a b -> c) -> KeyMap a -> KeyMap b -> KeyMap c
src/Data/Aeson/Parser/Internal.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} #if __GLASGOW_HASKELL__ <= 800 && __GLASGOW_HASKELL__ >= 706@@ -60,6 +61,7 @@ import Data.Scientific (Scientific) import Data.Text (Text) import Data.Vector (Vector)+import Data.Word (Word8) import qualified Data.Vector as Vector (empty, fromList, fromListN, reverse) import qualified Data.Attoparsec.ByteString as A import qualified Data.Attoparsec.Lazy as L@@ -77,22 +79,79 @@ -- >>> :set -XOverloadedStrings -- >>> import Data.Aeson.Types -#define BACKSLASH 92-#define CLOSE_CURLY 125-#define CLOSE_SQUARE 93-#define COMMA 44-#define DOUBLE_QUOTE 34-#define OPEN_CURLY 123-#define OPEN_SQUARE 91-#define C_0 48-#define C_9 57-#define C_A 65-#define C_F 70-#define C_a 97-#define C_f 102-#define C_n 110-#define C_t 116+-------------------------------------------------------------------------------+-- Word8 ASCII codes as patterns+------------------------------------------------------------------------------- +-- GHC-8.0 doesn't support giving multiple pattern synonyms type signature at once++-- spaces+pattern W8_SPACE :: Word8+pattern W8_NL    :: Word8+pattern W8_CR    :: Word8+pattern W8_TAB   :: Word8++pattern W8_SPACE = 0x20+pattern W8_NL    = 0x0a+pattern W8_CR    = 0x0d+pattern W8_TAB   = 0x09++-- punctuation+pattern W8_BACKSLASH    :: Word8+pattern W8_DOUBLE_QUOTE :: Word8+pattern W8_DOT          :: Word8+pattern W8_COMMA        :: Word8++pattern W8_BACKSLASH    = 92+pattern W8_COMMA        = 44+pattern W8_DOT          = 46+pattern W8_DOUBLE_QUOTE = 34++-- parentheses+pattern W8_CLOSE_CURLY  :: Word8+pattern W8_CLOSE_SQUARE :: Word8+pattern W8_OPEN_SQUARE  :: Word8+pattern W8_OPEN_CURLY   :: Word8++pattern W8_OPEN_CURLY   = 123+pattern W8_OPEN_SQUARE  = 91+pattern W8_CLOSE_CURLY  = 125+pattern W8_CLOSE_SQUARE = 93++-- operators+pattern W8_MINUS :: Word8+pattern W8_PLUS  :: Word8++pattern W8_PLUS  = 43+pattern W8_MINUS = 45++-- digits+pattern W8_0 :: Word8+pattern W8_9 :: Word8++pattern W8_0 = 48+pattern W8_9 = 57++-- lower case+pattern W8_e :: Word8+pattern W8_f :: Word8+pattern W8_n :: Word8+pattern W8_t :: Word8++pattern W8_e = 101+pattern W8_f = 102+pattern W8_n = 110+pattern W8_t = 116++-- upper case+pattern W8_E :: Word8+pattern W8_E = 69+++-------------------------------------------------------------------------------+-- Parsers+-------------------------------------------------------------------------------+ -- | Parse any JSON value. -- -- The conversion of a parsed value to a Haskell value is deferred@@ -151,7 +210,7 @@ objectValues mkObject str val = do   skipSpace   w <- A.peekWord8'-  if w == CLOSE_CURLY+  if w == W8_CLOSE_CURLY     then A.anyWord8 >> return KM.empty     else loop []  where@@ -162,9 +221,9 @@   loop acc = do     k <- (str A.<?> "object key") <* skipSpace <* (char ':' A.<?> "':'")     v <- (val A.<?> "object value") <* skipSpace-    ch <- A.satisfy (\w -> w == COMMA || w == CLOSE_CURLY) A.<?> "',' or '}'"+    ch <- A.satisfy (\w -> w == W8_COMMA || w == W8_CLOSE_CURLY) A.<?> "',' or '}'"     let acc' = (k, v) : acc-    if ch == COMMA+    if ch == W8_COMMA       then skipSpace >> loop acc'       else case mkObject acc' of         Left err -> fail err@@ -185,14 +244,14 @@ arrayValues val = do   skipSpace   w <- A.peekWord8'-  if w == CLOSE_SQUARE+  if w == W8_CLOSE_SQUARE     then A.anyWord8 >> return Vector.empty     else loop [] 1   where     loop acc !len = do       v <- (val A.<?> "json list value") <* skipSpace-      ch <- A.satisfy (\w -> w == COMMA || w == CLOSE_SQUARE) A.<?> "',' or ']'"-      if ch == COMMA+      ch <- A.satisfy (\w -> w == W8_COMMA || w == W8_CLOSE_SQUARE) A.<?> "',' or ']'"+      if ch == W8_COMMA         then skipSpace >> loop (v:acc) (len+1)         else return (Vector.reverse (Vector.fromListN len (v:acc))) {-# INLINE arrayValues #-}@@ -239,15 +298,15 @@   skipSpace   w <- A.peekWord8'   case w of-    DOUBLE_QUOTE  -> A.anyWord8 *> (String <$> jstring_)-    OPEN_CURLY    -> A.anyWord8 *> object_ mkObject value_-    OPEN_SQUARE   -> A.anyWord8 *> array_ value_-    C_f           -> string "false" $> Bool False-    C_t           -> string "true" $> Bool True-    C_n           -> string "null" $> Null-    _              | w >= 48 && w <= 57 || w == 45-                  -> Number <$> scientific-      | otherwise -> fail "not a valid json value"+    W8_DOUBLE_QUOTE  -> A.anyWord8 *> (String <$> jstring_)+    W8_OPEN_CURLY    -> A.anyWord8 *> object_ mkObject value_+    W8_OPEN_SQUARE   -> A.anyWord8 *> array_ value_+    W8_f             -> string "false" $> Bool False+    W8_t             -> string "true" $> Bool True+    W8_n             -> string "null" $> Null+    _                 | w >= W8_0 && w <= W8_9 || w == W8_MINUS+                     -> Number <$> scientific+      | otherwise    -> fail "not a valid json value" {-# INLINE jsonWith #-}  -- | Variant of 'json' which keeps only the last occurence of every key.@@ -291,19 +350,19 @@   skipSpace   w <- A.peekWord8'   case w of-    DOUBLE_QUOTE  -> do-                     !s <- A.anyWord8 *> jstring_-                     return (String s)-    OPEN_CURLY    -> A.anyWord8 *> object_' mkObject value_-    OPEN_SQUARE   -> A.anyWord8 *> array_' value_-    C_f           -> string "false" $> Bool False-    C_t           -> string "true" $> Bool True-    C_n           -> string "null" $> Null-    _              | w >= 48 && w <= 57 || w == 45-                  -> do-                     !n <- scientific-                     return (Number n)-      | otherwise -> fail "not a valid json value"+    W8_DOUBLE_QUOTE  -> do+                       !s <- A.anyWord8 *> jstring_+                       return (String s)+    W8_OPEN_CURLY    -> A.anyWord8 *> object_' mkObject value_+    W8_OPEN_SQUARE   -> A.anyWord8 *> array_' value_+    W8_f             -> string "false" $> Bool False+    W8_t             -> string "true" $> Bool True+    W8_n             -> string "null" $> Null+    _                 | w >= W8_0 && w <= W8_9 || w == W8_MINUS+                     -> do+                       !n <- scientific+                       return (Number n)+                      | otherwise -> fail "not a valid json value" {-# INLINE jsonWith' #-}  -- | Variant of 'json'' which keeps only the last occurence of every key.@@ -321,7 +380,7 @@  -- | Parse a quoted JSON string. jstring :: Parser Text-jstring = A.word8 DOUBLE_QUOTE *> jstring_+jstring = A.word8 W8_DOUBLE_QUOTE *> jstring_  -- | Parse a JSON Key key :: Parser Key@@ -331,16 +390,13 @@ jstring_ :: Parser Text {-# INLINE jstring_ #-} jstring_ = do-  -- not sure whether >= or bit hackery is faster-  -- perfectly, we shouldn't care, it's compiler job.-  s <- A.takeWhile (\w -> w /= DOUBLE_QUOTE && w /= BACKSLASH && w >= 0x20 && w < 0x80)-  let txt = unsafeDecodeASCII s+  s <- A.takeWhile (\w -> w /= W8_DOUBLE_QUOTE && w /= W8_BACKSLASH && w >= 0x20 && w < 0x80)   mw <- A.peekWord8   case mw of-    Nothing           -> fail "string without end"-    Just DOUBLE_QUOTE -> A.anyWord8 $> txt-    Just w | w < 0x20 -> fail "unescaped control character"-    _                 -> jstringSlow s+    Nothing              -> fail "string without end"+    Just W8_DOUBLE_QUOTE -> A.anyWord8 $> unsafeDecodeASCII s+    Just w | w < 0x20    -> fail "unescaped control character"+    _                    -> jstringSlow s  jstringSlow :: B.ByteString -> Parser Text {-# INLINE jstringSlow #-}@@ -350,13 +406,12 @@     Right r  -> return r     Left err -> fail $ show err  where-    startState              = False+    startState                = False     go a c-      | a                  = Just False-      | c == DOUBLE_QUOTE  = Nothing-      | otherwise = let a' = c == backslash+      | a                     = Just False+      | c == W8_DOUBLE_QUOTE  = Nothing+      | otherwise = let a' = c == W8_BACKSLASH                     in Just a'-      where backslash = BACKSLASH  decodeWith :: Parser Value -> (Value -> Result a) -> L.ByteString -> Maybe a decodeWith p to s =@@ -451,7 +506,7 @@ -- | The only valid whitespace in a JSON document is space, newline, -- carriage return, and tab. skipSpace :: Parser ()-skipSpace = A.skipWhile $ \w -> w == 0x20 || w == 0x0a || w == 0x0d || w == 0x09+skipSpace = A.skipWhile $ \w -> w == W8_SPACE || w == W8_NL || w == W8_CR || w == W8_TAB {-# INLINE skipSpace #-}  ------------------ Copy-pasted and adapted from attoparsec ------------------@@ -461,40 +516,34 @@  decimal0 :: Parser Integer decimal0 = do-  let zero = 48   digits <- A.takeWhile1 isDigit_w8-  if B.length digits > 1 && B.unsafeHead digits == zero+  if B.length digits > 1 && B.unsafeHead digits == W8_0     then fail "leading zero"     else return (bsToInteger digits)  -- | Parse a JSON number. scientific :: Parser Scientific scientific = do-  let minus = 45-      plus  = 43   sign <- A.peekWord8'-  let !positive = sign == plus || sign /= minus-  when (sign == plus || sign == minus) $+  let !positive = not (sign == W8_MINUS)+  when (sign == W8_PLUS || sign == W8_MINUS) $     void A.anyWord8    n <- decimal0    let f fracDigits = SP (B.foldl' step n fracDigits)                         (negate $ B.length fracDigits)-      step a w = a * 10 + fromIntegral (w - 48)+      step a w = a * 10 + fromIntegral (w - W8_0)    dotty <- A.peekWord8-  -- '.' -> ascii 46   SP c e <- case dotty of-              Just 46 -> A.anyWord8 *> (f <$> A.takeWhile1 isDigit_w8)-              _       -> pure (SP n 0)+              Just W8_DOT -> A.anyWord8 *> (f <$> A.takeWhile1 isDigit_w8)+              _           -> pure (SP n 0)    let !signedCoeff | positive  =  c                    | otherwise = -c -  let littleE = 101-      bigE    = 69-  (A.satisfy (\ex -> ex == littleE || ex == bigE) *>+  (A.satisfy (\ex -> case ex of W8_e -> True; W8_E -> True; _ -> False) *>       fmap (Sci.scientific signedCoeff . (e +)) (signed decimal)) <|>     return (Sci.scientific signedCoeff    e) {-# INLINE scientific #-}@@ -503,14 +552,14 @@  bsToInteger :: B.ByteString -> Integer bsToInteger bs-    | l > 40    = valInteger 10 l [ fromIntegral (w - 48) | w <- B.unpack bs ]+    | l > 40    = valInteger 10 l [ fromIntegral (w - W8_0) | w <- B.unpack bs ]     | otherwise = bsToIntegerSimple bs   where     l = B.length bs  bsToIntegerSimple :: B.ByteString -> Integer bsToIntegerSimple = B.foldl' step 0 where-  step a b = a * 10 + fromIntegral (b - 48) -- 48 = '0'+  step a b = a * 10 + fromIntegral (b - W8_0)  -- A sub-quadratic algorithm for Integer. Pairs of adjacent radix b -- digits are combined into a single radix b^2 digit. This process is
+ tests/JSONTestSuite.hs view
@@ -0,0 +1,80 @@+module JSONTestSuite (tests) where++import Test.Tasty (TestTree, testGroup)+import Data.Either.Compat (isLeft, isRight)+import Test.Tasty.HUnit ( testCase, assertBool )+import System.Directory (getDirectoryContents)+import System.FilePath ((</>), takeExtension, takeFileName)+import Data.List (sort)+import Control.Monad (forM)++import qualified Data.ByteString.Lazy as L+import qualified Data.HashSet as HashSet++import Data.Aeson++jsonTestSuiteTest :: FilePath -> TestTree+jsonTestSuiteTest path = testCase fileName $ do+    payload <- L.readFile path+    let result = eitherDecode payload :: Either String Value+    assertBool (show result) $ case take 2 fileName of+      "n_"                                                -> isLeft result+      "y_"                                                -> isRight result+      "i_" | fileName `HashSet.member` ignore_accepted    -> isRight result+           | otherwise                                    -> isLeft result+      _    | fileName `HashSet.member` transform_rejected -> isLeft result+           | otherwise                                    -> isRight result -- test_transform tests have inconsistent names+  where+    fileName = takeFileName path++-- Build a collection of tests based on the current contents of the+-- JSONTestSuite test directories.++tests :: IO TestTree+tests = do+  let suitePath = "tests/JSONTestSuite"+  let suites = ["test_parsing", "test_transform"]+  testPaths <- fmap (sort . concat) . forM suites $ \suite -> do+    let dir = suitePath </> suite+    entries <- getDirectoryContents dir+    let ok name = takeExtension name == ".json"+    return . map (dir </>) . filter ok $ entries+  return $ testGroup "JSONTestSuite" $ map jsonTestSuiteTest testPaths++-- The set expected-to-be-failing JSONTestSuite tests.+-- Not all of these failures are genuine bugs.+-- Of those that are bugs, not all are worth fixing.++-- | The @i@ cases we can ignore. We don't.+--+-- @i_@ - parsers are free to accept or reject content+--+-- We specify which @i_@ case we accept, so we can catch changes even in unspecified behavior.+-- (There is less case we accept)+ignore_accepted :: HashSet.HashSet FilePath+ignore_accepted = HashSet.fromList+    [ "i_number_double_huge_neg_exp.json"+    , "i_number_huge_exp.json"+    , "i_number_neg_int_huge_exp.json"+    , "i_number_pos_double_huge_exp.json"+    , "i_number_real_neg_overflow.json"+    , "i_number_real_pos_overflow.json"+    , "i_number_real_underflow.json"+    , "i_number_too_big_neg_int.json"+    , "i_number_too_big_pos_int.json"+    , "i_number_very_big_negative_int.json"+    , "i_structure_500_nested_arrays.json"+    ]++-- | Transform folder contain weird structures and characters that parsers may understand differently.+--+-- We don't even try to understand some.+transform_rejected :: HashSet.HashSet FilePath+transform_rejected = HashSet.fromList+    [ "string_1_escaped_invalid_codepoint.json"+    , "string_1_invalid_codepoint.json"+    , "string_2_escaped_invalid_codepoints.json"+    , "string_2_invalid_codepoints.json"+    , "string_3_escaped_invalid_codepoints.json"+    , "string_3_invalid_codepoints.json"+    ]
+ tests/JSONTestSuite/test_parsing/i_number_double_huge_neg_exp.json view
@@ -0,0 +1,1 @@+[123.456e-789]
+ tests/JSONTestSuite/test_parsing/i_number_huge_exp.json view
@@ -0,0 +1,1 @@+[0.4e00669999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999969999999006]
+ tests/JSONTestSuite/test_parsing/i_number_neg_int_huge_exp.json view
@@ -0,0 +1,1 @@+[-1e+9999]
+ tests/JSONTestSuite/test_parsing/i_number_pos_double_huge_exp.json view
@@ -0,0 +1,1 @@+[1.5e+9999]
+ tests/JSONTestSuite/test_parsing/i_number_real_neg_overflow.json view
@@ -0,0 +1,1 @@+[-123123e100000]
+ tests/JSONTestSuite/test_parsing/i_number_real_pos_overflow.json view
@@ -0,0 +1,1 @@+[123123e100000]
+ tests/JSONTestSuite/test_parsing/i_number_real_underflow.json view
@@ -0,0 +1,1 @@+[123e-10000000]
+ tests/JSONTestSuite/test_parsing/i_number_too_big_neg_int.json view
@@ -0,0 +1,1 @@+[-123123123123123123123123123123]
+ tests/JSONTestSuite/test_parsing/i_number_too_big_pos_int.json view
@@ -0,0 +1,1 @@+[100000000000000000000]
+ tests/JSONTestSuite/test_parsing/i_number_very_big_negative_int.json view
@@ -0,0 +1,1 @@+[-237462374673276894279832749832423479823246327846]
+ tests/JSONTestSuite/test_parsing/i_string_UTF8_surrogate_U+D800.json view
@@ -0,0 +1,1 @@+["í €"]
+ tests/JSONTestSuite/test_parsing/i_string_invalid_utf-8.json view
@@ -0,0 +1,1 @@+["ÿ"]
+ tests/JSONTestSuite/test_parsing/i_string_iso_latin_1.json view
@@ -0,0 +1,1 @@+["é"]
+ tests/JSONTestSuite/test_parsing/i_string_lone_utf8_continuation_byte.json view
@@ -0,0 +1,1 @@+[""]
+ tests/JSONTestSuite/test_parsing/i_string_overlong_sequence_2_bytes.json view
@@ -0,0 +1,1 @@+["À¯"]
+ tests/JSONTestSuite/test_parsing/i_string_overlong_sequence_6_bytes.json view
@@ -0,0 +1,1 @@+["üƒ¿¿¿¿"]
+ tests/JSONTestSuite/test_parsing/i_string_overlong_sequence_6_bytes_null.json view
@@ -0,0 +1,1 @@+["ü€€€€€"]
− tests/JSONTestSuite/test_parsing/i_string_unicode_U+10FFFE_nonchar.json 
@@ -1,1 +0,0 @@-["\uDBFF\uDFFE"]
− tests/JSONTestSuite/test_parsing/i_string_unicode_U+1FFFE_nonchar.json 
@@ -1,1 +0,0 @@-["\uD83F\uDFFE"]
− tests/JSONTestSuite/test_parsing/i_string_unicode_U+FDD0_nonchar.json 
@@ -1,1 +0,0 @@-["\uFDD0"]
− tests/JSONTestSuite/test_parsing/i_string_unicode_U+FFFE_nonchar.json 
@@ -1,1 +0,0 @@-["\uFFFE"]
+ tests/JSONTestSuite/test_parsing/i_string_utf16BE_no_BOM.json view

binary file changed (absent → 10 bytes)

+ tests/JSONTestSuite/test_parsing/i_string_utf16LE_no_BOM.json view

binary file changed (absent → 10 bytes)

+ tests/JSONTestSuite/test_parsing/n_multidigit_number_then_00.json view

binary file changed (absent → 4 bytes)

− tests/JSONTestSuite/test_parsing/n_number_then_00.json

binary file changed (2 → absent bytes)

+ tests/JSONTestSuite/test_parsing/n_object_lone_continuation_byte_in_key_and_trailing_comma.json view
@@ -0,0 +1,1 @@+{"¹":"0",}
− tests/JSONTestSuite/test_parsing/n_object_pi_in_key_and_trailing_comma.json 
@@ -1,1 +0,0 @@-{"¹":"0",}
− tests/JSONTestSuite/test_parsing/n_string_1_surrogate_then_escape u.json 
@@ -1,1 +0,0 @@-["\uD800\u"]
− tests/JSONTestSuite/test_parsing/n_string_1_surrogate_then_escape u1.json 
@@ -1,1 +0,0 @@-["\uD800\u1"]
− tests/JSONTestSuite/test_parsing/n_string_1_surrogate_then_escape u1x.json 
@@ -1,1 +0,0 @@-["\uD800\u1x"]
+ tests/JSONTestSuite/test_parsing/n_string_1_surrogate_then_escape_u.json view
@@ -0,0 +1,1 @@+["\uD800\u"]
+ tests/JSONTestSuite/test_parsing/n_string_1_surrogate_then_escape_u1.json view
@@ -0,0 +1,1 @@+["\uD800\u1"]
+ tests/JSONTestSuite/test_parsing/n_string_1_surrogate_then_escape_u1x.json view
@@ -0,0 +1,1 @@+["\uD800\u1x"]
− tests/JSONTestSuite/test_parsing/n_string_UTF8_surrogate_U+D800.json 
@@ -1,1 +0,0 @@-["í €"]
− tests/JSONTestSuite/test_parsing/n_string_invalid_utf-8.json 
@@ -1,1 +0,0 @@-["ÿ"]
− tests/JSONTestSuite/test_parsing/n_string_iso_latin_1.json 
@@ -1,1 +0,0 @@-["é"]
− tests/JSONTestSuite/test_parsing/n_string_lone_utf8_continuation_byte.json 
@@ -1,1 +0,0 @@-[""]
− tests/JSONTestSuite/test_parsing/n_string_overlong_sequence_2_bytes.json 
@@ -1,1 +0,0 @@-["À¯"]
− tests/JSONTestSuite/test_parsing/n_string_overlong_sequence_6_bytes.json 
@@ -1,1 +0,0 @@-["üƒ¿¿¿¿"]
− tests/JSONTestSuite/test_parsing/n_string_overlong_sequence_6_bytes_null.json 
@@ -1,1 +0,0 @@-["ü€€€€€"]
− tests/JSONTestSuite/test_parsing/n_string_unescaped_crtl_char.json

binary file changed (7 → absent bytes)

+ tests/JSONTestSuite/test_parsing/n_string_unescaped_ctrl_char.json view

binary file changed (absent → 7 bytes)

+ tests/JSONTestSuite/test_parsing/n_structure_angle_bracket_null.json view
@@ -0,0 +1,1 @@+[<null>]
− tests/JSONTestSuite/test_parsing/n_structure_null.json 
@@ -1,1 +0,0 @@-[<null>]
+ tests/JSONTestSuite/test_parsing/n_structure_single_eacute.json view
@@ -0,0 +1,1 @@+é
− tests/JSONTestSuite/test_parsing/n_structure_single_point.json 
@@ -1,1 +0,0 @@-é
− tests/JSONTestSuite/test_parsing/y_number_double_huge_neg_exp.json 
@@ -1,1 +0,0 @@-[123.456e-789]
− tests/JSONTestSuite/test_parsing/y_number_huge_exp.json 
@@ -1,1 +0,0 @@-[0.4e00669999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999969999999006]
− tests/JSONTestSuite/test_parsing/y_number_neg_int_huge_exp.json 
@@ -1,1 +0,0 @@-[-1e+9999]
− tests/JSONTestSuite/test_parsing/y_number_pos_double_huge_exp.json 
@@ -1,1 +0,0 @@-[1.5e+9999]
− tests/JSONTestSuite/test_parsing/y_number_real_neg_overflow.json 
@@ -1,1 +0,0 @@-[-123123e100000]
− tests/JSONTestSuite/test_parsing/y_number_real_pos_overflow.json 
@@ -1,1 +0,0 @@-[123123e100000]
− tests/JSONTestSuite/test_parsing/y_number_real_underflow.json 
@@ -1,1 +0,0 @@-[123e-10000000]
− tests/JSONTestSuite/test_parsing/y_number_too_big_neg_int.json 
@@ -1,1 +0,0 @@-[-123123123123123123123123123123]
− tests/JSONTestSuite/test_parsing/y_number_too_big_pos_int.json 
@@ -1,1 +0,0 @@-[100000000000000000000]
− tests/JSONTestSuite/test_parsing/y_number_very_big_negative_int.json 
@@ -1,1 +0,0 @@-[-237462374673276894279832749832423479823246327846]
tests/JSONTestSuite/test_parsing/y_object_extreme_numbers.json view
+ tests/JSONTestSuite/test_parsing/y_string_nbsp_uescaped.json view
@@ -0,0 +1,1 @@+["new\u00A0line"]
− tests/JSONTestSuite/test_parsing/y_string_newline_uescaped.json 
@@ -1,1 +0,0 @@-["new\u00A0line"]
− tests/JSONTestSuite/test_parsing/y_string_nonCharacterInUTF-8_U+1FFFF.json 
@@ -1,1 +0,0 @@-["𛿿"]
+ tests/JSONTestSuite/test_parsing/y_string_reservedCharacterInUTF-8_U+1BFFF.json view
@@ -0,0 +1,1 @@+["𛿿"]
+ tests/JSONTestSuite/test_parsing/y_string_uescaped_newline.json view
@@ -0,0 +1,1 @@+["new\u000Aline"]
+ tests/JSONTestSuite/test_parsing/y_string_unicode_U+10FFFE_nonchar.json view
@@ -0,0 +1,1 @@+["\uDBFF\uDFFE"]
+ tests/JSONTestSuite/test_parsing/y_string_unicode_U+1FFFE_nonchar.json view
@@ -0,0 +1,1 @@+["\uD83F\uDFFE"]
+ tests/JSONTestSuite/test_parsing/y_string_unicode_U+FDD0_nonchar.json view
@@ -0,0 +1,1 @@+["\uFDD0"]
+ tests/JSONTestSuite/test_parsing/y_string_unicode_U+FFFE_nonchar.json view
@@ -0,0 +1,1 @@+["\uFFFE"]
− tests/JSONTestSuite/test_parsing/y_string_utf16BE_no_BOM.json 
binary file changed (10 → absent bytes)
− tests/JSONTestSuite/test_parsing/y_string_utf16LE_no_BOM.json 
binary file changed (10 → absent bytes)
+ tests/JSONTestSuite/test_transform/number_-9223372036854775808.json view
@@ -0,0 +1,1 @@+[-9223372036854775808]
+ tests/JSONTestSuite/test_transform/number_-9223372036854775809.json view
@@ -0,0 +1,1 @@+[-9223372036854775809]
tests/JSONTestSuite/test_transform/number_10000000000000000999.json view
tests/JSONTestSuite/test_transform/number_1e-999.json view
tests/JSONTestSuite/test_transform/number_1e6.json view
+ tests/JSONTestSuite/test_transform/number_9223372036854775807.json view
@@ -0,0 +1,1 @@+[9223372036854775807]
+ tests/JSONTestSuite/test_transform/number_9223372036854775808.json view
@@ -0,0 +1,1 @@+[9223372036854775808]
+ tests/Regression/Issue967.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE Strict #-}+{-# LANGUAGE TemplateHaskell #-}+-- {-# OPTIONS_GHC -ddump-splices #-}+-- {-# OPTIONS_GHC -ddump-simpl -ddump-to-file #-}+module Regression.Issue967 (issue967) where++import Test.Tasty (TestTree)+import Test.Tasty.HUnit (testCase, assertEqual)++import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Encoding as LTE++import Data.Aeson+import Data.Aeson.TH++data DataA = DataA+  { val1 :: Int,+    val2 :: Int+  }+  deriving (Eq, Show)++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++$(deriveJSON defaultOptions ''DataA)++-------------------------------------------------------------------------------+-- Test+-------------------------------------------------------------------------------++issue967 :: TestTree+issue967 = testCase "issue967" $ do+  let ev = DataA 1 2+      encoding = encode ev+      parsedEv = decode encoding :: Maybe DataA++  assertEqual (LT.unpack $ LTE.decodeUtf8 encoding) (Just ev) parsedEv
tests/Tests.hs view
@@ -8,9 +8,11 @@ import qualified DataFamilies.Properties as DF import qualified Properties import qualified UnitTests+import qualified JSONTestSuite  main :: IO () main = do     ioTests <- UnitTests.ioTests-    let allTests = DF.tests : Properties.tests : UnitTests.tests : ioTests+    jsTests <- JSONTestSuite.tests+    let allTests = DF.tests : Properties.tests : UnitTests.tests : jsTests : ioTests     defaultMain (testGroup "tests" allTests)
tests/UnitTests.hs view
@@ -49,10 +49,9 @@ import qualified Data.Aeson.KeyMap as KM import Data.Attoparsec.ByteString (Parser, parseOnly) import Data.Char (toUpper, GeneralCategory(Control,Surrogate), generalCategory)-import Data.Either.Compat (isLeft, isRight) import Data.Hashable (hash) import Data.HashMap.Strict (HashMap)-import Data.List (sort, isSuffixOf)+import Data.List (isSuffixOf) import Data.Maybe (fromMaybe) import Data.Scientific (Scientific, scientific) import Data.Tagged (Tagged(..))@@ -63,16 +62,13 @@ import GHC.Generics.Generically (Generically (..)) import Instances () import Numeric.Natural (Natural)-import System.Directory (getDirectoryContents)-import System.FilePath ((</>), takeExtension, takeFileName) import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, assertEqual, testCase, (@?=))+import Test.Tasty.HUnit (Assertion, assertFailure, assertEqual, testCase, (@?=)) import Text.Printf (printf) import UnitTests.NullaryConstructors (nullaryConstructors) import qualified Data.ByteString as S import qualified Data.ByteString.Base16.Lazy as LBase16 import qualified Data.ByteString.Lazy.Char8 as L-import qualified Data.HashSet as HashSet import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Builder as TLB import qualified Data.Text.Lazy.Encoding as LT@@ -81,6 +77,7 @@ import qualified ErrorMessages import qualified SerializationFormatSpec import qualified Data.Map as Map -- Lazy!+import Regression.Issue967  roundTripCamel :: String -> Assertion roundTripCamel name = assertEqual "" name (camelFrom '_' $ camelTo '_' name)@@ -419,73 +416,8 @@       Surrogate -> False       _ -> True --- JSONTestSuite -jsonTestSuiteTest :: FilePath -> TestTree-jsonTestSuiteTest path = testCase fileName $ do-    payload <- L.readFile path-    let result = eitherDecode payload :: Either String Value-    assertBool fileName $ case take 2 fileName of-      "i_" -> isRight result-      "n_" -> isLeft result-      "y_" -> isRight result-      _    -> isRight result -- test_transform tests have inconsistent names-  where-    fileName = takeFileName path --- Build a collection of tests based on the current contents of the--- JSONTestSuite test directories.--jsonTestSuite :: IO TestTree-jsonTestSuite = do-  let suitePath = "tests/JSONTestSuite"-  let suites = ["test_parsing", "test_transform"]-  testPaths <- fmap (sort . concat) . forM suites $ \suite -> do-    let dir = suitePath </> suite-    entries <- getDirectoryContents dir-    let ok name = takeExtension name == ".json" &&-                  not (name `HashSet.member` blacklist)-    return . map (dir </>) . filter ok $ entries-  return $ testGroup "JSONTestSuite" $ map jsonTestSuiteTest testPaths---- The set expected-to-be-failing JSONTestSuite tests.--- Not all of these failures are genuine bugs.--- Of those that are bugs, not all are worth fixing.--blacklist :: HashSet.HashSet String--- blacklist = HashSet.empty-blacklist = _blacklist--_blacklist :: HashSet.HashSet String-_blacklist = HashSet.fromList [-    "i_object_key_lone_2nd_surrogate.json"-  , "i_string_1st_surrogate_but_2nd_missing.json"-  , "i_string_1st_valid_surrogate_2nd_invalid.json"-  , "i_string_UTF-16LE_with_BOM.json"-  , "i_string_UTF-16_invalid_lonely_surrogate.json"-  , "i_string_UTF-16_invalid_surrogate.json"-  , "i_string_UTF-8_invalid_sequence.json"-  , "i_string_incomplete_surrogate_and_escape_valid.json"-  , "i_string_incomplete_surrogate_pair.json"-  , "i_string_incomplete_surrogates_escape_valid.json"-  , "i_string_invalid_lonely_surrogate.json"-  , "i_string_invalid_surrogate.json"-  , "i_string_inverted_surrogates_U+1D11E.json"-  , "i_string_lone_second_surrogate.json"-  , "i_string_not_in_unicode_range.json"-  , "i_string_truncated-utf-8.json"-  , "i_structure_UTF-8_BOM_empty_object.json"-  , "string_1_escaped_invalid_codepoint.json"-  , "string_1_invalid_codepoint.json"-  , "string_1_invalid_codepoints.json"-  , "string_2_escaped_invalid_codepoints.json"-  , "string_2_invalid_codepoints.json"-  , "string_3_escaped_invalid_codepoints.json"-  , "string_3_invalid_codepoints.json"-  , "y_string_utf16BE_no_BOM.json"-  , "y_string_utf16LE_no_BOM.json"-  ]- -- A regression test for: https://github.com/bos/aeson/pull/455 data Foo a = FooNil | FooCons (Foo Int) deriveToJSON  defaultOptions ''Foo@@ -838,8 +770,7 @@ ioTests :: IO [TestTree] ioTests = do   enc <- encoderComparisonTests-  js <- jsonTestSuite-  return [enc, js]+  return [enc]  tests :: TestTree tests = testGroup "unit" [@@ -894,4 +825,10 @@       assertEqual "" (object ["foo" .= True]) [aesonQQ| {"foo": true } |]     ]   , monadFixTests+  , issue967+  , testCase "KeyMap.insertWith" $ do+      KM.insertWith (-)        "a" 2 (KM.fromList [("a", 1)]) @?= KM.fromList [("a",1 :: Int)]+      KM.insertWith (flip (-)) "a" 2 (KM.fromList [("a", 1)]) @?= KM.fromList [("a",-1 :: Int)]+      KM.insertWith (-)        "b" 2 (KM.fromList [("a", 1)]) @?= KM.fromList [("a",1),("b",2 :: Int)]+      KM.insertWith (-)        "b" 2 KM.empty                 @?= KM.fromList [("b",2 :: Int)]   ]