aeson 1.4.3.0 → 1.4.4.0

raw patch · 26 files changed

+712/−147 lines, 26 filesdep +time-compatdep −time-locale-compatdep ~QuickCheckdep ~bytestringdep ~hashablePVP ok

version bump matches the API change (PVP)

Dependencies added: time-compat

Dependencies removed: time-locale-compat

Dependency ranges changed: QuickCheck, bytestring, hashable, primitive, quickcheck-instances, semigroups, template-haskell, time

API changes (from Hackage documentation)

Files

• Data/Aeson.hs +9/−0
• Data/Aeson/Parser.hs +11/−1
• Data/Aeson/Parser/Internal.hs +155/−40
• Data/Aeson/TH.hs +0/−2
• Data/Aeson/Types.hs +11/−0
• Data/Aeson/Types/Class.hs +5/−1
• Data/Aeson/Types/FromJSON.hs +115/−22
• Data/Aeson/Types/Generic.hs +0/−1
• Data/Aeson/Types/Internal.hs +79/−0
• Data/Aeson/Types/ToJSON.hs +96/−10
• aeson.cabal +14/−11
• benchmarks/Compare/JsonBench.hs +2/−2
• benchmarks/CompareWithJSON.hs +1/−1
• benchmarks/Issue673.hs +1/−0
• benchmarks/JsonParse.hs +1/−1
• benchmarks/aeson-benchmarks.cabal +32/−27
• changelog.md +35/−0
• stack-bench.yaml +8/−1
• stack-ffi-unescape.yaml +6/−1
• stack-lts12.yaml +6/−1
• stack-nightly.yaml +5/−1
• tests/Encoders.hs +13/−0
• tests/PropertyRoundTrip.hs +7/−0
• tests/SerializationFormatSpec.hs +47/−19
• tests/UnitTests.hs +48/−5
• tests/UnitTests/NullaryConstructors.hs +5/−0

@@ -70,6 +70,11 @@     , ToJSONKeyFunction(..)     , FromJSONKey(..)     , FromJSONKeyFunction(..)+    -- *** Generic keys+    , GToJSONKey()+    , genericToJSONKey+    , GFromJSONKey()+    , genericFromJSONKey     -- ** Liftings to unary and binary type constructors     , FromJSON1(..)     , parseJSON1@@ -111,6 +116,10 @@     , SumEncoding(..)     , camelTo2     , defaultTaggedObject+    -- ** Options for object keys+    , JSONKeyOptions+    , keyModifier+    , defaultJSONKeyOptions      -- * Inspecting @'Value's@     , withObject

@@ -35,10 +35,20 @@     , value     , jstring     , scientific+    -- ** Handling objects with duplicate keys+    , jsonWith+    , jsonLast+    , jsonAccum+    , jsonNoDup     -- * Strict parsers     -- $strict     , json'     , value'+    -- ** Handling objects with duplicate keys+    , jsonWith'+    , jsonLast'+    , jsonAccum'+    , jsonNoDup'     -- * Decoding without FromJSON instances     , decodeWith     , decodeStrictWith@@ -47,7 +57,7 @@     ) where  -import Data.Aeson.Parser.Internal (decodeStrictWith, decodeWith, eitherDecodeStrictWith, eitherDecodeWith, json, json', jstring, scientific, value, value')+import Data.Aeson.Parser.Internal  -- $lazy --

