packages feed

aeson 1.0.2.1 → 1.1.0.0

raw patch · 19 files changed

+680/−247 lines, 19 filesdep +directorydep +filepathdep +uuid-typesdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: directory, filepath, uuid-types

Dependency ranges changed: base

API changes (from Hackage documentation)

+ Data.Aeson.Encoding: pair' :: Encoding' Text -> Encoding -> Series
+ Data.Aeson.Encoding.Internal: pair' :: Encoding' Text -> Encoding -> Series
+ Data.Aeson.Types: explicitParseField :: (Value -> Parser a) -> Object -> Text -> Parser a
+ Data.Aeson.Types: explicitParseFieldMaybe :: (Value -> Parser a) -> Object -> Text -> Parser (Maybe a)
+ Data.Aeson.Types: explicitParseFieldMaybe' :: (Value -> Parser a) -> Object -> Text -> Parser (Maybe a)
+ Data.Aeson.Types: parseField :: (FromJSON a) => Object -> Text -> Parser a
+ Data.Aeson.Types: parseFieldMaybe :: (FromJSON a) => Object -> Text -> Parser (Maybe a)
+ Data.Aeson.Types: parseFieldMaybe' :: (FromJSON a) => Object -> Text -> Parser (Maybe a)

Files

Data/Aeson/Encoding.hs view
@@ -14,6 +14,7 @@     , Series     , pairs     , pair+    , pair'     -- * Predicates     , nullEncoding     -- * Encoding constructors
Data/Aeson/Encoding/Builder.hs view
@@ -193,12 +193,13 @@         !(T dh dl)  = twoDigits d         encodeYear y             | y >= 1000 = B.integerDec y-            | y > 0 =-                let (ab,c) = fromIntegral y `quotRem` 10-                    (a,b)  = ab `quotRem` 10-                in BP.primBounded (ascii4 ('0',(digit a,(digit b,digit c)))) ()-            | otherwise =-                error "Data.Aeson.Encode.Builder.day:  years BCE not supported"+            | y >= 0    = BP.primBounded (ascii4 (padYear y)) ()+            | y >= -999 = BP.primBounded (ascii5 ('-',padYear (- y))) ()+            | otherwise = B.integerDec y+        padYear y =+            let (ab,c) = fromIntegral y `quotRem` 10+                (a,b)  = ab `quotRem` 10+            in ('0',(digit a,(digit b,digit c))) {-# INLINE day #-}  timeOfDay :: TimeOfDay -> Builder@@ -305,7 +306,7 @@               where                 go !i !op                   | i < iendTmp = case A.unsafeIndex arr i of-                      w | w <= 0x7F -> do+                      w | w <= 0x7F ->                             BP.runB be (fromIntegral w) op >>= go (i + 1)                         | w <= 0x7FF -> do                             poke8 0 $ (w `shiftR` 6) + 0xC0
Data/Aeson/Encoding/Internal.hs view
@@ -13,6 +13,7 @@     , Series (..)     , pairs     , pair+    , pair'     -- * Predicates     , nullEncoding     -- * Encoding constructors@@ -122,7 +123,10 @@             deriving (Typeable)  pair :: Text -> Encoding -> Series-pair name val = Value $ retagEncoding $ text name >< colon >< val+pair name val = pair' (text name) val++pair' :: Encoding' Text -> Encoding -> Series+pair' name val = Value $ retagEncoding $ retagEncoding name >< colon >< val  instance Semigroup Series where     Empty   <> a       = a
Data/Aeson/Parser/Internal.hs view
@@ -36,15 +36,20 @@ import Prelude () import Prelude.Compat +import Control.Applicative ((<|>))+import Control.Monad (void, when) import Data.Aeson.Types.Internal (IResult(..), JSONPath, Result(..), Value(..))-import Data.Attoparsec.ByteString.Char8 (Parser, char, endOfInput, scientific, skipSpace, string)+import Data.Attoparsec.ByteString.Char8 (Parser, char, decimal, endOfInput, isDigit_w8, signed, string)+import Data.Scientific (Scientific) import Data.Text (Text) import Data.Vector as Vector (Vector, empty, fromListN, reverse) import qualified Data.Attoparsec.ByteString as A import qualified Data.Attoparsec.Lazy as L import qualified Data.ByteString as B+import qualified Data.ByteString.Unsafe as B import qualified Data.ByteString.Lazy as L import qualified Data.HashMap.Strict as H+import qualified Data.Scientific as Sci import Data.Aeson.Parser.Unescape  #if MIN_VERSION_ghc_prim(0,3,1)@@ -289,3 +294,54 @@ -- end-of-input.  See also: 'json''. jsonEOF' :: Parser Value jsonEOF' = json' <* skipSpace <* endOfInput++-- | 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+{-# INLINE skipSpace #-}++------------------ Copy-pasted and adapted from attoparsec ------------------++-- A strict pair+data SP = SP !Integer {-# UNPACK #-}!Int++decimal0 :: Parser Integer+decimal0 = do+  let step a w = a * 10 + fromIntegral (w - zero)+      zero = 48+  digits <- A.takeWhile1 isDigit_w8+  if B.length digits > 1 && B.unsafeHead digits == zero+    then fail "leading zero"+    else return (B.foldl' step 0 digits)++{-# INLINE scientific #-}+scientific :: Parser Scientific+scientific = do+  let minus = 45+      plus  = 43+  sign <- A.peekWord8'+  let !positive = sign == plus || sign /= minus+  when (sign == plus || sign == 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)++  dotty <- A.peekWord8+  -- '.' -> ascii 46+  SP c e <- case dotty of+              Just 46 -> 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) *>+      fmap (Sci.scientific signedCoeff . (e +)) (signed decimal)) <|>+    return (Sci.scientific signedCoeff    e)
Data/Aeson/Parser/Time.hs view
@@ -25,6 +25,7 @@ import Prelude () import Prelude.Compat +import Control.Applicative ((<|>)) import Control.Monad (void, when) import Data.Aeson.Internal.Time (toPico) import Data.Attoparsec.Text as A@@ -46,13 +47,14 @@             Left err -> fail $ "could not parse date: " ++ err             Right r  -> return r --- | Parse a date of the form @YYYY-MM-DD@.+-- | Parse a date of the form @[+,-]YYYY-MM-DD@. day :: Parser Day day = do+  absOrNeg <- negate <$ char '-' <|> id <$ char '+' <|> pure id   y <- decimal <* char '-'   m <- twoDigits <* char '-'   d <- twoDigits-  maybe (fail "invalid date") return (fromGregorianValid y m d)+  maybe (fail "invalid date") return (fromGregorianValid (absOrNeg y) m d)  -- | Parse a two-digit integer (e.g. day of month, hour). twoDigits :: Parser Int
Data/Aeson/Types.hs view
@@ -90,6 +90,12 @@     , (.:!)     , (.!=)     , object+    , parseField+    , parseFieldMaybe+    , parseFieldMaybe'+    , explicitParseField+    , explicitParseFieldMaybe+    , explicitParseFieldMaybe'      , listEncoding     , listValue
Data/Aeson/Types/Class.hs view
@@ -76,11 +76,18 @@     -- * Functions     , fromJSON     , ifromJSON+    , typeMismatch+    , parseField+    , parseFieldMaybe+    , parseFieldMaybe'+    , explicitParseField+    , explicitParseFieldMaybe+    , explicitParseFieldMaybe'+    -- ** Operators     , (.:)     , (.:?)     , (.:!)     , (.!=)-    , typeMismatch     ) where  import Prelude ()
Data/Aeson/Types/FromJSON.hs view
@@ -59,11 +59,18 @@     -- * Functions     , fromJSON     , ifromJSON+    , typeMismatch+    , parseField+    , parseFieldMaybe+    , parseFieldMaybe'+    , explicitParseField+    , explicitParseFieldMaybe+    , explicitParseFieldMaybe'+    -- ** Operators     , (.:)     , (.:?)     , (.:!)     , (.!=)-    , typeMismatch      -- * Internal     , parseOptionalFieldWith@@ -123,6 +130,7 @@ import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as LT import qualified Data.Tree as Tree+import qualified Data.UUID.Types as UUID import qualified Data.Vector as V import qualified Data.Vector.Generic as VG import qualified Data.Vector.Primitive as VP@@ -653,9 +661,7 @@ -- in an object for it to be valid.  If the key and value are -- optional, use '.:?' instead. (.:) :: (FromJSON a) => Object -> Text -> Parser a-obj .: key = case H.lookup key obj of-               Nothing -> fail $ "key " ++ show key ++ " not present"-               Just v  -> parseJSON v <?> Key key+(.:) = explicitParseField parseJSON {-# INLINE (.:) #-}  -- | Retrieve the value associated with the given key of an 'Object'. The@@ -666,9 +672,7 @@ -- from an object without affecting its validity.  If the key and -- value are mandatory, use '.:' instead. (.:?) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)-obj .:? key = case H.lookup key obj of-               Nothing -> pure Nothing-               Just v  -> parseJSON v <?> Key key+(.:?) = explicitParseFieldMaybe parseJSON {-# INLINE (.:?) #-}  -- | Retrieve the value associated with the given key of an 'Object'.@@ -678,11 +682,47 @@ -- This differs from '.:?' by attempting to parse 'Null' the same as any -- other JSON value, instead of interpreting it as 'Nothing'. (.:!) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)-obj .:! key = case H.lookup key obj of-               Nothing -> pure Nothing-               Just v  -> Just <$> parseJSON v <?> Key key+(.:!) = explicitParseFieldMaybe' parseJSON {-# INLINE (.:!) #-} +-- | Function variant of '.:'.+parseField :: (FromJSON a) => Object -> Text -> Parser a+parseField = (.:)+{-# INLINE parseField #-}++-- | Function variant of '.:?'.+parseFieldMaybe :: (FromJSON a) => Object -> Text -> Parser (Maybe a)+parseFieldMaybe = (.:?)+{-# INLINE parseFieldMaybe #-}++-- | Function variant of '.:!'.+parseFieldMaybe' :: (FromJSON a) => Object -> Text -> Parser (Maybe a)+parseFieldMaybe' = (.:!)+{-# INLINE parseFieldMaybe' #-}++-- | Variant of '.:' with explicit parser function.+--+-- E.g. @'explicitParseField' 'parseJSON1' :: ('FromJSON1' f, 'FromJSON' a) -> 'Object' -> 'Text' -> 'Parser' (f a)@+explicitParseField :: (Value -> Parser a) -> Object -> Text -> Parser a+explicitParseField p obj key = case H.lookup key obj of+    Nothing -> fail $ "key " ++ show key ++ " not present"+    Just v  -> p v <?> Key key+{-# INLINE explicitParseField #-}++-- | Variant of '.:?' with explicit parser function.+explicitParseFieldMaybe :: (Value -> Parser a) -> Object -> Text -> Parser (Maybe a)+explicitParseFieldMaybe p obj key = case H.lookup key obj of+    Nothing -> pure Nothing+    Just v  -> liftParseJSON p (listParser p) v <?> Key key -- listParser isn't used by maybe instance.+{-# INLINE explicitParseFieldMaybe #-}++-- | Variant of '.:!' with explicit parser function.+explicitParseFieldMaybe' :: (Value -> Parser a) -> Object -> Text -> Parser (Maybe a)+explicitParseFieldMaybe' p obj key = case H.lookup key obj of+    Nothing -> pure Nothing+    Just v  -> Just <$> p v <?> Key key+{-# INLINE explicitParseFieldMaybe' #-}+ -- | Helper for use in combination with '.:?' to provide default -- values for optional JSON object fields. --@@ -1360,7 +1400,7 @@     parseJSONList = liftParseJSONList parseJSON parseJSONList     {-# INLINE parseJSONList #-} -instance (FromJSONKey a, FromJSON a) => FromJSONKey (Identity a) where+instance (FromJSONKey a) => FromJSONKey (Identity a) where     fromJSONKey = coerceFromJSONKeyFunction (fromJSONKey :: FromJSONKeyFunction a)     fromJSONKeyList = coerceFromJSONKeyFunction (fromJSONKeyList :: FromJSONKeyFunction [a]) @@ -1487,6 +1527,18 @@     {-# INLINE parseJSON #-}  -------------------------------------------------------------------------------+-- uuid+-------------------------------------------------------------------------------++instance FromJSON UUID.UUID where+    parseJSON = withText "UUID" $+        maybe (fail "Invalid UUID") pure . UUID.fromText++instance FromJSONKey UUID.UUID where+    fromJSONKey = FromJSONKeyTextParser $+        maybe (fail "Invalid UUID") pure . UUID.fromText++------------------------------------------------------------------------------- -- vector ------------------------------------------------------------------------------- @@ -1725,11 +1777,20 @@ -- tagged ------------------------------------------------------------------------------- +instance FromJSON1 Proxy where+    {-# INLINE liftParseJSON #-}+    liftParseJSON _ _ Null = pure Proxy+    liftParseJSON _ _ v    = typeMismatch "Proxy" v+ instance FromJSON (Proxy a) where     {-# INLINE parseJSON #-}     parseJSON Null = pure Proxy     parseJSON v    = typeMismatch "Proxy" v ++instance FromJSON2 Tagged where+    liftParseJSON2 _ _ p _ = fmap Tagged . p+    {-# INLINE liftParseJSON2 #-}  instance FromJSON1 (Tagged a) where     liftParseJSON p _ = fmap Tagged . p
Data/Aeson/Types/ToJSON.hs view
@@ -113,6 +113,7 @@ import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as LT import qualified Data.Tree as Tree+import qualified Data.UUID.Types as UUID import qualified Data.Vector as V import qualified Data.Vector.Generic as VG import qualified Data.Vector.Mutable as VM@@ -120,6 +121,9 @@ import qualified Data.Vector.Storable as VS import qualified Data.Vector.Unboxed as VU +import qualified Data.Aeson.Encoding.Builder as EB+import qualified Data.ByteString.Builder as B+ #if !(MIN_VERSION_bytestring(0,10,0)) import Foreign.ForeignPtr (withForeignPtr) import Foreign.Marshal.Utils (copyBytes)@@ -615,6 +619,11 @@     {-# INLINE liftToEncoding #-}  instance (ToJSON a) => ToJSON [a] where+    {-# SPECIALIZE instance ToJSON String #-}+    {-# SPECIALIZE instance ToJSON [String] #-}+    {-# SPECIALIZE instance ToJSON [Array] #-}+    {-# SPECIALIZE instance ToJSON [Object] #-}+     toJSON = toJSON1     {-# INLINE toJSON #-} @@ -1661,7 +1670,7 @@     toEncodingList = liftToEncodingList toEncoding toEncodingList     {-# INLINE toEncodingList #-} -instance (ToJSONKey a, ToJSON a) => ToJSONKey (Identity a) where+instance (ToJSONKey a) => ToJSONKey (Identity a) where     toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey     toJSONKeyList = contramapToJSONKeyFunction (map runIdentity) toJSONKeyList @@ -1852,7 +1861,18 @@     toEncoding = toEncoding1     {-# INLINE toEncoding #-} +-------------------------------------------------------------------------------+-- uuid+------------------------------------------------------------------------------- +instance ToJSON UUID.UUID where+    toJSON = toJSON . UUID.toText+    toEncoding = E.unsafeToEncoding . EB.quote . B.byteString . UUID.toASCIIBytes++instance ToJSONKey UUID.UUID where+    toJSONKey = ToJSONKeyText UUID.toText $+        E.unsafeToEncoding . EB.quote . B.byteString . UUID.toASCIIBytes+ ------------------------------------------------------------------------------- -- vector -------------------------------------------------------------------------------@@ -1865,6 +1885,8 @@     {-# INLINE liftToEncoding #-}  instance (ToJSON a) => ToJSON (Vector a) where+    {-# SPECIALIZE instance ToJSON Array #-}+     toJSON = toJSON1     {-# INLINE toJSON #-} @@ -1936,6 +1958,8 @@     {-# INLINE liftToEncoding #-}  instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where+    {-# SPECIALIZE instance ToJSON Object #-}+     toJSON = toJSON1     {-# INLINE toJSON #-} @@ -2165,6 +2189,13 @@ -- tagged ------------------------------------------------------------------------------- +instance ToJSON1 Proxy where+    liftToJSON _ _ _ = Null+    {-# INLINE liftToJSON #-}++    liftToEncoding _ _ _ = E.null_+    {-# INLINE liftToEncoding #-}+ instance ToJSON (Proxy a) where     toJSON _ = Null     {-# INLINE toJSON #-}@@ -2173,6 +2204,13 @@     {-# INLINE toEncoding #-}  +instance ToJSON2 Tagged where+    liftToJSON2 _ _ t _ (Tagged x) = t x+    {-# INLINE liftToJSON2 #-}++    liftToEncoding2 _ _ t _ (Tagged x) = t x+    {-# INLINE liftToEncoding2 #-}+ instance ToJSON1 (Tagged a) where     liftToJSON t _ (Tagged x) = t x     {-# INLINE liftToJSON #-}@@ -2187,7 +2225,6 @@     toEncoding = toEncoding1     {-# INLINE toEncoding #-} - instance ToJSONKey b => ToJSONKey (Tagged a b) where     toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey     toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList@@ -2769,7 +2806,7 @@  -- | Pack the chunks of a lazy bytestring into a single strict bytestring. packChunks :: L.ByteString -> S.ByteString-packChunks lbs = do+packChunks lbs =     S.unsafeCreate (fromIntegral $ L.length lbs) (copyChunks lbs)   where     copyChunks !L.Empty                         !_pf = return ()
README.markdown view
@@ -15,9 +15,9 @@  * `git clone git://github.com/bos/aeson.git` -There's also a [Mercurial mirror](http://bitbucket.org/bos/aeson):+See what's changed in recent (and upcoming) releases: -* `hg clone http://bitbucket.org/bos/aeson`+* https://github.com/bos/aeson/blob/master/changelog.md  (You can create and contribute changes using either git or Mercurial.)
aeson.cabal view
@@ -1,5 +1,5 @@ name:            aeson-version:         1.0.2.1+version:         1.1.0.0 license:         BSD3 license-file:    LICENSE category:        Text, Web, JSON@@ -117,6 +117,7 @@     time >= 1.1.1.4,     time-locale-compat >= 0.1.1 && < 0.2,     unordered-containers >= 0.2.5.0,+    uuid-types >= 1.0.3 && <1.1,     vector >= 0.8    if flag(bytestring-builder)@@ -162,10 +163,12 @@     DataFamilies.Encoders     DataFamilies.Types     Encoders+    ErrorMessages     Functions     Instances     Options     Properties+    SerializationFormatSpec     Types     UnitTests     UnitTests.NullaryConstructors@@ -182,7 +185,9 @@     base-orphans >= 0.5.3 && <0.6,     base16-bytestring,     containers,+    directory,     dlist,+    filepath,     generic-deriving >= 1.10 && < 1.12,     ghc-prim >= 0.2,     hashable >= 1.2.4.0,@@ -196,6 +201,7 @@     time,     time-locale-compat,     unordered-containers,+    uuid-types,     vector,     quickcheck-instances >=0.3.12 @@ -220,7 +226,3 @@ source-repository head   type:     git   location: git://github.com/bos/aeson.git--source-repository head-  type:     mercurial-  location: https://bitbucket.org/bos/aeson
benchmarks/aeson-benchmarks.cabal view
@@ -53,6 +53,7 @@     time,     transformers,     unordered-containers >= 0.2.3.0,+    uuid-types >= 1.0.3 && <1.1,     vector >= 0.7.1    if flag(bytestring-builder)
changelog.md view
@@ -1,5 +1,47 @@ For the latest version of this document, please see [https://github.com/bos/aeson/blob/master/changelog.md](https://github.com/bos/aeson/blob/master/changelog.md). +# 1.1.0.0++* The operators for parsing fields now have named aliases:+  -  `.:` => `parseField`+  -  `.:?` => `parseFieldMaybe`+  -  `.:!` => `parseFieldMaybe'`+  - These functions now also have variants with explicit parser functions: `explicitParseField`, `explicitParseFieldMaybe`, "explicitParseFieldMaybe'`+Thanks to Oleg Grenrus.++* `ToJSONKey (Identity a)` and `FromJSONKey (Identity a)` no longer require the unnecessary `FromJSON a` constraint. Thanks to Oleg Grenrus.++* Added `Data.Aeson.Encoding.pair'` which is a more general version of `Data.Aeson.Encoding.pair`. Thanks to Andrew Martin.++* `Day`s BCE are properly encoded and `+` is now a valid prefix for `Day`s CE. Thanks to Matt Parsons.++* Some commonly used ToJSON instances are now specialized in order to improve compile time. Thanks to Bartosz Nitka.+++[JSONTestSuite](https://github.com/nst/JSONTestSuite) cleanups, all+motivated by tighter RFC 7159 compliance:++* The parser now rejects numbers for which+  [the integer portion contains a leading zero](https://github.com/bos/aeson/commit/3fb7c155f2255482b1b9566ec5c1eaf9895d630e).+* The parser now rejects numbers for which+  [a decimal point is not followed by at least one digit](https://github.com/bos/aeson/commit/ecfca35a45286dbe2bbaf5f62354be393bc59b66),+* The parser now rejects documents that contain [whitespace outside the+  set {space, newline, carriage return, tab}](https://github.com/bos/aeson/commit/8ef622c2ad8d4a109884e17c2792238a2a320e44).++Over 90% of JSONTestSuite tests currently pass. The remainder can be+categorised as follows:++* The string parser is strict with Unicode compliance where the RFC+  leaves room for implementation-defined behaviour (tests prefixed+  with "`i_string_`". (This is necessary because the `text` library+  cannot accommodate invalid Unicode.)++* The parser does not (and will not) support UTF-16, UTF-32, or byte+  order marks (BOM).+* The parser accepts unescaped control characters, even though the RFC+  states that control characters must be escaped. (This may change at+  some point, but doesn't seem important.)+ #### 1.0.2.1  * Fixes a regression where a bunch of valid characters caused an
+ tests/ErrorMessages.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module ErrorMessages+  (+    tests+  ) where++import Prelude ()+import Prelude.Compat++import Data.Aeson (FromJSON(..), eitherDecode)+import Data.Proxy (Proxy(..))+import Instances ()+import Test.Framework (Test)+import Test.Framework.Providers.HUnit (testCase)+import Test.HUnit (Assertion, assertFailure, assertEqual)+import qualified Data.ByteString.Lazy.Char8 as L+import qualified Data.HashMap.Strict as HM++tests :: [Test]+tests =+    [+      testCase "Int" int+    , testCase "String" string+    , testCase "HashMap" hashMap+    ]++int :: Assertion+int = do+  let t = test (Proxy :: Proxy Int)+  t "\"\"" $ expected "Int" "String"+  t "[]" $ expected "Int" "Array"+  t "{}" $ expected "Int" "Object"+  t "null" $ expected "Int" "Null"++string :: Assertion+string = do+  let t = test (Proxy :: Proxy String)+  t "1" $ expected "String" "Number"+  t "[]" $ expected "String" "Array"+  t "{}" $ expected "String" "Object"+  t "null" $ expected "String" "Null"++hashMap :: Assertion+hashMap = do+  let t = test (Proxy :: Proxy (HM.HashMap String Int))+  t "\"\"" $ expected "HashMap k v" "String"+  t "[]" $ expected "HashMap k v" "Array"++expected :: String -> String -> String+expected ex enc = "Error in $: expected " ++ ex ++ ", encountered " ++ enc++test :: forall a proxy . (FromJSON a, Show a) => proxy a -> L.ByteString -> String -> Assertion+test _ v msg = case eitherDecode v of+    Left e -> assertEqual "Invalid error message" msg e+    Right (x :: a) -> assertFailure $ "Expected parsing to fail but it suceeded with: " ++ show x
tests/Instances.hs view
@@ -25,6 +25,7 @@ import Types import qualified Data.DList as DList import qualified Data.HashMap.Strict as HM+import qualified Data.UUID.Types as UUID  #if !MIN_VERSION_QuickCheck(2,9,0) import Control.Applicative (Const(..))@@ -218,3 +219,10 @@ instance Arbitrary a => Arbitrary (Identity a) where     arbitrary = Identity <$> arbitrary #endif++instance Arbitrary UUID.UUID where+    arbitrary = UUID.fromWords+        <$> arbitrary+        <*> arbitrary+        <*> arbitrary+        <*> arbitrary
tests/Properties.hs view
@@ -41,6 +41,7 @@ import qualified Data.Map as Map import qualified Data.Text as T import qualified Data.Text.Lazy as LT+import qualified Data.UUID.Types as UUID import qualified Data.Vector as V  encodeDouble :: Double -> Double -> Property@@ -202,6 +203,7 @@     , testProperty "Lazy Text" $ roundTripEq LT.empty     , testProperty "Foo" $ roundTripEq (undefined :: Foo)     , testProperty "Day" $ roundTripEq (undefined :: Day)+    , testProperty "BCE Day" $ roundTripEq (undefined :: BCEDay)     , testProperty "DotNetTime" $ roundTripEq (undefined :: Approx DotNetTime)     , testProperty "LocalTime" $ roundTripEq (undefined :: LocalTime)     , testProperty "TimeOfDay" $ roundTripEq (undefined :: TimeOfDay)@@ -217,6 +219,7 @@     , testProperty "Seq" $ roundTripEq (undefined :: Seq Int)     , testProperty "Rational" $ roundTripEq (undefined :: Rational)     , testProperty "Ratio Int" $ roundTripEq (undefined :: Ratio Int)+    , testProperty "UUID" $ roundTripEq UUID.nil     , testGroup "functors"       [ testProperty "Identity Char" $ roundTripEq (undefined :: I Int) @@ -278,6 +281,7 @@ #endif     , testProperty "Version" $ roundTripKey (undefined :: Version)     , testProperty "Lazy Text" $ roundTripKey (undefined :: LT.Text)+    , testProperty "UUID" $ roundTripKey UUID.nil     ]   , testGroup "toFromJSON" [       testProperty "Integer" (toFromJSON :: Integer -> Property)
+ tests/SerializationFormatSpec.hs view
@@ -0,0 +1,245 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+#if __GLASGOW_HASKELL__ >= 708+{-# LANGUAGE DataKinds #-}+#endif++------------------------------------------------------------------------------+-- These tests assert that the JSON serialization doesn't change by accident.+-----------------------------------------------------------------------------++module SerializationFormatSpec+  (+    tests+  ) where++import Prelude ()+import Prelude.Compat++import Control.Applicative (Const(..))+import Data.Aeson (FromJSON(..), decode, encode, genericParseJSON, genericToEncoding, genericToJSON)+import Data.Aeson.Types (Options(..), SumEncoding(..), ToJSON(..), defaultOptions)+import Data.Fixed (Pico)+import Data.Functor.Compose (Compose(..))+import Data.Functor.Identity (Identity(..))+import Data.Functor.Product (Product(..))+import Data.Functor.Sum (Sum(..))+import Data.List.NonEmpty (NonEmpty(..))+import Data.Proxy (Proxy(..))+import Data.Scientific (Scientific)+import Data.Tagged (Tagged(..))+import Data.Time (fromGregorian)+import Data.Word (Word8)+import GHC.Generics (Generic)+import Instances ()+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.HUnit (testCase)+import Test.HUnit (assertFailure, assertEqual)+import Types (Approx(..), Compose3, Compose3', I)+import qualified Data.ByteString.Lazy.Char8 as L+import qualified Data.DList as DList+import qualified Data.HashMap.Strict as HM+import qualified Data.HashSet as HashSet+import qualified Data.IntMap as IntMap+import qualified Data.IntSet as IntSet+import qualified Data.Map as M+import qualified Data.Monoid as Monoid+import qualified Data.Semigroup as Semigroup+import qualified Data.Sequence as Seq+import qualified Data.Set as Set+import qualified Data.Tree as Tree+import qualified Data.UUID.Types as UUID+import qualified Data.Vector as Vector++tests :: [Test]+tests =+  [+    testGroup "To JSON representation" $ fmap assertJsonEncodingExample jsonEncodingExamples+  , testGroup "From JSON representation" $ fmap assertJsonExample jsonDecodingExamples+  , testGroup "To/From JSON representation" $ fmap assertJsonExample jsonExamples++  ]++jsonExamples :: [Example]+jsonExamples =+  [+    Example "Either Left" "{\"Left\":1}"  (Left 1 :: Either Int Int)+  , Example "Either Right" "{\"Right\":1}"  (Right 1 :: Either Int Int)+  , Example "Nothing"  "null"  (Nothing :: Maybe Int)+  , Example "Just"  "1"  (Just 1 :: Maybe Int)+  , Example "Proxy Int" "null"  (Proxy :: Proxy Int)+  , Example "Tagged Char Int" "1"  (Tagged 1 :: Tagged Char Int)+#if __GLASGOW_HASKELL__ >= 708+    -- Test Tagged instance is polykinded+  , Example "Tagged 123 Int" "1"  (Tagged 1 :: Tagged 123 Int)+#endif+  , Example "Const Char Int" "\"c\""  (Const 'c' :: Const Char Int)+  , Example "Tuple" "[1,2]"  ((1, 2) :: (Int, Int))+  , Example "NonEmpty" "[1,2,3]"  (1 :| [2, 3] :: NonEmpty Int)+  , Example "Seq" "[1,2,3]"  (Seq.fromList [1, 2, 3] ::  Seq.Seq Int)+  , Example "DList" "[1,2,3]"  (DList.fromList [1, 2, 3] :: DList.DList Int)+  , Example "()" "[]"  ()++  , Example "HashMap Int Int"          "{\"0\":1,\"2\":3}"  (HM.fromList [(0,1),(2,3)] :: HM.HashMap Int Int)+  , Example "Map Int Int"              "{\"0\":1,\"2\":3}"  (M.fromList [(0,1),(2,3)] :: M.Map Int Int)+  , Example "Map (Tagged Int Int) Int" "{\"0\":1,\"2\":3}"  (M.fromList [(Tagged 0,1),(Tagged 2,3)] :: M.Map (Tagged Int Int) Int)+  , Example "Map [Int] Int"            "[[[0],1],[[2],3]]"  (M.fromList [([0],1),([2],3)] :: M.Map [Int] Int)+  , Example "Map [Char] Int"           "{\"ab\":1,\"cd\":3}"  (M.fromList [("ab",1),("cd",3)] :: M.Map [Char] Int)+  , Example "Map [I Char] Int"         "{\"ab\":1,\"cd\":3}"  (M.fromList [(map pure "ab",1),(map pure "cd",3)] :: M.Map [I Char] Int)++  , Example "nan :: Double" "null"  (Approx $ 0/0 :: Approx Double)++  , Example "Ordering LT" "\"LT\"" LT+  , Example "Ordering EQ" "\"EQ\"" EQ+  , Example "Ordering GT" "\"GT\"" GT++  , Example "Float" "3.14" (3.14 :: Float)+  , Example "Pico" "3.14" (3.14 :: Pico)+  , Example "Scientific" "3.14" (3.14 :: Scientific)++  , Example "UUID" "\"c2cc10e1-57d6-4b6f-9899-38d972112d8c\"" $ UUID.fromWords+      0xc2cc10e1 0x57d64b6f 0x989938d9 0x72112d8c++  , Example "Set Int" "[1,2,3]" (Set.fromList [3, 2, 1] :: Set.Set Int)+  , Example "IntSet"  "[1,2,3]" (IntSet.fromList [3, 2, 1])+  , Example "IntMap" "[[1,2],[3,4]]" (IntMap.fromList [(3,4), (1,2)] :: IntMap.IntMap Int)+  , Example "Vector" "[1,2,3]" (Vector.fromList [1, 2, 3] :: Vector.Vector Int)+  , Example "HashSet Int" "[1,2,3]" (HashSet.fromList [3, 2, 1] :: HashSet.HashSet Int)+  , Example "Tree Int" "[1,[[2,[[3,[]],[4,[]]]],[5,[]]]]" (let n = Tree.Node in n 1 [n 2 [n 3 [], n 4 []], n 5 []] :: Tree.Tree Int)++  -- Three separate cases, as ordering in HashMap is not defined+  , Example "HashMap Float Int, NaN" "{\"NaN\":1}"  (Approx $ HM.singleton (0/0) 1 :: Approx (HM.HashMap Float Int))+  , Example "HashMap Float Int, Infinity" "{\"Infinity\":1}"  (HM.singleton (1/0) 1 :: HM.HashMap Float Int)+  , Example "HashMap Float Int, +Infinity" "{\"-Infinity\":1}"  (HM.singleton (negate 1/0) 1 :: HM.HashMap Float Int)++  -- Functors+  , Example "Identity Int" "1"  (pure 1 :: Identity Int)++  , Example "Identity Char" "\"x\""      (pure 'x' :: Identity Char)+  , Example "Identity String" "\"foo\""  (pure "foo" :: Identity String)+  , Example "[Identity Char]" "\"xy\""   ([pure 'x', pure 'y'] :: [Identity Char])++  , Example "Maybe Char" "\"x\""              (pure 'x' :: Maybe Char)+  , Example "Maybe String" "\"foo\""          (pure "foo" :: Maybe String)+  , Example "Maybe [Identity Char]" "\"xy\""  (pure [pure 'x', pure 'y'] :: Maybe [Identity Char])++  , Example "Day; year >= 1000" "\"1999-10-12\""        (fromGregorian 1999    10 12)+  , Example "Day; year > 0 && < 1000" "\"0500-03-04\""  (fromGregorian 500     3  4)+  , Example "Day; year == 0" "\"0000-02-20\""           (fromGregorian 0       2  20)+  , Example "Day; year < 0" "\"-0234-01-01\""           (fromGregorian (-234)  1  1)+  , Example "Day; year < -1000" "\"-1234-01-01\""       (fromGregorian (-1234) 1  1)++  , Example "Product I Maybe Int" "[1,2]"         (Pair (pure 1) (pure 2) :: Product I Maybe Int)+  , Example "Product I Maybe Int" "[1,null]"      (Pair (pure 1) Nothing :: Product I Maybe Int)+  , Example "Product I [] Char" "[\"a\",\"foo\"]" (Pair (pure 'a') "foo" :: Product I [] Char)++  , Example "Sum I [] Int: InL"  "{\"InL\":1}"       (InL (pure 1) :: Sum I [] Int)+  , Example "Sum I [] Int: InR"  "{\"InR\":[1,2]}"   (InR [1, 2] :: Sum I [] Int)+  , Example "Sum I [] Char: InR" "{\"InR\":\"foo\"}" (InR "foo" :: Sum I [] Char)++  , Example "Compose I  I  Int" "1"      (pure 1 :: Compose I I   Int)+  , Example "Compose I  [] Int" "[1]"    (pure 1 :: Compose I []  Int)+  , Example "Compose [] I  Int" "[1]"    (pure 1 :: Compose [] I  Int)+  , Example "Compose [] [] Int" "[[1]]"  (pure 1 :: Compose [] [] Int)++  , Example "Compose I  I  Char" "\"x\""    (pure 'x' :: Compose I  I  Char)+  , Example "Compose I  [] Char" "\"x\""    (pure 'x' :: Compose I  [] Char)+  , Example "Compose [] I  Char" "\"x\""    (pure 'x' :: Compose [] I  Char)+  , Example "Compose [] [] Char" "[\"x\"]"  (pure 'x' :: Compose [] [] Char)++  , Example "Compose3 I  I  I  Char" "\"x\""      (pure 'x' :: Compose3 I  I  I  Char)+  , Example "Compose3 I  I  [] Char" "\"x\""      (pure 'x' :: Compose3 I  I  [] Char)+  , Example "Compose3 I  [] I  Char" "\"x\""      (pure 'x' :: Compose3 I  [] I  Char)+  , Example "Compose3 I  [] [] Char" "[\"x\"]"    (pure 'x' :: Compose3 I  [] [] Char)+  , Example "Compose3 [] I  I  Char" "\"x\""      (pure 'x' :: Compose3 [] I  I  Char)+  , Example "Compose3 [] I  [] Char" "[\"x\"]"    (pure 'x' :: Compose3 [] I  [] Char)+  , Example "Compose3 [] [] I  Char" "[\"x\"]"    (pure 'x' :: Compose3 [] [] I  Char)+  , Example "Compose3 [] [] [] Char" "[[\"x\"]]"  (pure 'x' :: Compose3 [] [] [] Char)++  , Example "Compose3' I  I  I  Char" "\"x\""      (pure 'x' :: Compose3' I  I  I  Char)+  , Example "Compose3' I  I  [] Char" "\"x\""      (pure 'x' :: Compose3' I  I  [] Char)+  , Example "Compose3' I  [] I  Char" "\"x\""      (pure 'x' :: Compose3' I  [] I  Char)+  , Example "Compose3' I  [] [] Char" "[\"x\"]"    (pure 'x' :: Compose3' I  [] [] Char)+  , Example "Compose3' [] I  I  Char" "\"x\""      (pure 'x' :: Compose3' [] I  I  Char)+  , Example "Compose3' [] I  [] Char" "[\"x\"]"    (pure 'x' :: Compose3' [] I  [] Char)+  , Example "Compose3' [] [] I  Char" "[\"x\"]"    (pure 'x' :: Compose3' [] [] I  Char)+  , Example "Compose3' [] [] [] Char" "[[\"x\"]]"  (pure 'x' :: Compose3' [] [] [] Char)++  , Example "MyEither Int String: Left"  "42"      (MyLeft 42     :: MyEither Int String)+  , Example "MyEither Int String: Right" "\"foo\"" (MyRight "foo" :: MyEither Int String)++  -- newtypes from Monoid/Semigroup+  , Example "Monoid.Dual Int" "2" (pure 2 :: Monoid.Dual Int)+  , Example "Monoid.First Int" "2" (pure 2 :: Monoid.First Int)+  , Example "Monoid.Last Int" "2" (pure 2 :: Monoid.Last Int)+  , Example "Semigroup.Min Int" "2" (pure 2 :: Semigroup.Min Int)+  , Example "Semigroup.Max Int" "2" (pure 2 :: Semigroup.Max Int)+  , Example "Semigroup.First Int" "2" (pure 2 :: Semigroup.First Int)+  , Example "Semigroup.Last Int" "2" (pure 2 :: Semigroup.Last Int)+  , Example "Semigroup.WrappedMonoid Int" "2" (Semigroup.WrapMonoid 2 :: Semigroup.WrappedMonoid Int)+  , Example "Semigroup.Option Just" "2" (pure 2 :: Semigroup.Option Int)+  , Example "Semigroup.Option Nothing" "null" (Semigroup.Option (Nothing :: Maybe Bool))+  ]++jsonEncodingExamples :: [Example]+jsonEncodingExamples =+  [+  -- Maybe serialising is lossy+  -- https://github.com/bos/aeson/issues/376+    Example "Just Nothing" "null" (Just Nothing :: Maybe (Maybe Int))+  -- infinities cannot be recovered, null is decoded as NaN+  , Example "inf :: Double" "null" (Approx $ 1/0 :: Approx Double)+  ]++jsonDecodingExamples :: [Example]+jsonDecodingExamples = [+  -- Maybe serialising is lossy+  -- https://github.com/bos/aeson/issues/376+    MaybeExample "Nothing"      "null" (Just $ Nothing :: Maybe (Maybe Int))+  , MaybeExample "Just"         "1"    (Just $ Just 1 :: Maybe (Maybe Int))+  , MaybeExample "Just Nothing" "null" (Just $ Nothing :: Maybe (Maybe (Maybe Int)))+  -- Integral values are truncated, and overflowed+  -- https://github.com/bos/aeson/issues/317+  , MaybeExample "Word8 3"    "3"    (Just 3 :: Maybe Word8)+  , MaybeExample "Word8 3.00" "3.00" (Just 3 :: Maybe Word8)+  , MaybeExample "Word8 3.14" "3.14" (Nothing :: Maybe Word8)+  , MaybeExample "Word8 -1"   "-1"   (Nothing :: Maybe Word8)+  , MaybeExample "Word8 300"  "300"  (Nothing :: Maybe Word8)+  -- Negative zero year, encoding never produces such:+  , MaybeExample "Day -0000-02-03" "\"-0000-02-03\"" (Just (fromGregorian 0 2 3))+  ]++data Example where+    Example+        :: (Eq a, Show a, ToJSON a, FromJSON a)+        => String -> L.ByteString -> a -> Example+    MaybeExample+        :: (Eq a, Show a, FromJSON a)+        => String -> L.ByteString -> Maybe a -> Example++data MyEither a b = MyLeft a | MyRight b+  deriving (Generic, Show, Eq)++instance (ToJSON a, ToJSON b) => ToJSON (MyEither a b) where+    toJSON = genericToJSON defaultOptions { sumEncoding = UntaggedValue }+    toEncoding = genericToEncoding defaultOptions { sumEncoding = UntaggedValue }++instance (FromJSON a, FromJSON b) => FromJSON (MyEither a b) where+    parseJSON = genericParseJSON defaultOptions { sumEncoding = UntaggedValue }++assertJsonExample :: Example -> Test+assertJsonExample (Example name bs val) = testCase name $ do+    assertEqual "encode"           bs         (encode val)+    assertEqual "encode/via value" bs         (encode $ toJSON val)+    assertEqual "decode"           (Just val) (decode bs)+assertJsonExample (MaybeExample name bs mval) = testCase name $+    assertEqual "decode" mval (decode bs)++assertJsonEncodingExample :: Example -> Test+assertJsonEncodingExample (Example name bs val) = testCase name $ do+    assertEqual "encode"           bs (encode val)+    assertEqual "encode/via value" bs (encode $ toJSON val)+assertJsonEncodingExample (MaybeExample name _ _) = testCase name $+    assertFailure "cannot encode MaybeExample"
tests/Types.hs view
@@ -15,9 +15,11 @@ import Data.Functor.Compose (Compose (..)) import Data.Functor.Identity (Identity (..)) import Data.Text+import Data.Time (Day (..), fromGregorian) import GHC.Generics-import Test.QuickCheck (Property, counterexample)+import Test.QuickCheck (Arbitrary (..), Property, counterexample) import qualified Data.Map as Map+import Data.Aeson  type I = Identity type Compose3  f g h = Compose (Compose f g) h@@ -115,3 +117,19 @@ failure :: Show a => String -> String -> a -> Property failure func msg v = counterexample                      (func ++ " failed: " ++ msg ++ ", " ++ show v) False++newtype BCEDay = BCEDay Day+  deriving (Eq, Show)++zeroDay :: Day+zeroDay = fromGregorian 0 0 0++instance Arbitrary BCEDay where+    arbitrary = fmap (BCEDay . ModifiedJulianDay . (+ toModifiedJulianDay zeroDay)) arbitrary++instance ToJSON BCEDay where+    toJSON (BCEDay d)     = toJSON d+    toEncoding (BCEDay d) = toEncoding d++instance FromJSON BCEDay where+    parseJSON = fmap BCEDay . parseJSON
tests/UnitTests.hs view
@@ -1,14 +1,11 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}-#if __GLASGOW_HASKELL__ >= 708-{-# LANGUAGE DataKinds #-}-#endif +-- For Data.Aeson.Types.camelTo {-# OPTIONS_GHC -fno-warn-deprecations #-}  module UnitTests@@ -20,61 +17,49 @@ import Prelude () import Prelude.Compat -import Control.Applicative (Const(..))-import Control.Monad (forM, forM_)-import Data.Aeson ((.=), (.:), (.:?), (.:!), FromJSON(..), FromJSONKeyFunction(..), FromJSONKey(..), ToJSON1(..), decode, eitherDecode, encode, genericParseJSON, genericToEncoding, genericToJSON, object, withObject)+import Control.Monad (forM, forM_, unless)+import Data.Aeson ((.=), (.:), (.:?), (.:!), FromJSON(..), FromJSONKeyFunction(..), FromJSONKey(..), ToJSON1(..), decode, eitherDecode, encode, genericToEncoding, genericToJSON, object, withObject) import Data.Aeson.Internal (JSONPathElement(..), formatError) import Data.Aeson.TH (deriveJSON, deriveToJSON, deriveToJSON1) import Data.Aeson.Text (encodeToTextBuilder)-import Data.Aeson.Types (Options(..), SumEncoding(..), ToJSON(..), Value, camelTo, camelTo2, defaultOptions, omitNothingFields)+import Data.Aeson.Types (Options(..), ToJSON(..), Value, camelTo, camelTo2, defaultOptions, omitNothingFields) import Data.Char (toUpper)-import Data.Fixed (Pico)-import Data.Functor.Compose (Compose(..))-import Data.Functor.Identity (Identity(..))-import Data.Functor.Product (Product(..))-import Data.Functor.Sum (Sum(..))+import Data.Either.Compat (isLeft, isRight) import Data.Hashable (hash)-import Data.List.NonEmpty (NonEmpty(..))+import Data.List (sort) import Data.Maybe (fromMaybe)-import Data.Proxy (Proxy(..))-import Data.Scientific (Scientific) import Data.Sequence (Seq) import Data.Tagged (Tagged(..)) import Data.Text (Text) import Data.Time (UTCTime) import Data.Time.Format (parseTime) import Data.Time.Locale.Compat (defaultTimeLocale)-import Data.Word (Word8) import GHC.Generics (Generic) import Instances ()+import System.Directory (doesDirectoryExist, getDirectoryContents)+import System.Exit (exitWith, ExitCode(ExitFailure))+import System.FilePath ((</>), takeExtension, takeFileName)+import System.IO (hPutStrLn, stderr) import Test.Framework (Test, testGroup) import Test.Framework.Providers.HUnit (testCase)-import Test.HUnit (Assertion, assertFailure, assertEqual)+import Test.HUnit (Assertion, assertBool, assertFailure, assertEqual) import Text.Printf (printf)-import Types (Approx(..), Compose3, Compose3', I) import UnitTests.NullaryConstructors (nullaryConstructors) import qualified Data.ByteString.Base16.Lazy as LBase16 import qualified Data.ByteString.Lazy.Char8 as L-import qualified Data.DList as DList-import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HashSet-import qualified Data.IntMap as IntMap-import qualified Data.IntSet as IntSet-import qualified Data.Map as M-import qualified Data.Monoid as Monoid-import qualified Data.Semigroup as Semigroup-import qualified Data.Sequence as Seq-import qualified Data.Set as Set import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Builder as TLB import qualified Data.Text.Lazy.Encoding as LT import qualified Data.Text.Lazy.Encoding as TLE-import qualified Data.Tree as Tree-import qualified Data.Vector as Vector+import qualified ErrorMessages+import qualified SerializationFormatSpec  tests :: Test tests = testGroup "unit" [-    testGroup "camelCase" [+    testGroup "SerializationFormatSpec" SerializationFormatSpec.tests+  , testGroup "ErrorMessages" ErrorMessages.tests+  , testGroup "camelCase" [       testCase "camelTo" $ roundTripCamel "aName"     , testCase "camelTo" $ roundTripCamel "another"     , testCase "camelTo" $ roundTripCamel "someOtherName"@@ -97,9 +82,6 @@       testCase "example 1" $ formatErrorExample     ]   , testGroup ".:, .:?, .:!" $ fmap (testCase "-") dotColonMark-  , testGroup "To JSON representation" $ fmap assertJsonEncodingExample jsonEncodingExamples-  , testGroup "From JSON representation" $ fmap assertJsonExample jsonDecodingExamples-  , testGroup "To/From JSON representation" $ fmap assertJsonExample jsonExamples   , testGroup "JSONPath" $ fmap (testCase "-") jsonPath   , testGroup "Hashable laws" $ fmap (testCase "-") hashableLaws   , testGroup "Issue #351" $ fmap (testCase "-") issue351@@ -123,17 +105,6 @@     capitalize t = toUpper (head t) : tail t  -data MyEither a b = MyLeft a | MyRight b-  deriving (Generic, Show, Eq)--instance (ToJSON a, ToJSON b) => ToJSON (MyEither a b) where-    toJSON = genericToJSON defaultOptions { sumEncoding = UntaggedValue }-    toEncoding = genericToEncoding defaultOptions { sumEncoding = UntaggedValue }--instance (FromJSON a, FromJSON b) => FromJSON (MyEither a b) where-    parseJSON = genericParseJSON defaultOptions { sumEncoding = UntaggedValue }-- data Wibble = Wibble {     wibbleString :: String   , wibbleInt :: Int@@ -274,173 +245,6 @@         ex3 = "{\"value\": null }"  --------------------------------------------------------------------------------- These tests assert that the JSON serialization doesn't change by accident.--------------------------------------------------------------------------------data Example where-    Example-        :: (Eq a, Show a, ToJSON a, FromJSON a)-        => String -> L.ByteString -> a -> Example-    MaybeExample-        :: (Eq a, Show a, FromJSON a)-        => String -> L.ByteString -> Maybe a -> Example--assertJsonExample :: Example -> Test-assertJsonExample (Example name bs val) = testCase name $ do-    assertEqual "encode"           bs         (encode val)-    assertEqual "encode/via value" bs         (encode $ toJSON val)-    assertEqual "decode"           (Just val) (decode bs)-assertJsonExample (MaybeExample name bs mval) = testCase name $-    assertEqual "decode" mval (decode bs)--assertJsonEncodingExample :: Example -> Test-assertJsonEncodingExample (Example name bs val) = testCase name $ do-    assertEqual "encode"           bs (encode val)-    assertEqual "encode/via value" bs (encode $ toJSON val)-assertJsonEncodingExample (MaybeExample name _ _) = testCase name $-    assertFailure "cannot encode MaybeExample"--jsonEncodingExamples :: [Example]-jsonEncodingExamples =-  [-  -- Maybe serialising is lossy-  -- https://github.com/bos/aeson/issues/376-    Example "Just Nothing" "null" (Just Nothing :: Maybe (Maybe Int))-  -- infinities cannot be recovered, null is decoded as NaN-  , Example "inf :: Double" "null" (Approx $ 1/0 :: Approx Double)-  ]--jsonDecodingExamples :: [Example]-jsonDecodingExamples = [-  -- Maybe serialising is lossy-  -- https://github.com/bos/aeson/issues/376-    MaybeExample "Nothing"      "null" (Just $ Nothing :: Maybe (Maybe Int))-  , MaybeExample "Just"         "1"    (Just $ Just 1 :: Maybe (Maybe Int))-  , MaybeExample "Just Nothing" "null" (Just $ Nothing :: Maybe (Maybe (Maybe Int)))-  -- Integral values are truncated, and overflowed-  -- https://github.com/bos/aeson/issues/317-  , MaybeExample "Word8 3"    "3"    (Just 3 :: Maybe Word8)-  , MaybeExample "Word8 3.00" "3.00" (Just 3 :: Maybe Word8)-  , MaybeExample "Word8 3.14" "3.14" (Nothing :: Maybe Word8)-  , MaybeExample "Word8 -1"   "-1"   (Nothing :: Maybe Word8)-  , MaybeExample "Word8 300"  "300"  (Nothing :: Maybe Word8)-  ]--jsonExamples :: [Example]-jsonExamples =-  [-    Example "Either Left" "{\"Left\":1}"  (Left 1 :: Either Int Int)-  , Example "Either Right" "{\"Right\":1}"  (Right 1 :: Either Int Int)-  , Example "Nothing"  "null"  (Nothing :: Maybe Int)-  , Example "Just"  "1"  (Just 1 :: Maybe Int)-  , Example "Proxy Int" "null"  (Proxy :: Proxy Int)-  , Example "Tagged Char Int" "1"  (Tagged 1 :: Tagged Char Int)-#if __GLASGOW_HASKELL__ >= 708-    -- Test Tagged instance is polykinded-  , Example "Tagged 123 Int" "1"  (Tagged 1 :: Tagged 123 Int)-#endif-  , Example "Const Char Int" "\"c\""  (Const 'c' :: Const Char Int)-  , Example "Tuple" "[1,2]"  ((1, 2) :: (Int, Int))-  , Example "NonEmpty" "[1,2,3]"  (1 :| [2, 3] :: NonEmpty Int)-  , Example "Seq" "[1,2,3]"  (Seq.fromList [1, 2, 3] ::  Seq.Seq Int)-  , Example "DList" "[1,2,3]"  (DList.fromList [1, 2, 3] :: DList.DList Int)-  , Example "()" "[]"  ()--  , Example "HashMap Int Int"          "{\"0\":1,\"2\":3}"  (HM.fromList [(0,1),(2,3)] :: HM.HashMap Int Int)-  , Example "Map Int Int"              "{\"0\":1,\"2\":3}"  (M.fromList [(0,1),(2,3)] :: M.Map Int Int)-  , Example "Map (Tagged Int Int) Int" "{\"0\":1,\"2\":3}"  (M.fromList [(Tagged 0,1),(Tagged 2,3)] :: M.Map (Tagged Int Int) Int)-  , Example "Map [Int] Int"            "[[[0],1],[[2],3]]"  (M.fromList [([0],1),([2],3)] :: M.Map [Int] Int)-  , Example "Map [Char] Int"           "{\"ab\":1,\"cd\":3}"  (M.fromList [("ab",1),("cd",3)] :: M.Map [Char] Int)-  , Example "Map [I Char] Int"         "{\"ab\":1,\"cd\":3}"  (M.fromList [(map pure "ab",1),(map pure "cd",3)] :: M.Map [I Char] Int)--  , Example "nan :: Double" "null"  (Approx $ 0/0 :: Approx Double)--  , Example "Ordering LT" "\"LT\"" LT-  , Example "Ordering EQ" "\"EQ\"" EQ-  , Example "Ordering GT" "\"GT\"" GT--  , Example "Float" "3.14" (3.14 :: Float)-  , Example "Pico" "3.14" (3.14 :: Pico)-  , Example "Scientific" "3.14" (3.14 :: Scientific)--  , Example "Set Int" "[1,2,3]" (Set.fromList [3, 2, 1] :: Set.Set Int)-  , Example "IntSet"  "[1,2,3]" (IntSet.fromList [3, 2, 1])-  , Example "IntMap" "[[1,2],[3,4]]" (IntMap.fromList [(3,4), (1,2)] :: IntMap.IntMap Int)-  , Example "Vector" "[1,2,3]" (Vector.fromList [1, 2, 3] :: Vector.Vector Int)-  , Example "HashSet Int" "[1,2,3]" (HashSet.fromList [3, 2, 1] :: HashSet.HashSet Int)-  , Example "Tree Int" "[1,[[2,[[3,[]],[4,[]]]],[5,[]]]]" (let n = Tree.Node in n 1 [n 2 [n 3 [], n 4 []], n 5 []] :: Tree.Tree Int)--  -- Three separate cases, as ordering in HashMap is not defined-  , Example "HashMap Float Int, NaN" "{\"NaN\":1}"  (Approx $ HM.singleton (0/0) 1 :: Approx (HM.HashMap Float Int))-  , Example "HashMap Float Int, Infinity" "{\"Infinity\":1}"  (HM.singleton (1/0) 1 :: HM.HashMap Float Int)-  , Example "HashMap Float Int, +Infinity" "{\"-Infinity\":1}"  (HM.singleton (negate 1/0) 1 :: HM.HashMap Float Int)--  -- Functors-  , Example "Identity Int" "1"  (pure 1 :: Identity Int)--  , Example "Identity Char" "\"x\""      (pure 'x' :: Identity Char)-  , Example "Identity String" "\"foo\""  (pure "foo" :: Identity String)-  , Example "[Identity Char]" "\"xy\""   ([pure 'x', pure 'y'] :: [Identity Char])--  , Example "Maybe Char" "\"x\""              (pure 'x' :: Maybe Char)-  , Example "Maybe String" "\"foo\""          (pure "foo" :: Maybe String)-  , Example "Maybe [Identity Char]" "\"xy\""  (pure [pure 'x', pure 'y'] :: Maybe [Identity Char])--  , Example "Product I Maybe Int" "[1,2]"         (Pair (pure 1) (pure 2) :: Product I Maybe Int)-  , Example "Product I Maybe Int" "[1,null]"      (Pair (pure 1) Nothing :: Product I Maybe Int)-  , Example "Product I [] Char" "[\"a\",\"foo\"]" (Pair (pure 'a') "foo" :: Product I [] Char)--  , Example "Sum I [] Int: InL"  "{\"InL\":1}"       (InL (pure 1) :: Sum I [] Int)-  , Example "Sum I [] Int: InR"  "{\"InR\":[1,2]}"   (InR [1, 2] :: Sum I [] Int)-  , Example "Sum I [] Char: InR" "{\"InR\":\"foo\"}" (InR "foo" :: Sum I [] Char)--  , Example "Compose I  I  Int" "1"      (pure 1 :: Compose I I   Int)-  , Example "Compose I  [] Int" "[1]"    (pure 1 :: Compose I []  Int)-  , Example "Compose [] I  Int" "[1]"    (pure 1 :: Compose [] I  Int)-  , Example "Compose [] [] Int" "[[1]]"  (pure 1 :: Compose [] [] Int)--  , Example "Compose I  I  Char" "\"x\""    (pure 'x' :: Compose I  I  Char)-  , Example "Compose I  [] Char" "\"x\""    (pure 'x' :: Compose I  [] Char)-  , Example "Compose [] I  Char" "\"x\""    (pure 'x' :: Compose [] I  Char)-  , Example "Compose [] [] Char" "[\"x\"]"  (pure 'x' :: Compose [] [] Char)--  , Example "Compose3 I  I  I  Char" "\"x\""      (pure 'x' :: Compose3 I  I  I  Char)-  , Example "Compose3 I  I  [] Char" "\"x\""      (pure 'x' :: Compose3 I  I  [] Char)-  , Example "Compose3 I  [] I  Char" "\"x\""      (pure 'x' :: Compose3 I  [] I  Char)-  , Example "Compose3 I  [] [] Char" "[\"x\"]"    (pure 'x' :: Compose3 I  [] [] Char)-  , Example "Compose3 [] I  I  Char" "\"x\""      (pure 'x' :: Compose3 [] I  I  Char)-  , Example "Compose3 [] I  [] Char" "[\"x\"]"    (pure 'x' :: Compose3 [] I  [] Char)-  , Example "Compose3 [] [] I  Char" "[\"x\"]"    (pure 'x' :: Compose3 [] [] I  Char)-  , Example "Compose3 [] [] [] Char" "[[\"x\"]]"  (pure 'x' :: Compose3 [] [] [] Char)--  , Example "Compose3' I  I  I  Char" "\"x\""      (pure 'x' :: Compose3' I  I  I  Char)-  , Example "Compose3' I  I  [] Char" "\"x\""      (pure 'x' :: Compose3' I  I  [] Char)-  , Example "Compose3' I  [] I  Char" "\"x\""      (pure 'x' :: Compose3' I  [] I  Char)-  , Example "Compose3' I  [] [] Char" "[\"x\"]"    (pure 'x' :: Compose3' I  [] [] Char)-  , Example "Compose3' [] I  I  Char" "\"x\""      (pure 'x' :: Compose3' [] I  I  Char)-  , Example "Compose3' [] I  [] Char" "[\"x\"]"    (pure 'x' :: Compose3' [] I  [] Char)-  , Example "Compose3' [] [] I  Char" "[\"x\"]"    (pure 'x' :: Compose3' [] [] I  Char)-  , Example "Compose3' [] [] [] Char" "[[\"x\"]]"  (pure 'x' :: Compose3' [] [] [] Char)--  , Example "MyEither Int String: Left"  "42"      (MyLeft 42     :: MyEither Int String)-  , Example "MyEither Int String: Right" "\"foo\"" (MyRight "foo" :: MyEither Int String)--  -- newtypes from Monoid/Semigroup-  , Example "Monoid.Dual Int" "2" (pure 2 :: Monoid.Dual Int)-  , Example "Monoid.First Int" "2" (pure 2 :: Monoid.First Int)-  , Example "Monoid.Last Int" "2" (pure 2 :: Monoid.Last Int)-  , Example "Semigroup.Min Int" "2" (pure 2 :: Semigroup.Min Int)-  , Example "Semigroup.Max Int" "2" (pure 2 :: Semigroup.Max Int)-  , Example "Semigroup.First Int" "2" (pure 2 :: Semigroup.First Int)-  , Example "Semigroup.Last Int" "2" (pure 2 :: Semigroup.Last Int)-  , Example "Semigroup.WrappedMonoid Int" "2" (Semigroup.WrapMonoid 2 :: Semigroup.WrappedMonoid Int)-  , Example "Semigroup.Option Just" "2" (pure 2 :: Semigroup.Option Int)-  , Example "Semigroup.Option Nothing" "null" (Semigroup.Option (Nothing :: Maybe Bool))-  ]---------------------------------------------------------------------------------- -- These tests check that JSONPath is tracked correctly ----------------------------------------------------------------------------- @@ -536,7 +340,8 @@ ioTests :: IO [Test] ioTests = do   enc <- encoderComparisonTests-  return [enc]+  js <- jsonTestSuite+  return [enc, js]  encoderComparisonTests :: IO Test encoderComparisonTests = do@@ -595,6 +400,82 @@       | L.length s == 8 =           L.concat ["\"\\u", L.take 4 s, "\\u", L.drop 4 s, "\""]       | otherwise = error "unescapeString: can't happen"++-- JSONTestSuite++jsonTestSuiteTest :: FilePath -> Test+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 Test+jsonTestSuite = do+  let suitePath = "tests/JSONTestSuite"+  exists <- doesDirectoryExist suitePath+  unless exists $ do+    hPutStrLn stderr $ "git clone https://github.com/nst/JSONTestSuite " +++                       suitePath+    exitWith (ExitFailure 1)+  -- ignore test_transform for now+  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"+  , "n_string_unescaped_crtl_char.json"+  , "n_string_unescaped_newline.json"+  , "n_string_unescaped_tab.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)