@@ -5,6 +5,10 @@ #if MIN_VERSION_ghc_prim(0,3,1) {-# LANGUAGE MagicHash #-} #endif+#if __GLASGOW_HASKELL__ <= 710 && __GLASGOW_HASKELL__ >= 706+-- Work around a compiler bug+{-# OPTIONS_GHC -fsimpl-tick-factor=200 #-}+#endif -- | -- Module:      Data.Aeson.Parser.Internal -- Copyright:   (c) 2011-2016 Bryan O'Sullivan@@ -21,29 +25,43 @@     (     -- * Lazy parsers       json, jsonEOF+    , jsonWith+    , jsonLast+    , jsonAccum+    , jsonNoDup     , value     , jstring     , jstring_     , scientific     -- * Strict parsers     , json', jsonEOF'+    , jsonWith'+    , jsonLast'+    , jsonAccum'+    , jsonNoDup'     , value'     -- * Helpers     , decodeWith     , decodeStrictWith     , eitherDecodeWith     , eitherDecodeStrictWith+    -- ** Handling objects with duplicate keys+    , fromListAccum+    , parseListNoDup     ) where  import Prelude.Compat  import Control.Applicative ((<|>)) import Control.Monad (void, when)-import Data.Aeson.Types.Internal (IResult(..), JSONPath, Result(..), Value(..))+import Data.Aeson.Types.Internal (IResult(..), JSONPath, Object, Result(..), Value(..)) import Data.Attoparsec.ByteString.Char8 (Parser, char, decimal, endOfInput, isDigit_w8, signed, string)+import Data.Function (fix)+import Data.Functor.Compat (($>)) import Data.Scientific (Scientific) import Data.Text (Text)-import Data.Vector as Vector (Vector, empty, fromListN, reverse)+import Data.Vector (Vector)+import qualified Data.Vector as Vector (empty, fromList, fromListN, reverse) import qualified Data.Attoparsec.ByteString as A import qualified Data.Attoparsec.Lazy as L import qualified Data.ByteString as B@@ -75,7 +93,7 @@ #define C_n 110 #define C_t 116 --- | Parse a top-level JSON value.+-- | Parse any JSON value. -- -- The conversion of a parsed value to a Haskell value is deferred -- until the Haskell value is needed.  This may improve performance if@@ -85,10 +103,15 @@ -- This function is an alias for 'value'. In aeson 0.8 and earlier, it -- parsed only object or array types, in conformance with the -- now-obsolete RFC 4627.+--+-- ==== Warning+--+-- If an object contains duplicate keys, only the first one will be kept.+-- For a more flexible alternative, see 'jsonWith'. json :: Parser Value json = value --- | Parse a top-level JSON value.+-- | Parse any JSON value. -- -- This is a strict version of 'json' which avoids building up thunks -- during parsing; it performs all conversions immediately.  Prefer@@ -97,23 +120,35 @@ -- This function is an alias for 'value''. In aeson 0.8 and earlier, it -- parsed only object or array types, in conformance with the -- now-obsolete RFC 4627.+--+-- ==== Warning+--+-- If an object contains duplicate keys, only the first one will be kept.+-- For a more flexible alternative, see 'jsonWith''. json' :: Parser Value json' = value' -object_ :: Parser Value-object_ = {-# SCC "object_" #-} Object <$> objectValues jstring value+-- Open recursion: object_, object_', array_, array_' are parameterized by the+-- toplevel Value parser to be called recursively, to keep the parameter+-- mkObject outside of the recursive loop for proper inlining. -object_' :: Parser Value-object_' = {-# SCC "object_'" #-} do-  !vals <- objectValues jstring' value'+object_ :: ([(Text, Value)] -> Either String Object) -> Parser Value -> Parser Value+object_ mkObject val = {-# SCC "object_" #-} Object <$> objectValues mkObject jstring val+{-# INLINE object_ #-}++object_' :: ([(Text, Value)] -> Either String Object) -> Parser Value -> Parser Value+object_' mkObject val' = {-# SCC "object_'" #-} do+  !vals <- objectValues mkObject jstring' val'   return (Object vals)  where   jstring' = do     !s <- jstring     return s+{-# INLINE object_' #-} -objectValues :: Parser Text -> Parser Value -> Parser (H.HashMap Text Value)-objectValues str val = do+objectValues :: ([(Text, Value)] -> Either String Object)+             -> Parser Text -> Parser Value -> Parser (H.HashMap Text Value)+objectValues mkObject str val = do   skipSpace   w <- A.peekWord8'   if w == CLOSE_CURLY@@ -129,16 +164,20 @@     let acc' = (k, v) : acc     if ch == COMMA       then skipSpace >> loop acc'-      else return (H.fromList acc')+      else case mkObject acc' of+        Left err -> fail err+        Right obj -> pure obj {-# INLINE objectValues #-} -array_ :: Parser Value-array_ = {-# SCC "array_" #-} Array <$> arrayValues value+array_ :: Parser Value -> Parser Value+array_ val = {-# SCC "array_" #-} Array <$> arrayValues val+{-# INLINE array_ #-} -array_' :: Parser Value-array_' = {-# SCC "array_'" #-} do-  !vals <- arrayValues value'+array_' :: Parser Value -> Parser Value+array_' val = {-# SCC "array_'" #-} do+  !vals <- arrayValues val   return (Array vals)+{-# INLINE array_' #-}  arrayValues :: Parser Value -> Parser (Vector Value) arrayValues val = do@@ -156,50 +195,126 @@         else return (Vector.reverse (Vector.fromListN len (v:acc))) {-# INLINE arrayValues #-} --- | Parse any JSON value.  You should usually 'json' in preference to--- this function, as this function relaxes the object-or-array--- requirement of RFC 4627.------ In particular, be careful in using this function if you think your--- code might interoperate with Javascript.  A na&#xef;ve Javascript--- library that parses JSON data using @eval@ is vulnerable to attack--- unless the encoded data represents an object or an array.  JSON--- implementations in other languages conform to that same restriction--- to preserve interoperability and security.+-- | Parse any JSON value. Synonym of 'json'. value :: Parser Value-value = do+value = jsonWith (pure . H.fromList)++-- | Parse any JSON value.+--+-- This parser is parameterized by a function to construct an 'Object'+-- from a raw list of key-value pairs, where duplicates are preserved.+-- The pairs appear in __reverse order__ from the source.+--+-- ==== __Examples__+--+-- 'json' keeps only the first occurence of each key, using 'HashMap.Lazy.fromList'.+--+-- @+-- 'json' = 'jsonWith' ('Right' '.' 'H.fromList')+-- @+--+-- 'jsonLast' keeps the last occurence of each key, using+-- @'HashMap.Lazy.fromListWith' ('const' 'id')@.+--+-- @+-- 'jsonLast' = 'jsonWith' ('Right' '.' 'HashMap.Lazy.fromListWith' ('const' 'id'))+-- @+--+-- 'jsonAccum' keeps wraps all values in arrays to keep duplicates, using+-- 'fromListAccum'.+--+-- @+-- 'jsonAccum' = 'jsonWith' ('Right' . 'fromListAccum')+-- @+--+-- 'jsonNoDup' fails if any object contains duplicate keys, using 'parseListNoDup'.+--+-- @+-- 'jsonNoDup' = 'jsonWith' 'parseListNoDup'+-- @+jsonWith :: ([(Text, Value)] -> Either String Object) -> Parser Value+jsonWith mkObject = fix $ \value_ -> do   skipSpace   w <- A.peekWord8'   case w of     DOUBLE_QUOTE  -> A.anyWord8 *> (String <$> jstring_)-    OPEN_CURLY    -> A.anyWord8 *> object_-    OPEN_SQUARE   -> A.anyWord8 *> array_-    C_f           -> string "false" *> pure (Bool False)-    C_t           -> string "true" *> pure (Bool True)-    C_n           -> string "null" *> pure Null+    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"+{-# INLINE jsonWith #-} --- | Strict version of 'value'. See also 'json''.+-- | Variant of 'json' which keeps only the last occurence of every key.+jsonLast :: Parser Value+jsonLast = jsonWith (Right . H.fromListWith (const id))++-- | Variant of 'json' wrapping all object mappings in 'Array' to preserve+-- key-value pairs with the same keys.+jsonAccum :: Parser Value+jsonAccum = jsonWith (Right . fromListAccum)++-- | Variant of 'json' which fails if any object contains duplicate keys.+jsonNoDup :: Parser Value+jsonNoDup = jsonWith parseListNoDup++-- | @'fromListAccum' kvs@ is an object mapping keys to arrays containing all+-- associated values from the original list @kvs@.+--+-- >>> fromListAccum [("apple", Bool True), ("apple", Bool False), ("orange", Bool False)]+-- fromList [("apple", [Bool False, Bool True]), ("orange", [Bool False])]+fromListAccum :: [(Text, Value)] -> Object+fromListAccum =+  fmap (Array . Vector.fromList . ($ [])) . H.fromListWith (.) . (fmap . fmap) (:)++-- | @'fromListNoDup' kvs@ fails if @kvs@ contains duplicate keys.+parseListNoDup :: [(Text, Value)] -> Either String Object+parseListNoDup =+  H.traverseWithKey unwrap . H.fromListWith (\_ _ -> Nothing) . (fmap . fmap) Just+  where+    unwrap k Nothing = Left $ "found duplicate key: " ++ show k+    unwrap _ (Just v) = Right v++-- | Strict version of 'value'. Synonym of 'json''. value' :: Parser Value-value' = do+value' = jsonWith' (pure . H.fromList)++-- | Strict version of 'jsonWith'.+jsonWith' :: ([(Text, Value)] -> Either String Object) -> Parser Value+jsonWith' mkObject = fix $ \value_ -> do   skipSpace   w <- A.peekWord8'   case w of     DOUBLE_QUOTE  -> do                      !s <- A.anyWord8 *> jstring_                      return (String s)-    OPEN_CURLY    -> A.anyWord8 *> object_'-    OPEN_SQUARE   -> A.anyWord8 *> array_'-    C_f           -> string "false" *> pure (Bool False)-    C_t           -> string "true" *> pure (Bool True)-    C_n           -> string "null" *> pure Null+    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"+{-# INLINE jsonWith' #-}++-- | Variant of 'json'' which keeps only the last occurence of every key.+jsonLast' :: Parser Value+jsonLast' = jsonWith' (pure . H.fromListWith (const id))++-- | Variant of 'json'' wrapping all object mappings in 'Array' to preserve+-- key-value pairs with the same keys.+jsonAccum' :: Parser Value+jsonAccum' = jsonWith' (pure . fromListAccum)++-- | Variant of 'json'' which fails if any object contains duplicate keys.+jsonNoDup' :: Parser Value+jsonNoDup' = jsonWith' parseListNoDup  -- | Parse a quoted JSON string. jstring :: Parser Text

@@ -159,8 +159,6 @@ import qualified Data.Vector as V (unsafeIndex, null, length, create, empty) import qualified Data.Vector.Mutable as VM (unsafeNew, unsafeWrite) -{-# ANN module "Hlint: ignore Reduce duplication" #-}- -------------------------------------------------------------------------------- -- Convenience --------------------------------------------------------------------------------

@@ -53,6 +53,12 @@     , coerceFromJSONKeyFunction     , mapFromJSONKeyFunction +    -- *** Generic keys+    , GToJSONKey()+    , genericToJSONKey+    , GFromJSONKey()+    , genericFromJSONKey+     -- ** Liftings to unary and binary type constructors     , FromJSON1(..)     , parseJSON1@@ -125,6 +131,11 @@     , camelTo2     , defaultOptions     , defaultTaggedObject++    -- ** Options for object keys+    , JSONKeyOptions+    , keyModifier+    , defaultJSONKeyOptions     ) where  import Prelude.Compat

@@ -6,7 +6,6 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeSynonymInstances #-}  -- | -- Module:      Data.Aeson.Types.Class@@ -59,6 +58,11 @@     , fromJSONKeyCoerce     , coerceFromJSONKeyFunction     , mapFromJSONKeyFunction+    -- ** Generic keys+    , GToJSONKey()+    , genericToJSONKey+    , GFromJSONKey()+    , genericFromJSONKey     -- * Object key-value pairs     , KeyValue(..) 

@@ -11,7 +11,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ViewPatterns #-} @@ -46,6 +45,9 @@     , coerceFromJSONKeyFunction     , mapFromJSONKeyFunction +    , GFromJSONKey()+    , genericFromJSONKey+     -- * List functions     , listParser @@ -88,7 +90,7 @@ import Data.Aeson.Types.Generic import Data.Aeson.Types.Internal import Data.Bits (unsafeShiftR)-import Data.Fixed (Fixed, HasResolution)+import Data.Fixed (Fixed, HasResolution (resolution), Nano) import Data.Functor.Compose (Compose(..)) import Data.Functor.Identity (Identity(..)) import Data.Functor.Product (Product(..))@@ -104,8 +106,10 @@ import Data.Tagged (Tagged(..)) import Data.Text (Text, pack, unpack) import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)-import Data.Time.Format (parseTime)-import Data.Time.Locale.Compat (defaultTimeLocale)+import Data.Time.Calendar.Compat (CalendarDiffDays (..), DayOfWeek (..))+import Data.Time.LocalTime.Compat (CalendarDiffTime (..))+import Data.Time.Clock.System.Compat (SystemTime (..))+import Data.Time.Format.Compat (parseTimeM, defaultTimeLocale) import Data.Traversable as Tr (sequence) import Data.Vector (Vector) import Data.Version (Version, parseVersion)@@ -148,7 +152,9 @@ import qualified Data.Primitive.Types as PM  #if MIN_VERSION_primitive(0,6,4)+#if !MIN_VERSION_primitive(0,7,0) import qualified Data.Primitive.UnliftedArray as PM+#endif import qualified Data.Primitive.PrimArray as PM #endif @@ -403,6 +409,16 @@ --   > newtype SomeId = SomeId { getSomeId :: Text } --   >   deriving (Eq,Ord,Hashable,FromJSONKey) --+--   If you have a sum of nullary constructors, you may use the generic+--   implementation:+--+-- @+-- data Color = Red | Green | Blue+--   deriving Generic+--+-- instance 'FromJSONKey' Color where+--   'fromJSONKey' = 'genericFromJSONKey' 'defaultJSONKeyOptions'+-- @ class FromJSONKey a where     -- | Strategy for parsing the key of a map-like container.     fromJSONKey :: FromJSONKeyFunction a@@ -501,6 +517,35 @@ mapFromJSONKeyFunction :: (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b mapFromJSONKeyFunction = fmap +-- | 'fromJSONKey' for 'Generic' types.+-- These types must be sums of nullary constructors, whose names will be used+-- as keys for JSON objects.+--+-- See also 'genericToJSONKey'.+--+-- === __Example__+--+-- @+-- data Color = Red | Green | Blue+--   deriving 'Generic'+--+-- instance 'FromJSONKey' Color where+--   'fromJSONKey' = 'genericFromJSONKey' 'defaultJSONKeyOptions'+-- @+genericFromJSONKey :: forall a. (Generic a, GFromJSONKey (Rep a))+             => JSONKeyOptions+             -> FromJSONKeyFunction a+genericFromJSONKey opts = FromJSONKeyTextParser $ \t ->+    case parseSumFromString (keyModifier opts) t of+        Nothing -> fail $+            "invalid key " ++ show t ++ ", expected one of " ++ show cnames+        Just k -> pure (to k)+  where+    cnames = unTagged2 (constructorTags (keyModifier opts) :: Tagged2 (Rep a) [String])++class    (ConstructorNames f, SumFromString f) => GFromJSONKey f where+instance (ConstructorNames f, SumFromString f) => GFromJSONKey f where+ ------------------------------------------------------------------------------- -- Functions needed for documentation -------------------------------------------------------------------------------@@ -1017,41 +1062,46 @@ parseAllNullarySum tname opts =     withText tname $ \tag ->         maybe (badTag tag) return $-            parseSumFromString opts tag+            parseSumFromString modifier tag   where-    badTag tag = failWithCTags tname opts $ \cnames ->+    badTag tag = failWithCTags tname modifier $ \cnames ->         "expected one of the tags " ++ show cnames ++         ", but found tag " ++ show tag+    modifier = constructorTagModifier opts  -- | Fail with an informative error message about a mismatched tag. -- The error message is parameterized by the list of expected tags, -- to be inferred from the result type of the parser. failWithCTags-  :: forall f a. ConstructorNames f-  => TypeName -> Options -> ([String] -> String) -> Parser (f a)-failWithCTags tname opts f =+  :: forall f a t. ConstructorNames f+  => TypeName -> (String -> t) -> ([t] -> String) -> Parser (f a)+failWithCTags tname modifier f =     contextType tname . fail $ f cnames   where-    cnames = unTagged2 (constructorTags opts :: Tagged2 f [String])+    cnames = unTagged2 (constructorTags modifier :: Tagged2 f [t])  class SumFromString f where-    parseSumFromString :: Options -> Text -> Maybe (f a)+    parseSumFromString :: (String -> String) -> Text -> Maybe (f a)  instance (SumFromString a, SumFromString b) => SumFromString (a :+: b) where     parseSumFromString opts key = (L1 <$> parseSumFromString opts key) <|>                                   (R1 <$> parseSumFromString opts key)  instance (Constructor c) => SumFromString (C1 c U1) where-    parseSumFromString opts key | key == name = Just $ M1 U1-                                | otherwise   = Nothing-        where-          name = pack $ constructorTagModifier opts $-                          conName (undefined :: M1 _i c _f _p)+    parseSumFromString modifier key+        | key == name = Just $ M1 U1+        | otherwise   = Nothing+      where+        name = pack $ modifier $ conName (undefined :: M1 _i c _f _p) +-- For genericFromJSONKey+instance SumFromString a => SumFromString (D1 d a) where+    parseSumFromString modifier key = M1 <$> parseSumFromString modifier key+ -- | List of all constructor tags.-constructorTags :: ConstructorNames a => Options -> Tagged2 a [String]-constructorTags opts =-    fmap DList.toList (constructorNames' (constructorTagModifier opts))+constructorTags :: ConstructorNames a => (String -> t) -> Tagged2 a [t]+constructorTags modifier =+    fmap DList.toList (constructorNames' modifier)  -- | List of all constructor names of an ADT, after a given conversion -- function. (Better inlining.)@@ -1072,6 +1122,13 @@       where         cname = conName (undefined :: M1 _i c _f _p) +-- For genericFromJSONKey+instance ConstructorNames a => ConstructorNames (D1 d a) where+    constructorNames' = retag . constructorNames'+      where+        retag :: Tagged2 a u -> Tagged2 (D1 d a) u+        retag (Tagged2 x) = Tagged2 x+ --------------------------------------------------------------------------------  parseNonAllNullarySum :: ( FromPair          arity f@@ -1123,7 +1180,7 @@        UntaggedValue -> parseUntaggedValue p   where-    failWith_ = failWithCTags tname opts+    failWith_ = failWithCTags tname (constructorTagModifier opts)  -------------------------------------------------------------------------------- @@ -1660,7 +1717,7 @@     liftParseJSON p _ = withArray "NonEmpty" $         (>>= ne) . Tr.sequence . zipWith (parseIndexedJSON p) [0..] . V.toList       where-        ne []     = fail "parsing NonEmpty failed, unpexpected empty list"+        ne []     = fail "parsing NonEmpty failed, unexpected empty list"         ne (x:xs) = pure (x :| xs)     {-# INLINE liftParseJSON #-} @@ -1915,7 +1972,7 @@     parseJSON = withText "DotNetTime" $ \t ->         let (s,m) = T.splitAt (T.length t - 5) t             t'    = T.concat [s,".",m]-        in case parseTime defaultTimeLocale "/Date(%s%Q)/" (unpack t') of+        in case parseTimeM True defaultTimeLocale "/Date(%s%Q)/" (unpack t') of              Just d -> pure (DotNetTime d)              _      -> fail "could not parse .NET time"     {-# INLINE parseJSON #-}@@ -1937,10 +1994,12 @@ instance (PM.Prim a,FromJSON a) => FromJSON (PM.PrimArray a) where   parseJSON = fmap Exts.fromList . parseJSON +#if !MIN_VERSION_primitive(0,7,0) instance (PM.PrimUnlifted a,FromJSON a) => FromJSON (PM.UnliftedArray a) where   parseJSON = fmap Exts.fromList . parseJSON #endif #endif+#endif  ------------------------------------------------------------------------------- -- time@@ -2008,6 +2067,40 @@ instance FromJSON DiffTime where     parseJSON = withBoundedScientific "DiffTime" $ pure . realToFrac     {-# INLINE parseJSON #-}++instance FromJSON SystemTime where+    parseJSON v = prependContext "SystemTime" $ do+        n <- parseJSON v+        let n' = floor (n * fromInteger (resolution n) :: Nano)+        let (secs, nano) = n' `divMod` resolution n+        return (MkSystemTime (fromInteger secs) (fromInteger nano))++instance FromJSON CalendarDiffTime where+    parseJSON = withObject "CalendarDiffTime" $ \obj -> CalendarDiffTime+        <$> obj .: "months"+        <*> obj .: "time"++instance FromJSON CalendarDiffDays where+    parseJSON = withObject "CalendarDiffDays" $ \obj -> CalendarDiffDays+        <$> obj .: "months"+        <*> obj .: "days"++instance FromJSON DayOfWeek where+    parseJSON = withText "DaysOfWeek" parseDayOfWeek++parseDayOfWeek :: T.Text -> Parser DayOfWeek+parseDayOfWeek t = case T.toLower t of+    "monday"    -> return Monday+    "tuesday"   -> return Tuesday+    "wednesday" -> return Wednesday+    "thursday"  -> return Thursday+    "friday"    -> return Friday+    "saturday"  -> return Saturday+    "sunday"    -> return Sunday+    _           -> fail "Invalid week day"++instance FromJSONKey DayOfWeek where+    fromJSONKey = FromJSONKeyTextParser parseDayOfWeek  ------------------------------------------------------------------------------- -- base Monoid/Semigroup

@@ -5,7 +5,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-}

@@ -65,8 +65,10 @@         )      , SumEncoding(..)+    , JSONKeyOptions(keyModifier)     , defaultOptions     , defaultTaggedObject+    , defaultJSONKeyOptions      -- * Used for changing CamelCase names into something else.     , camelTo@@ -158,8 +160,10 @@     IError path err >>= _ = IError path err     {-# INLINE (>>=) #-} +#if !(MIN_VERSION_base(4,13,0))     fail = Fail.fail     {-# INLINE fail #-}+#endif  instance Fail.MonadFail IResult where     fail err = IError [] err@@ -173,8 +177,10 @@     Error err >>= _ = Error err     {-# INLINE (>>=) #-} +#if !(MIN_VERSION_base(4,13,0))     fail = Fail.fail     {-# INLINE fail #-}+#endif  instance Fail.MonadFail Result where     fail err = Error err@@ -288,8 +294,11 @@     {-# INLINE (>>=) #-}     return = pure     {-# INLINE return #-}++#if !(MIN_VERSION_base(4,13,0))     fail = Fail.fail     {-# INLINE fail #-}+#endif  instance Fail.MonadFail Parser where     fail msg = Parser $ \path kf _ks -> kf (reverse path) msg@@ -561,6 +570,39 @@       -- ^ If 'True' record fields with a 'Nothing' value will be       -- omitted from the resulting object. If 'False' the resulting       -- object will include those fields mapping to @null@.+      --+      -- === Note+      --+      -- Setting 'omitNothingFields' to 'True' only affects fields which are of+      -- type 'Maybe' /uniformly/ in the 'ToJSON' or 'FromJSON' instance. In+      -- particular, if the type of a field is declared as a type variable, it+      -- will not be omitted from the JSON object, unless the field is+      -- specialized upfront in the instance.+      --+      -- ==== __Example__+      --+      -- The generic instance for the following type @Fruit@ depends on whether+      -- the instance head is @Fruit a@ or @Fruit (Maybe a)@.+      --+      -- @+      -- data Fruit a =+      --   { apples :: a  -- A field whose type is a type variable.+      --   , oranges :: 'Maybe' Int+      --   }+      --+      -- options :: 'Options'+      -- options = 'defaultOptions' { 'omitNothingFields' = 'True' }+      --+      -- -- apples required, oranges optional+      -- -- Even if 'Data.Aeson.fromJSON' is then specialized to (Fruit ('Maybe' a)).+      -- instance 'Data.Aeson.FromJSON' a => 'Data.Aeson.FromJSON' (Fruit a) where+      --   'Data.Aeson.fromJSON' = 'Data.Aeson.genericFromJSON' options+      --+      -- -- apples optional, oranges optional+      -- -- In this instance, the field apples is uniformly of type ('Maybe' a).+      -- instance 'Data.Aeson.FromJSON' a => 'Data.Aeson.FromJSON' (Fruit ('Maybe' a)) where+      --   'Data.Aeson.fromJSON' = 'Data.Aeson.genericFromJSON' options+      -- @     , sumEncoding :: SumEncoding       -- ^ Specifies how to encode constructors of a sum datatype.     , unwrapUnaryRecords :: Bool@@ -625,6 +667,33 @@     -- contents of the constructor.     deriving (Eq, Show) +-- | Options for encoding keys with 'Data.Aeson.Types.genericFromJSONKey' and+-- 'Data.Aeson.Types.genericToJSONKey'.+data JSONKeyOptions = JSONKeyOptions+    { keyModifier :: String -> String+      -- ^ Function applied to keys. Its result is what goes into the encoded+      -- 'Value'.+      --+      -- === __Example__+      --+      -- The following instances encode the constructor @Bar@ to lower-case keys+      -- @\"bar\"@.+      --+      -- @+      -- data Foo = Bar+      --   deriving 'Generic'+      --+      -- opts :: 'JSONKeyOptions'+      -- opts = 'defaultJSONKeyOptions' { 'keyModifier' = 'toLower' }+      --+      -- instance 'ToJSONKey' Foo where+      --   'toJSONKey' = 'genericToJSONKey' opts+      --+      -- instance 'FromJSONKey' Foo where+      --   'fromJSONKey' = 'genericFromJSONKey' opts+      -- @+    }+ -- | Default encoding 'Options': -- -- @@@ -662,6 +731,16 @@                       { tagFieldName      = "tag"                       , contentsFieldName = "contents"                       }++-- | Default 'JSONKeyOptions':+--+-- @+-- defaultJSONKeyOptions = 'JSONKeyOptions'+--                         { 'keyModifier' = 'id'+--                         }+-- @+defaultJSONKeyOptions :: JSONKeyOptions+defaultJSONKeyOptions = JSONKeyOptions id  -- | Converts from CamelCase to another lower case, interspersing --   the character between all capital letters and their previous

@@ -5,7 +5,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-}@@ -13,7 +12,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-}  #if __GLASGOW_HASKELL__ >= 706@@ -49,6 +47,10 @@     , ToJSONKeyFunction(..)     , toJSONKeyText     , contramapToJSONKeyFunction++    , GToJSONKey()+    , genericToJSONKey+     -- * Object key-value pairs     , KeyValue(..)     , KeyValuePair(..)@@ -71,7 +73,7 @@ import Data.Attoparsec.Number (Number(..)) import Data.Bits (unsafeShiftR) import Data.DList (DList)-import Data.Fixed (Fixed, HasResolution)+import Data.Fixed (Fixed, HasResolution, Nano) import Data.Foldable (toList) import Data.Functor.Compose (Compose(..)) import Data.Functor.Contravariant (Contravariant (..))@@ -88,8 +90,10 @@ import Data.Tagged (Tagged(..)) import Data.Text (Text, pack) import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)-import Data.Time.Format (FormatTime, formatTime)-import Data.Time.Locale.Compat (defaultTimeLocale)+import Data.Time.Calendar.Compat (CalendarDiffDays (..), DayOfWeek (..))+import Data.Time.LocalTime.Compat (CalendarDiffTime (..))+import Data.Time.Clock.System.Compat (SystemTime (..))+import Data.Time.Format.Compat (FormatTime, formatTime, defaultTimeLocale) import Data.Vector (Vector) import Data.Version (Version, showVersion) import Data.Void (Void, absurd)@@ -135,7 +139,9 @@ import qualified Data.Primitive.Types as PM  #if MIN_VERSION_primitive(0,6,4)+#if !MIN_VERSION_primitive(0,7,0) import qualified Data.Primitive.UnliftedArray as PM+#endif import qualified Data.Primitive.PrimArray as PM #endif @@ -147,8 +153,6 @@ import qualified Data.ByteString.Lazy.Internal as L #endif -{-# ANN module ("HLint: ignore Reduce duplication"::String) #-}- toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b) {-# INLINE toJSONPair #-}@@ -411,7 +415,7 @@ --   newtype wrapper around 'Text'. The recommended approach is to use --   generalized newtype deriving: -----   > newtype RecordId = RecordId { getRecordId :: Text}+--   > newtype RecordId = RecordId { getRecordId :: Text } --   >   deriving (Eq,Ord,ToJSONKey) -- --   Then we may write:@@ -426,8 +430,18 @@ -- --   It is possible to get the 'ToJSONKey' instance for free as we did --   with 'Foo'. However, in this case, we have a natural way to go to---   and from 'Text' that does not require any escape sequences. So, in---   this example, 'ToJSONKeyText' will be used instead of 'ToJSONKeyValue'.+--   and from 'Text' that does not require any escape sequences. So+--   'ToJSONKeyText' can be used instead of 'ToJSONKeyValue' to encode maps+--   as objects instead of arrays of pairs. This instance may be+--   implemented using generics as follows:+--+-- @+-- instance 'ToJSONKey' Color where+--   'toJSONKey' = 'genericToJSONKey' 'defaultJSONKeyOptions'+-- @+--+--   === __Low-level implementations__+-- --   The 'Show' instance can be used to help write 'ToJSONKey': -- --   > instance ToJSONKey Color where@@ -515,6 +529,29 @@     ToJSONKeyText  f g -> ToJSONKeyText (f . h) (g . h)     ToJSONKeyValue f g -> ToJSONKeyValue (f . h) (g . h) +-- 'toJSONKey' for 'Generic' types.+-- Deriving is supported for enumeration types, i.e. the sums of nullary+-- constructors. The names of constructors will be used as keys for JSON+-- objects.+--+-- See also 'genericFromJSONKey'.+--+-- === __Example__+--+-- @+-- data Color = Red | Green | Blue+--   deriving 'Generic'+--+-- instance 'ToJSONKey' Color where+--   'toJSONKey' = 'genericToJSONKey' 'defaultJSONKeyOptions'+-- @+genericToJSONKey :: (Generic a, GToJSONKey (Rep a))+           => JSONKeyOptions -> ToJSONKeyFunction a+genericToJSONKey opts = toJSONKeyText (pack . keyModifier opts . getConName . from)++class    GetConName f => GToJSONKey f+instance GetConName f => GToJSONKey f+ ------------------------------------------------------------------------------- -- Lifings of FromJSON and ToJSON to unary and binary type constructors -------------------------------------------------------------------------------@@ -944,6 +981,9 @@ instance (Constructor c) => GetConName (C1 c a) where     getConName = conName +-- For genericToJSONKey+instance GetConName a => GetConName (D1 d a) where+    getConName (M1 x) = getConName x  -------------------------------------------------------------------------------- @@ -1959,11 +1999,13 @@   toJSON = toJSON . Exts.toList   toEncoding = toEncoding . Exts.toList +#if !MIN_VERSION_primitive(0,7,0) instance (PM.PrimUnlifted a,ToJSON a) => ToJSON (PM.UnliftedArray a) where   toJSON = toJSON . Exts.toList   toEncoding = toEncoding . Exts.toList #endif #endif+#endif  ------------------------------------------------------------------------------- -- time@@ -2032,6 +2074,50 @@      toEncoding = E.scientific . realToFrac     {-# INLINE toEncoding #-}++-- | Encoded as number+instance ToJSON SystemTime where+    toJSON (MkSystemTime secs nsecs) =+        toJSON (fromIntegral secs + fromIntegral nsecs / 1000000000 :: Nano)+    toEncoding (MkSystemTime secs nsecs) =+        toEncoding (fromIntegral secs + fromIntegral nsecs / 1000000000 :: Nano)++instance ToJSON CalendarDiffTime where+    toJSON (CalendarDiffTime m nt) = object+        [ "months" .= m+        , "time" .= nt+        ]+    toEncoding (CalendarDiffTime m nt) = E.pairs+        ("months" .= m <> "time" .= nt)++instance ToJSON CalendarDiffDays where+    toJSON (CalendarDiffDays m d) = object+        [ "months" .= m+        , "days" .= d+        ]+    toEncoding (CalendarDiffDays m d) = E.pairs+        ("months" .= m <> "days" .= d)++instance ToJSON DayOfWeek where+    toJSON Monday    = "monday"+    toJSON Tuesday   = "tuesday"+    toJSON Wednesday = "wednesday"+    toJSON Thursday  = "thursday"+    toJSON Friday    = "friday"+    toJSON Saturday  = "saturday"+    toJSON Sunday    = "sunday"++toEncodingDayOfWeek :: DayOfWeek -> E.Encoding' Text+toEncodingDayOfWeek Monday    = E.unsafeToEncoding "\"monday\""+toEncodingDayOfWeek Tuesday   = E.unsafeToEncoding "\"tuesday\""+toEncodingDayOfWeek Wednesday = E.unsafeToEncoding "\"wednesday\""+toEncodingDayOfWeek Thursday  = E.unsafeToEncoding "\"thursday\""+toEncodingDayOfWeek Friday    = E.unsafeToEncoding "\"friday\""+toEncodingDayOfWeek Saturday  = E.unsafeToEncoding "\"saturday\""+toEncodingDayOfWeek Sunday    = E.unsafeToEncoding "\"sunday\""++instance ToJSONKey DayOfWeek where+    toJSONKey = toJSONKeyTextEnc toEncodingDayOfWeek  ------------------------------------------------------------------------------- -- base Monoid/Semigroup

@@ -1,5 +1,5 @@ name:            aeson-version:         1.4.3.0+version:         1.4.4.0 license:         BSD3 license-file:    LICENSE category:        Text, Web, JSON@@ -111,12 +111,16 @@     text             >= 1.2.3.0 && < 1.3,     time             >= 1.4     && < 1.9 +  if impl(ghc >= 8.0)+    build-depends: bytestring >= 0.10.8.1+   -- Compat   build-depends:-    base-compat     >= 0.9.1    && < 0.11+    base-compat     >= 0.9.1    && < 0.11,+    time-compat     >= 1.9.2.2  && < 1.10    if flag(bytestring-builder)-    build-depends: bytestring >= 0.9.2 && < 0.10.4,+    build-depends: bytestring >= 0.9.2.1 && < 0.10.4,                    bytestring-builder >= 0.10.4 && < 1   else     build-depends: bytestring >= 0.10.4 && < 0.11@@ -128,7 +132,7 @@   if !impl(ghc >= 8.0)     -- `Data.Semigroup` and `Control.Monad.Fail` and `Control.Monad.IO.Class` are available in base only since GHC 8.0 / base 4.9     build-depends:-      semigroups          >= 0.18.5  && < 0.19,+      semigroups          >= 0.18.5  && < 0.20,       transformers        >= 0.3.0.0 && < 0.6,       transformers-compat >= 0.6.2   && < 0.7,       fail == 4.9.*@@ -144,16 +148,15 @@      -- not in LTS-12.10     tagged               >= 0.8.5    && < 0.9,-    primitive            >= 0.6.3.0  && < 0.7+    primitive            >= 0.6.3.0  && < 0.8    -- Other dependencies   build-depends:     attoparsec           >= 0.13.2.2 && < 0.14,     dlist                >= 0.8.0.4  && < 0.9,-    hashable             >= 1.2.7.0  && < 1.3,+    hashable             >= 1.2.7.0  && < 1.4,     scientific           >= 0.3.6.2  && < 0.4,     th-abstraction       >= 0.2.8.0  && < 0.4,-    time-locale-compat   >= 0.1.1.5  && < 0.2,     uuid-types           >= 1.0.3    && < 1.1,     vector               >= 0.12.0.1 && < 0.13 @@ -211,7 +214,7 @@     UnitTests.NullaryConstructors    build-depends:-    QuickCheck >= 2.10.0.1 && < 2.13,+    QuickCheck >= 2.10.0.1 && < 2.14,     aeson,     integer-logarithms >= 1 && <1.1,     attoparsec,@@ -236,11 +239,11 @@     tasty-quickcheck,     text,     time,-    time-locale-compat,+    time-compat,     unordered-containers,     uuid-types,     vector,-    quickcheck-instances >= 0.3.16+    quickcheck-instances >= 0.3.21 && <0.4    if flag(bytestring-builder)     build-depends: bytestring >= 0.9 && < 0.10.4,@@ -250,7 +253,7 @@    if !impl(ghc >= 8.0)     build-depends:-      semigroups >= 0.18.2 && < 0.19,+      semigroups >= 0.18.2 && < 0.20,       transformers >= 0.2.2.0,       transformers-compat >= 0.3 

@@ -68,10 +68,10 @@ instance NFData Fruit where rnf !_ = ()  instance NFData Friend where-    rnf Friend {..} = rnf fId `seq` rnf fName `seq` ()+    rnf Friend {..} = rnf fId `seq` rnf fName  instance NFData User where-    rnf User {..} = rnf uId `seq` rnf uIndex `seq` rnf uGuid `seq` rnf uIsActive `seq` rnf uBalance `seq` rnf uPicture `seq` rnf uAge `seq` rnf uEyeColor `seq` rnf uName `seq` rnf uGender `seq` rnf uCompany `seq` rnf uEmail `seq` rnf uPhone `seq` rnf uAddress `seq` rnf uAbout `seq` rnf uRegistered `seq` rnf uLatitude `seq` rnf uLongitude `seq` rnf uTags `seq` rnf uFriends `seq` rnf uGreeting `seq` rnf uFavouriteFruit `seq` ()+    rnf User {..} = rnf uId `seq` rnf uIndex `seq` rnf uGuid `seq` rnf uIsActive `seq` rnf uBalance `seq` rnf uPicture `seq` rnf uAge `seq` rnf uEyeColor `seq` rnf uName `seq` rnf uGender `seq` rnf uCompany `seq` rnf uEmail `seq` rnf uPhone `seq` rnf uAddress `seq` rnf uAbout `seq` rnf uRegistered `seq` rnf uLatitude `seq` rnf uLongitude `seq` rnf uTags `seq` rnf uFriends `seq` rnf uGreeting `seq` rnf uFavouriteFruit  eyeColorTable :: [(Text, EyeColor)] eyeColorTable = [("brown", Brown), ("green", Green), ("blue", Blue)]

@@ -27,7 +27,7 @@ instance NFData J.JSValue where   rnf J.JSNull = ()   rnf (J.JSBool b) = rnf b-  rnf (J.JSRational a b) = rnf a `seq` rnf b `seq` ()+  rnf (J.JSRational a b) = rnf a `seq` rnf b   rnf (J.JSString s) = rnf (J.fromJSString s)   rnf (J.JSArray lst) = rnf lst   rnf (J.JSObject o) = rnf o

@@ -18,6 +18,7 @@ import Prelude.Compat import Data.Int (Int64) import Data.Scientific (Scientific)+import Data.Semigroup ((<>)) import Data.Aeson.Parser (scientific)  import qualified Data.Attoparsec.ByteString.Lazy as AttoL

@@ -17,7 +17,7 @@ instance NFData JSValue where     rnf JSNull = ()     rnf (JSBool b) = rnf b-    rnf (JSRational b r) = rnf b `seq` rnf r `seq` ()+    rnf (JSRational b r) = rnf b `seq` rnf r     rnf (JSString s) = rnf (fromJSString s)     rnf (JSArray vs) = rnf vs     rnf (JSObject kvs) = rnf (fromJSObject kvs)

@@ -28,44 +28,42 @@     hs-source-dirs: .. ../ffi ../pure ../attoparsec-iso8601     c-sources:  ../cbits/unescape_string.c     build-depends:-      attoparsec >= 0.13.0.1,-      base == 4.*,-      base-compat >= 0.9.1 && <0.11,-      time-locale-compat >=0.1.1 && <0.2,+      attoparsec,+      base,+      base-compat,       containers,       deepseq,-      dlist >= 0.2,-      fail == 4.9.*,-      ghc-prim >= 0.2,-      hashable >= 1.1.2.0,+      dlist,+      fail,+      ghc-prim,+      hashable,       mtl,-      primitive >= 0.6.1,-      scientific >= 0.3.4.7 && < 0.4,+      primitive,+      scientific,       syb,-      tagged >=0.8.3 && <0.9,-      template-haskell >= 2.4,-      text >= 1.2.3,-      th-abstraction >= 0.2.2 && < 0.4,+      tagged,+      template-haskell,+      text,+      th-abstraction,+      time-compat,       time,       transformers,-      unordered-containers >= 0.2.3.0,-      uuid-types >= 1.0.3 && <1.1,-      vector >= 0.7.1--    if !impl(ghc >= 7.10)-      -- `Numeric.Natural` is available in base only since GHC 7.10 / base 4.8-      build-depends: nats >= 1 && < 1.2+      unordered-containers,+      uuid-types,+      vector -    if impl(ghc >=7.8)-      cpp-options: -DHAS_COERCIBLE+    if !impl(ghc >= 8.6)+      build-depends: contravariant      if !impl(ghc >= 8.0)       -- `Data.Semigroup` is available in base only since GHC 8.0 / base 4.9-      build-depends: semigroups >= 0.18.2 && < 0.19+      build-depends: semigroups,+                     transformers-compat -    if !impl(ghc >= 8.6)-      build-depends:-       contravariant >=1.4.1    && <1.6+    if !impl(ghc >= 7.10)+      -- `Numeric.Natural` is available in base only since GHC 7.10 / base 4.8+      build-depends: nats,+                     void      include-dirs: ../include @@ -178,6 +176,9 @@      Compare.JsonBuilder    build-depends:      json-builder+ if impl(ghc < 8.0)+   build-depends:+     semigroups  executable aeson-benchmark-micro   default-language: Haskell2010@@ -224,6 +225,8 @@                    bytestring-builder >= 0.10.4 && < 1   else     build-depends: bytestring >= 0.10.4+  if impl(ghc < 8.0)+    build-depends: semigroups  executable aeson-benchmark-compare-with-json   default-language: Haskell2010@@ -339,3 +342,5 @@     scientific,     base-compat,     criterion >= 1.0+  if impl(ghc < 8.0)+    build-depends: semigroups

@@ -1,5 +1,40 @@ 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.4.4.0++**New features**:++* Adds a parameterized parser `jsonWith` that can be used to choose how to handle duplicate keys in objects, thanks to Xia Li-Yao.++* Add generic implementations of `FromJSONKey` and `ToJSONKey`, thanks to Xia Li-Yao. Example:++```haskell+data Foo = Bar+  deriving Generic++opts :: JSONKeyOptions+opts = defaultJSONKeyOptions { keyModifier = toLower }++instance ToJSONKey Foo where+  toJSONKey = genericToJSONKey opts++instance FromJSONKey Foo where+  fromJSONKey = genericFromJSONKey opts+```++**Minor**:+* aeson now uses `time-compat` instead of `time-locale-compat`, thanks to Oleg Grenrus.+* Prepare for `MonadFail` breakages in GHC 8.8, thanks to Oleg Grenrus.+* Require `bytestring >= 0.10.8.1` for newer GHCs to avoid build failures, thanks to Oleg Grenrus.+* Support `primitive 0.7.*`, thanks to Adam Bergmark.+* Allow `semigroups 0.19.*` and `hashable 1.3.*`, thanks to Oleg Grenrus.+* Fix a typo in the error message when parsing `NonEmpty`, thanks to Colin Woodbury.+* Document surprising behavior when using `omitNothingFields` with type variables, thanks to Xia Li-Yao.++**Internal changes**:+* Code cleanup by Oleg Grenrus+* Fix dependencies of the benchmarks on older GHC's, thanks to Xia Li-Yao.+ ### 1.4.3.0 * Improve error messages for FromJSON in existing instances and GHC Generic implementation. Thanks to Xia Li-Yao & Igor Pashev. * Tweak error-reporting combinators and their documentation. Thanks to Xia Li-Yao.

@@ -1,4 +1,4 @@-resolver: lts-12.10+resolver: lts-12.26 # We use aeson in the snapshot to # - avoid recompilation of criterion # - compare against it@@ -9,3 +9,10 @@ work-dir: .stack-work-bench packages: - benchmarks+extra-deps:+- base-orphans-0.8.1+- hashable-time-0.2.0.1+- QuickCheck-2.13.1+- quickcheck-instances-0.3.21+- splitmix-0.0.2+- time-compat-1.9.2.2

@@ -1,4 +1,4 @@-resolver: lts-12.10+resolver: lts-12.26 packages: - '.' flags:@@ -6,4 +6,9 @@     fast: true     cffi: true extra-deps:+- base-orphans-0.8.1 - hashable-time-0.2.0.1+- QuickCheck-2.13.1+- quickcheck-instances-0.3.21+- splitmix-0.0.2+- time-compat-1.9.2.2

@@ -1,4 +1,4 @@-resolver: lts-12.10+resolver: lts-12.26 packages: - '.' - attoparsec-iso8601@@ -7,4 +7,9 @@     fast: true     cffi: true extra-deps:+- base-orphans-0.8.1 - hashable-time-0.2.0.1+- QuickCheck-2.13.1+- quickcheck-instances-0.3.21+- splitmix-0.0.2+- time-compat-1.9.2.2

@@ -1,4 +1,4 @@-resolver: nightly-2018-09-26+resolver: nightly-2019-05-13 packages: - '.' - attoparsec-iso8601@@ -7,3 +7,7 @@     fast: true   attoparsec-iso8601:     fast: true+extra-deps:+- hlint-2.1.18+- time-compat-1.9.2.2+- quickcheck-instances-0.3.21

@@ -6,6 +6,7 @@ module Encoders (module Encoders) where  import Prelude.Compat+import Data.Text (Text)  import Data.Aeson.TH import Data.Aeson.Types@@ -96,6 +97,18 @@ gNullaryParseJSONObjectWithSingleField :: Value -> Parser Nullary gNullaryParseJSONObjectWithSingleField = genericParseJSON optsObjectWithSingleField +keyOptions :: JSONKeyOptions+keyOptions = defaultJSONKeyOptions { keyModifier = ('k' :) }++gNullaryToJSONKey :: Nullary -> Either String Text+gNullaryToJSONKey x = case genericToJSONKey keyOptions of+  ToJSONKeyText p _ -> Right (p x)+  _ -> Left "Should be a ToJSONKeyText"++gNullaryFromJSONKey :: Text -> Parser Nullary+gNullaryFromJSONKey t = case genericFromJSONKey keyOptions of+  FromJSONKeyTextParser p -> p t+  _ -> fail "Not a TextParser"  -------------------------------------------------------------------------------- -- SomeType encoders/decoders

@@ -14,6 +14,9 @@ import Data.Tagged (Tagged) import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime) import Data.Version (Version)+import Data.Time.Calendar.Compat (CalendarDiffDays, DayOfWeek)+import Data.Time.LocalTime.Compat (CalendarDiffTime)+import Data.Time.Clock.System.Compat (SystemTime) import Instances () import Numeric.Natural (Natural) import Test.Tasty (TestTree, testGroup)@@ -47,6 +50,10 @@     , testProperty "ZonedTime" $ roundTripEq (undefined :: ZonedTime)     , testProperty "NominalDiffTime" $ roundTripEq (undefined :: NominalDiffTime)     , testProperty "DiffTime" $ roundTripEq (undefined :: DiffTime)+    , testProperty "DayOfWeek" $ roundTripEq (undefined :: DayOfWeek)+    , testProperty "SystemTime" $ roundTripEq (undefined :: SystemTime)+    , testProperty "CalendarDiffTime" $ roundTripEq (undefined :: CalendarDiffTime)+    , testProperty "CalendarDiffDays" $ roundTripEq (undefined :: CalendarDiffDays)     , testProperty "Version" $ roundTripEq (undefined :: Version)     , testProperty "Natural" $ roundTripEq (undefined :: Natural)     , testProperty "Proxy" $ roundTripEq (undefined :: Proxy Int)

@@ -32,6 +32,9 @@ import Data.Scientific (Scientific) import Data.Tagged (Tagged(..)) import Data.Time (fromGregorian)+import Data.Time.Calendar.Compat (CalendarDiffDays (..), DayOfWeek (..))+import Data.Time.LocalTime.Compat (CalendarDiffTime (..))+import Data.Time.Clock.System.Compat (SystemTime (..)) import Data.Word (Word8) import GHC.Generics (Generic) import Instances ()@@ -68,6 +71,9 @@     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)+  -- Maybe serialising is lossy+  -- https://github.com/bos/aeson/issues/376+  , Example "Just Nothing" ["null"] (Just Nothing :: Maybe (Maybe Int)) Nothing   , example "Just"  "1"  (Just 1 :: Maybe Int)   , example "Proxy Int" "null"  (Proxy :: Proxy Int)   , example "Tagged Char Int" "1"  (Tagged 1 :: Tagged Char Int)@@ -82,22 +88,22 @@   , example "DList" "[1,2,3]"  (DList.fromList [1, 2, 3] :: DList.DList Int)   , example "()" "[]"  () -  , Example "HashMap Int Int"+  , ndExample "HashMap Int Int"         [ "{\"0\":1,\"2\":3}", "{\"2\":3,\"0\":1}"]         (HM.fromList [(0,1),(2,3)] :: HM.HashMap Int Int)-  , Example "Map Int Int"+  , ndExample "Map Int Int"         [ "{\"0\":1,\"2\":3}", "{\"2\":3,\"0\":1}"]         (M.fromList [(0,1),(2,3)] :: M.Map Int Int)-  , Example "Map (Tagged Int Int) Int"+  , ndExample "Map (Tagged Int Int) Int"         [ "{\"0\":1,\"2\":3}", "{\"2\":3,\"0\":1}"]         (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"+  , ndExample "Map [Char] Int"         [ "{\"ab\":1,\"cd\":3}", "{\"cd\":3,\"ab\":1}" ]         (M.fromList [("ab",1),("cd",3)] :: M.Map String Int)-  , Example "Map [I Char] Int"+  , ndExample "Map [I Char] Int"         [ "{\"ab\":1,\"cd\":3}", "{\"cd\":3,\"ab\":1}" ]         (M.fromList [(map pure "ab",1),(map pure "cd",3)] :: M.Map [I Char] Int) @@ -193,16 +199,27 @@   , 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))++  -- time 1.9+  , example "SystemTime" "123.123456789" (MkSystemTime 123 123456789)+  , Example "SystemTime" ["124.23456789"]+    (MkSystemTime 123 1234567890)+    (MkSystemTime 124 234567890)+  , ndExample "CalendarDiffTime"+    [ "{\"months\":12,\"time\":456.789}", "{\"time\":456.789,\"months\":12}" ]+    (CalendarDiffTime 12 456.789)+  , ndExample "CalendarDiffDays"+    [ "{\"months\":12,\"days\":20}", "{\"days\":20,\"months\":12}" ]+    (CalendarDiffDays 12 20)+  , example "DayOfWeek" "\"monday\"" Monday   ]  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)+    example "inf :: Double" "null" (Approx $ 1/0 :: Approx Double)+  , example "-inf :: Double" "null" (Approx $ -1/0 :: Approx Double)   ]  jsonDecodingExamples :: [Example]@@ -224,17 +241,28 @@   ]  data Example where-    Example-        :: (Eq a, Show a, ToJSON a, FromJSON a)-        => String -> [L.ByteString] -> a -> Example -- empty bytestring will fail, any p [] == False-    MaybeExample-        :: (Eq a, Show a, FromJSON a)-        => String -> L.ByteString -> Maybe a -> Example+  Example+    :: (Eq a, Show a, ToJSON a, FromJSON a)+    => String          -- name+    -> [L.ByteString]  -- encoded variants+    -> a               -- input+    -> a               -- decoded+    -> Example         -- empty bytestring will fail, any p [] == False +  MaybeExample+    :: (Eq a, Show a, FromJSON a)+    => String -> L.ByteString -> Maybe a -> Example+ example :: (Eq a, Show a, ToJSON a, FromJSON a)         => String -> L.ByteString -> a -> Example-example n bs x = Example n [bs] x+example n bs x = Example n [bs] x x +-- | Non-deterministic example, input encodes to some of bytestrings.+ndExample :: (Eq a, Show a, ToJSON a, FromJSON a)+          => String -> [L.ByteString] -> a -> Example+ndExample n bss x = Example n bss x x++ data MyEither a b = MyLeft a | MyRight b   deriving (Generic, Show, Eq) @@ -246,16 +274,16 @@     parseJSON = genericParseJSON defaultOptions { sumEncoding = UntaggedValue }  assertJsonExample :: Example -> TestTree-assertJsonExample (Example name bss val) = testCase name $ do+assertJsonExample (Example name bss val val') = testCase name $ do     assertSomeEqual "encode"           bss        (encode val)     assertSomeEqual "encode/via value" bss        (encode $ toJSON val)     for_ bss $ \bs ->-        assertEqual "decode"           (Just val) (decode bs)+        assertEqual "decode"           (Just val') (decode bs) assertJsonExample (MaybeExample name bs mval) = testCase name $     assertEqual "decode" mval (decode bs)  assertJsonEncodingExample :: Example -> TestTree-assertJsonEncodingExample (Example name bss val) = testCase name $ do+assertJsonEncodingExample (Example name bss val _) = testCase name $ do     assertSomeEqual "encode"           bss (encode val)     assertSomeEqual "encode/via value" bss (encode $ toJSON val) assertJsonEncodingExample (MaybeExample name _ _) = testCase name $

@@ -29,7 +29,13 @@ import Data.Aeson.QQ.Simple (aesonQQ) import Data.Aeson.TH (deriveJSON, deriveToJSON, deriveToJSON1) import Data.Aeson.Text (encodeToTextBuilder)-import Data.Aeson.Types (Options(..), Result(Success), ToJSON(..), Value(Null, Object), camelTo, camelTo2, defaultOptions, omitNothingFields, parse)+import Data.Aeson.Parser+  ( json, jsonLast, jsonAccum, jsonNoDup+  , json', jsonLast', jsonAccum', jsonNoDup')+import Data.Aeson.Types+  ( Options(..), Result(Success), ToJSON(..), Value(Array, Bool, Null, Object)+  , camelTo, camelTo2, defaultOptions, omitNothingFields, parse)+import Data.Attoparsec.ByteString (Parser, parseOnly) import Data.Char (toUpper) import Data.Either.Compat (isLeft, isRight) import Data.Hashable (hash)@@ -40,24 +46,26 @@ 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.Time.Format.Compat (parseTimeM, defaultTimeLocale) import GHC.Generics (Generic) 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, assertBool, 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.HashMap.Lazy as HashMap 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.Vector as Vector import qualified ErrorMessages import qualified SerializationFormatSpec @@ -103,6 +111,7 @@   , testGroup "SingleMaybeField" singleMaybeField   , testCase "withEmbeddedJSON" withEmbeddedJSONTest   , testCase "SingleFieldCon" singleFieldCon+  , testGroup "Ordering of object keys" keyOrdering   , testCase "Ratio with denominator 0" ratioDenominator0   , testCase "Big scientific exponent" bigScientificExponent   , testCase "Big integer decoding" bigIntegerDecoding@@ -215,7 +224,7 @@   where     parseWithRead :: String -> LT.Text -> UTCTime     parseWithRead f s =-      fromMaybe (error "parseTime input malformed") . parseTime defaultTimeLocale f . LT.unpack $ s+      fromMaybe (error "parseTime input malformed") . parseTimeM True defaultTimeLocale f . LT.unpack $ s     parseWithAeson :: LT.Text -> Maybe UTCTime     parseWithAeson s = decode . LT.encodeUtf8 $ LT.concat ["\"", s, "\""] @@ -557,6 +566,40 @@ singleFieldCon :: Assertion singleFieldCon =   assertEqual "fromJSON" (Right (SingleFieldCon 0)) (eitherDecode "0")++testParser :: (Eq a, Show a)+           => String -> Parser a -> S.ByteString -> Either String a -> TestTree+testParser name json_ s expected =+  testCase name (parseOnly json_ s @?= expected)++keyOrdering :: [TestTree]+keyOrdering =+  [ testParser "json" json+      "{\"k\":true,\"k\":false}" $+      Right (Object (HashMap.fromList [("k", Bool True)]))+  , testParser "jsonLast" jsonLast+      "{\"k\":true,\"k\":false}" $+      Right (Object (HashMap.fromList [("k", Bool False)]))+  , testParser "jsonAccum" jsonAccum+      "{\"k\":true,\"k\":false}" $+      Right (Object (HashMap.fromList [("k", Array (Vector.fromList [Bool True, Bool False]))]))+  , testParser "jsonNoDup" jsonNoDup+      "{\"k\":true,\"k\":false}" $+      Left "Failed reading: found duplicate key: \"k\""++  , testParser "json'" json'+      "{\"k\":true,\"k\":false}" $+      Right (Object (HashMap.fromList [("k", Bool True)]))+  , testParser "jsonLast'" jsonLast'+      "{\"k\":true,\"k\":false}" $+      Right (Object (HashMap.fromList [("k", Bool False)]))+  , testParser "jsonAccum'" jsonAccum'+      "{\"k\":true,\"k\":false}" $+      Right (Object (HashMap.fromList [("k", Array (Vector.fromList [Bool True, Bool False]))]))+  , testParser "jsonNoDup'" jsonNoDup'+      "{\"k\":true,\"k\":false}" $+      Left "Failed reading: found duplicate key: \"k\""+  ]  ratioDenominator0 :: Assertion ratioDenominator0 =

@@ -14,6 +14,7 @@ import Data.Aeson.Internal (IResult (..), iparse) import Data.Aeson.Types (Parser) import Data.ByteString.Builder (toLazyByteString)+import Data.Foldable (for_) import Data.Maybe (fromJust) import Encoders import Test.Tasty.HUnit ((@=?), Assertion)@@ -52,6 +53,10 @@     -- Make sure that the old `"contents" : []' is still allowed   , ISuccess C1 @=? parse thNullaryParseJSONTaggedObject          (dec "{\"tag\":\"c1\",\"contents\":[]}")   , ISuccess C1 @=? parse gNullaryParseJSONTaggedObject           (dec "{\"tag\":\"c1\",\"contents\":[]}")++  , for_ [("kC1", C1), ("kC2", C2), ("kC3", C3)] $ \(jkey, key) -> do+      Right   jkey @=? gNullaryToJSONKey key+      ISuccess key @=? parse gNullaryFromJSONKey jkey   ]   where     enc = eitherDecode . toLazyByteString . fromEncoding