aeson 1.1.1.0 → 1.1.2.0
raw patch · 28 files changed
+280/−226 lines, 28 filesdep ~bytestringdep ~containersdep ~dlistPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: bytestring, containers, dlist
API changes (from Hackage documentation)
Files
- Data/Aeson/Encoding/Builder.hs +1/−1
- Data/Aeson/Internal/Time.hs +3/−2
- Data/Aeson/Parser/Internal.hs +2/−0
- Data/Aeson/TH.hs +29/−58
- Data/Aeson/Types/FromJSON.hs +45/−37
- Data/Aeson/Types/Internal.hs +15/−14
- Data/Aeson/Types/ToJSON.hs +59/−40
- aeson.cabal +1/−1
- benchmarks/AesonCompareAutoInstances.hs +2/−2
- benchmarks/AesonEncode.hs +2/−3
- benchmarks/AesonMap.hs +4/−4
- benchmarks/AesonParse.hs +1/−2
- benchmarks/AesonTuples.hs +0/−2
- benchmarks/Compare/JsonBench.hs +2/−3
- benchmarks/CompareWithJSON.hs +3/−6
- benchmarks/Dates.hs +8/−8
- benchmarks/ReadFile.hs +1/−1
- benchmarks/Typed/Common.hs +2/−0
- changelog.md +6/−0
- examples/Twitter.hs +3/−0
- examples/Twitter/Generic.hs +0/−1
- examples/Twitter/Manual.hs +4/−1
- pure/Data/Aeson/Parser/UnescapePure.hs +9/−9
- tests/Encoders.hs +13/−0
- tests/Instances.hs +2/−1
- tests/Properties.hs +36/−16
- tests/SerializationFormatSpec.hs +3/−3
- tests/UnitTests.hs +24/−11
Data/Aeson/Encoding/Builder.hs view
@@ -292,7 +292,7 @@ where iend = off + len - outerLoop !i0 !br@(B.BufferRange op0 ope)+ outerLoop !i0 br@(B.BufferRange op0 ope) | i0 >= iend = k br | outRemaining > 0 = goPartial (i0 + min outRemaining inpRemaining) -- TODO: Use a loop with an integrated bound's check if outRemaining
Data/Aeson/Internal/Time.hs view
@@ -20,14 +20,13 @@ import Prelude () import Prelude.Compat -import Data.Fixed (Pico) import Data.Int (Int64) import Data.Time import Unsafe.Coerce (unsafeCoerce) #if MIN_VERSION_base(4,7,0) -import Data.Fixed (Fixed(MkFixed))+import Data.Fixed (Pico, Fixed(MkFixed)) toPico :: Integer -> Pico toPico = MkFixed@@ -36,6 +35,8 @@ fromPico (MkFixed i) = i #else++import Data.Fixed (Pico) toPico :: Integer -> Pico toPico = unsafeCoerce
Data/Aeson/Parser/Internal.hs view
@@ -221,6 +221,8 @@ in Just (S a') data S = S Int#+-- This hint will no longer trigger once hlint > 1.9.41 is released.+{-# ANN S ("HLint: ignore Use newtype instead of data" :: String) #-} #else startState = False go a c
Data/Aeson/TH.hs view
@@ -403,44 +403,27 @@ isNullary (NormalC _ []) = True isNullary _ = False -sumToValue :: Options -> Bool -> Name -> Q Exp -> Q Exp-sumToValue opts multiCons conName exp+sumToValue :: Options -> Bool -> Bool -> Name -> Q Exp -> Q Exp+sumToValue opts multiCons nullary conName exp | multiCons = case sumEncoding opts of TwoElemArray -> [|Array|] `appE` ([|V.fromList|] `appE` listE [conStr opts conName, exp]) TaggedObject{tagFieldName, contentsFieldName} ->- [|A.object|] `appE` listE- [ infixApp [|T.pack tagFieldName|] [|(.=)|] (conStr opts conName)- , infixApp [|T.pack contentsFieldName|] [|(.=)|] exp- ]+ let tag = infixApp [|T.pack tagFieldName|] [|(.=)|] (conStr opts conName)+ contents = infixApp [|T.pack contentsFieldName|] [|(.=)|] exp+ in+ [|A.object|] `appE` listE (if nullary then [tag] else [tag, contents]) ObjectWithSingleField -> [|A.object|] `appE` listE [ infixApp (conTxt opts conName) [|(.=)|] exp ]+ UntaggedValue | nullary -> conStr opts conName UntaggedValue -> exp | otherwise = exp -nullarySumToValue :: Options -> Bool -> Name -> Q Exp-nullarySumToValue opts multiCons conName =- case sumEncoding opts of- TaggedObject{tagFieldName} ->- [|A.object|] `appE` listE- [ infixApp [|T.pack tagFieldName|] [|(.=)|] (conStr opts conName)- ]- UntaggedValue -> conStr opts conName- _ -> sumToValue opts multiCons conName [e|toJSON ([] :: [()])|]- -- | Generates code to generate the JSON encoding of a single constructor. argsToValue :: JSONClass -> [(Name, Name)] -> Options -> Bool -> Con -> Q Match--- Nullary constructors. Generates code that explicitly matches against the--- constructor even though it doesn't contain data. This is useful to prevent--- type errors.-argsToValue jc tjs opts multiCons (NormalC conName []) = do- ([], _) <- reifyConTys jc tjs conName- match (conP conName [])- (normalB (nullarySumToValue opts multiCons conName))- [] -- Polyadic constructors with special case for unary constructors. argsToValue jc tjs opts multiCons (NormalC conName ts) = do@@ -471,7 +454,7 @@ (varE 'V.create `appE` doE (newMV:stmts++[ret])) match (conP conName $ map varP args)- (normalB $ sumToValue opts multiCons conName js)+ (normalB $ sumToValue opts multiCons (null ts) conName js) [] -- Records.@@ -538,7 +521,7 @@ ar <- newName "argR" match (infixP (varP al) conName (varP ar)) ( normalB- $ sumToValue opts multiCons conName+ $ sumToValue opts multiCons False conName $ [|toJSON|] `appE` listE [ dispatchToJSON jc conName tvMap aTy `appE` varE a | (a, aTy) <- [(al,alTy), (ar,arTy)]@@ -580,41 +563,27 @@ object :: ExpQ -> ExpQ object exp = [|E.wrapObject|] `appE` exp -sumToEncoding :: Options -> Bool -> Name -> Q Exp -> Q Exp-sumToEncoding opts multiCons conName exp+sumToEncoding :: Options -> Bool -> Bool -> Name -> Q Exp -> Q Exp+sumToEncoding opts multiCons nullary conName exp | multiCons = let fexp = exp in case sumEncoding opts of TwoElemArray -> array (encStr opts conName <%> fexp) TaggedObject{tagFieldName, contentsFieldName} ->- object $- ([|E.text (T.pack tagFieldName)|] <:> encStr opts conName) <%>- ([|E.text (T.pack contentsFieldName)|] <:> fexp)+ let tag = [|E.text (T.pack tagFieldName)|] <:> encStr opts conName+ contents = [|E.text (T.pack contentsFieldName)|] <:> fexp+ in+ object $+ if nullary then tag else tag <%> contents ObjectWithSingleField -> object (encStr opts conName <:> fexp)+ UntaggedValue | nullary -> encStr opts conName UntaggedValue -> exp | otherwise = exp -nullarySumToEncoding :: Options -> Bool -> Name -> Q Exp-nullarySumToEncoding opts multiCons conName =- case sumEncoding opts of- TaggedObject{tagFieldName} ->- object $- [|E.text (T.pack tagFieldName)|] <:> encStr opts conName- UntaggedValue -> encStr opts conName- _ -> sumToEncoding opts multiCons conName [e|toEncoding ([] :: [()])|]- -- | Generates code to generate the JSON encoding of a single constructor. argsToEncoding :: JSONClass -> [(Name, Name)] -> Options -> Bool -> Con -> Q Match--- Nullary constructors. Generates code that explicitly matches against the--- constructor even though it doesn't contain data. This is useful to prevent--- type errors.-argsToEncoding jc tes opts multiCons (NormalC conName []) = do- ([], _) <- reifyConTys jc tes conName- match (conP conName [])- (normalB (nullarySumToEncoding opts multiCons conName))- [] -- Polyadic constructors with special case for unary constructors. argsToEncoding jc tes opts multiCons (NormalC conName ts) = do@@ -622,6 +591,9 @@ let len = length ts args <- newNameList "arg" len js <- case zip args argTys of+ -- Nullary constructors are converted to an empty array.+ [] -> return [| E.emptyArray_ |]+ -- Single argument is directly converted. [(e,eTy)] -> return (dispatchToEncoding jc conName tvMap eTy `appE` varE e)@@ -632,7 +604,7 @@ | (x,xTy) <- es ])) match (conP conName $ map varP args)- (normalB $ sumToEncoding opts multiCons conName js)+ (normalB $ sumToEncoding opts multiCons (null ts) conName js) [] -- Records.@@ -701,7 +673,7 @@ ([alTy,arTy], tvMap) <- reifyConTys jc tes conName match (infixP (varP al) conName (varP ar)) ( normalB- $ sumToEncoding opts multiCons conName+ $ sumToEncoding opts multiCons False conName $ array (foldr1 (<%>) [ dispatchToEncoding jc conName tvMap aTy `appE` varE a | (a,aTy) <- [(al,alTy), (ar,arTy)]@@ -1657,7 +1629,7 @@ -- instance C (Fam [Char]) remainingTysOrigSubst :: [Type] remainingTysOrigSubst =- map (substNamesWithKindStar (union droppedKindVarNames kvNames'))+ map (substNamesWithKindStar (droppedKindVarNames `union` kvNames')) $ take remainingLength varTysOrig remainingTysOrigSubst' :: [Type]@@ -2146,7 +2118,7 @@ createKindChain = go starK where go :: Kind -> Int -> Kind- go k !0 = k+ go k 0 = k #if MIN_VERSION_template_haskell(2,8,0) go k !n = go (AppT (AppT ArrowT StarT) k) (n - 1) #else@@ -2273,7 +2245,7 @@ substNameWithKind n k = substKind (M.singleton n k) substNamesWithKindStar :: [Name] -> Type -> Type-substNamesWithKindStar ns t = foldr' (flip substNameWithKind starK) t ns+substNamesWithKindStar ns t = foldr' (`substNameWithKind` starK) t ns ------------------------------------------------------------------------------- -- Error messages@@ -2422,13 +2394,12 @@ -- | Does a Type have kind * or k (for some kind variable k)? canRealizeKindStar :: Type -> StarKindStatus-canRealizeKindStar t- | hasKindStar t = KindStar- | otherwise = case t of+canRealizeKindStar t = case t of+ _ | hasKindStar t -> KindStar #if MIN_VERSION_template_haskell(2,8,0)- SigT _ (VarT k) -> IsKindVar k+ SigT _ (VarT k) -> IsKindVar k #endif- _ -> NotKindStar+ _ -> NotKindStar -- | Returns 'Just' the kind variable 'Name' of a 'StarKindStatus' if it exists. -- Otherwise, returns 'Nothing'.
Data/Aeson/Types/FromJSON.hs view
@@ -281,12 +281,12 @@ -- -- The basic ways to signal a failed conversion are as follows: ----- * 'empty' and 'mzero' work, but are terse and uninformative+-- * 'empty' and 'mzero' work, but are terse and uninformative; ----- * 'fail' yields a custom error message+-- * 'fail' yields a custom error message; -- -- * 'typeMismatch' produces an informative message for cases when the--- value encountered is not of the expected type+-- value encountered is not of the expected type. -- -- An example type and instance using 'typeMismatch': --@@ -296,27 +296,27 @@ -- -- data Coord = Coord { x :: Double, y :: Double } ----- instance FromJSON Coord where--- parseJSON ('Object' v) = Coord--- '<$>' v '.:' \"x\" +-- instance 'FromJSON' Coord where+-- 'parseJSON' ('Object' v) = Coord+-- '<$>' v '.:' \"x\" -- '<*>' v '.:' \"y\" -- -- \-- We do not expect a non-'Object' value here. -- \-- We could use 'mzero' to fail, but 'typeMismatch' -- \-- gives a much more informative error message.--- parseJSON invalid = 'typeMismatch' \"Coord\" invalid+-- 'parseJSON' invalid = 'typeMismatch' \"Coord\" invalid -- @ -- -- For this common case of only being concerned with a single--- type of JSON value, the functions @withObject@, @withNumber@, etc.+-- type of JSON value, the functions 'withObject', 'withNumber', etc. -- are provided. Their use is to be preferred when possible, since--- they are more terse. Using @withObject@, we can rewrite the above instance +-- they are more terse. Using 'withObject', we can rewrite the above instance -- (assuming the same language extension and data type) as: -- -- @--- instance FromJSON Coord where--- parseJSON = withObject \"Coord\" $ \v -> Coord--- '<$>' v '.:' \"x\" +-- instance 'FromJSON' Coord where+-- 'parseJSON' = 'withObject' \"Coord\" $ \v -> Coord+-- '<$>' v '.:' \"x\" -- '<*>' v '.:' \"y\" -- @ --@@ -325,7 +325,7 @@ -- -- * "Data.Aeson.TH" provides Template Haskell functions which will derive an -- instance at compile time. The generated instance is optimized for your type--- so will probably be more efficient than the following two options:+-- so it will probably be more efficient than the following option. -- -- * The compiler can provide a default generic implementation for -- 'parseJSON'.@@ -343,18 +343,21 @@ -- -- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic' ----- instance FromJSON Coord+-- instance 'FromJSON' Coord -- @ ----- If @DefaultSignatures@ doesn't give exactly the results you want,--- you can customize the generic decoding with only a tiny amount of--- effort, using 'genericParseJSON' with your preferred 'Options':+-- The default implementation will be equivalent to+-- @parseJSON = 'genericParseJSON' 'defaultOptions'@; If you need different+-- options, you can customize the generic decoding by defining: -- -- @--- instance FromJSON Coord where--- parseJSON = 'genericParseJSON' 'defaultOptions'+-- customOptions = 'defaultOptions'+-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'+-- }+--+-- instance 'FromJSON' Coord where+-- 'parseJSON' = 'genericParseJSON' customOptions -- @- class FromJSON a where parseJSON :: Value -> Parser a @@ -516,7 +519,7 @@ -- -- * "Data.Aeson.TH" provides Template Haskell functions which will derive an -- instance at compile time. The generated instance is optimized for your type--- so will probably be more efficient than the following two options:+-- so it will probably be more efficient than the following option. -- -- * The compiler can provide a default generic implementation for -- 'liftParseJSON'.@@ -534,16 +537,20 @@ -- -- data Pair a b = Pair { pairFst :: a, pairSnd :: b } deriving 'Generic1' ----- instance FromJSON a => FromJSON1 (Pair a)+-- instance 'FromJSON' a => 'FromJSON1' (Pair a) -- @ ----- If @DefaultSignatures@ doesn't give exactly the results you want,+-- If the default implementation doesn't give exactly the results you want, -- you can customize the generic decoding with only a tiny amount of -- effort, using 'genericLiftParseJSON' with your preferred 'Options': -- -- @--- instance FromJSON a => FromJSON1 (Pair a) where--- liftParseJSON = 'genericLiftParseJSON' 'defaultOptions'+-- customOptions = 'defaultOptions'+-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'+-- }+--+-- instance 'FromJSON' a => 'FromJSON1' (Pair a) where+-- 'liftParseJSON' = 'genericLiftParseJSON' customOptions -- @ class FromJSON1 f where liftParseJSON :: (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser (f a)@@ -614,43 +621,44 @@ -- Functions ------------------------------------------------------------------------------- --- | @withObject expected f value@ applies @f@ to the 'Object' when @value@ is an @Object@--- and fails using @'typeMismatch' expected@ otherwise.+-- | @'withObject' expected f value@ applies @f@ to the 'Object' when @value@+-- is an 'Object' and fails using @'typeMismatch' expected@ otherwise. withObject :: String -> (Object -> Parser a) -> Value -> Parser a withObject _ f (Object obj) = f obj withObject expected _ v = typeMismatch expected v {-# INLINE withObject #-} --- | @withText expected f value@ applies @f@ to the 'Text' when @value@ is a @String@--- and fails using @'typeMismatch' expected@ otherwise.+-- | @'withText' expected f value@ applies @f@ to the 'Text' when @value@ is a+-- 'String' and fails using @'typeMismatch' expected@ otherwise. withText :: String -> (Text -> Parser a) -> Value -> Parser a withText _ f (String txt) = f txt withText expected _ v = typeMismatch expected v {-# INLINE withText #-} --- | @withArray expected f value@ applies @f@ to the 'Array' when @value@ is an @Array@--- and fails using @'typeMismatch' expected@ otherwise.+-- | @'withArray' expected f value@ applies @f@ to the 'Array' when @value@ is+-- an 'Array' and fails using @'typeMismatch' expected@ otherwise. withArray :: String -> (Array -> Parser a) -> Value -> Parser a withArray _ f (Array arr) = f arr withArray expected _ v = typeMismatch expected v {-# INLINE withArray #-} --- | @withNumber expected f value@ applies @f@ to the 'Number' when @value@ is a 'Number'.--- and fails using @'typeMismatch' expected@ otherwise.+-- | @'withNumber' expected f value@ applies @f@ to the 'Number' when @value@+-- is a 'Number' and fails using @'typeMismatch' expected@ otherwise. withNumber :: String -> (Number -> Parser a) -> Value -> Parser a withNumber expected f = withScientific expected (f . scientificToNumber) {-# INLINE withNumber #-} {-# DEPRECATED withNumber "Use withScientific instead" #-} --- | @withScientific expected f value@ applies @f@ to the 'Scientific' number when @value@ is a 'Number'.--- and fails using @'typeMismatch' expected@ otherwise.+-- | @'withScientific' expected f value@ applies @f@ to the 'Scientific' number+-- when @value@ is a 'Number' and fails using @'typeMismatch' expected@+-- otherwise. withScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a withScientific _ f (Number scientific) = f scientific withScientific expected _ v = typeMismatch expected v {-# INLINE withScientific #-} --- | @withBool expected f value@ applies @f@ to the 'Bool' when @value@ is a @Bool@--- and fails using @'typeMismatch' expected@ otherwise.+-- | @'withBool' expected f value@ applies @f@ to the 'Bool' when @value@ is a+-- 'Bool' and fails using @'typeMismatch' expected@ otherwise. withBool :: String -> (Bool -> Parser a) -> Value -> Parser a withBool _ f (Bool arr) = f arr withBool expected _ v = typeMismatch expected v
Data/Aeson/Types/Internal.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE Rank2Types #-}-{-# LANGUAGE RecordWildCards #-} #if __GLASGOW_HASKELL__ >= 800 -- a) THQ works on cross-compilers and unregisterised GHCs -- b) may make compilation faster as no dynamic loading is ever needed (not sure about this)@@ -75,6 +74,7 @@ import Data.Foldable (foldl') import Data.HashMap.Strict (HashMap) import Data.Hashable (Hashable(..))+import Data.List (intercalate) import Data.Scientific (Scientific) import Data.Semigroup (Semigroup((<>))) import Data.String (IsString(..))@@ -527,16 +527,17 @@ } instance Show Options where- show Options{..} = "Options {" ++- "fieldLabelModifier =~ " ++- show (fieldLabelModifier "exampleField") ++ ", " ++- "constructorTagModifier =~ " ++- show (constructorTagModifier "ExampleConstructor") ++ ", " ++- "allNullaryToStringTag = " ++ show allNullaryToStringTag ++ ", " ++- "omitNothingFields = " ++ show omitNothingFields ++ ", " ++- "sumEncoding = " ++ show sumEncoding ++ ", " ++- "unwrapUnaryRecords = " ++ show unwrapUnaryRecords ++- "}"+ show (Options f c a o s u) =+ "Options {"+ ++ intercalate ", "+ [ "fieldLabelModifier =~ " ++ show (f "exampleField")+ , "constructorTagModifier =~ " ++ show (c "ExampleConstructor")+ , "allNullaryToStringTag = " ++ show a+ , "omitNothingFields = " ++ show o+ , "sumEncoding = " ++ show s+ , "unwrapUnaryRecords = " ++ show u+ ]+ ++ "}" -- | Specifies how to encode constructors of a sum datatype. data SumEncoding =@@ -554,18 +555,18 @@ -- the 'contentsFieldName' field. | UntaggedValue -- ^ Constructor names won't be encoded. Instead only the contents of the- -- constructor will be encoded as if the type had single constructor. JSON+ -- constructor will be encoded as if the type had a single constructor. JSON -- encodings have to be disjoint for decoding to work properly. -- -- When decoding, constructors are tried in the order of definition. If some -- encodings overlap, the first one defined will succeed. --- -- /Note:/ Nullary constructors are encoded as the string (using+ -- /Note:/ Nullary constructors are encoded as strings (using -- 'constructorTagModifier'). Having a nullary constructor alongside a -- single field constructor that encodes to a string leads to ambiguity. -- -- /Note:/ Only the last error is kept when decoding, so in the case of- -- mailformed JSON, only an error for the last constructor will be reported.+ -- malformed JSON, only an error for the last constructor will be reported. | ObjectWithSingleField -- ^ A constructor will be encoded to an object with a single -- field named after the constructor tag (modified by the
Data/Aeson/Types/ToJSON.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-}@@ -132,6 +131,8 @@ 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 #-}@@ -205,6 +206,9 @@ -- | A type that can be converted to JSON. --+-- Instances in general /must/ specify 'toJSON' and /should/ (but don't need+-- to) specify 'toEncoding'.+-- -- An example type and instance: -- -- @@@ -213,10 +217,10 @@ -- -- data Coord = Coord { x :: Double, y :: Double } ----- instance ToJSON Coord where--- toJSON (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]+-- instance 'ToJSON' Coord where+-- 'toJSON' (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y] ----- toEncoding (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)+-- 'toEncoding' (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y) -- @ -- -- Instead of manually writing your 'ToJSON' instance, there are two options@@ -224,17 +228,15 @@ -- -- * "Data.Aeson.TH" provides Template Haskell functions which will derive an -- instance at compile time. The generated instance is optimized for your type--- so will probably be more efficient than the following two options:+-- so it will probably be more efficient than the following option. -- -- * The compiler can provide a default generic implementation for -- 'toJSON'. -- -- To use the second, simply add a @deriving 'Generic'@ clause to your--- datatype and declare a 'ToJSON' instance for your datatype without giving--- definitions for 'toJSON' or 'toEncoding'.------ For example, the previous example can be simplified to a more--- minimal instance:+-- datatype and declare a 'ToJSON' instance. If you require nothing other than+-- 'defaultOptions', it is sufficient to write (and this is the only+-- alternative where the default 'toJSON' implementation is sufficient): -- -- @ -- {-\# LANGUAGE DeriveGeneric \#-}@@ -243,30 +245,41 @@ -- -- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic' ----- instance ToJSON Coord where--- toEncoding = 'genericToEncoding' 'defaultOptions'+-- instance 'ToJSON' Coord where+-- 'toEncoding' = 'genericToEncoding' 'defaultOptions' -- @ ----- Why do we provide an implementation for 'toEncoding' here? The--- 'toEncoding' function is a relatively new addition to this class.--- To allow users of older versions of this library to upgrade without--- having to edit all of their instances or encounter surprising--- incompatibilities, the default implementation of 'toEncoding' uses--- 'toJSON'. This produces correct results, but since it performs an--- intermediate conversion to a 'Value', it will be less efficient--- than directly emitting an 'Encoding'. Our one-liner definition of--- 'toEncoding' above bypasses the intermediate 'Value'.------ If @DefaultSignatures@ doesn't give exactly the results you want,--- you can customize the generic encoding with only a tiny amount of--- effort, using 'genericToJSON' and 'genericToEncoding' with your--- preferred 'Options':+-- If on the other hand you wish to customize the generic decoding, you have+-- to implement both methods: -- -- @--- instance ToJSON Coord where--- toJSON = 'genericToJSON' 'defaultOptions'--- toEncoding = 'genericToEncoding' 'defaultOptions'+-- customOptions = 'defaultOptions'+-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'+-- }+--+-- instance 'ToJSON' Coord where+-- 'toJSON' = 'genericToJSON' customOptions+-- 'toEncoding' = 'genericToEncoding' customOptions -- @+--+-- Previous versions of this library only had the 'toJSON' method. Adding+-- 'toEncoding' had to reasons:+--+-- 1. toEncoding is more efficient for the common case that the output of+-- 'toJSON' is directly serialized to a @ByteString@.+-- Further, expressing either method in terms of the other would be+-- non-optimal.+--+-- 2. The choice of defaults allows a smooth transition for existing users:+-- Existing instances that do not define 'toEncoding' still+-- compile and have the correct semantics. This is ensured by making+-- the default implementation of 'toEncoding' use 'toJSON'. This produces+-- correct results, but since it performs an intermediate conversion to a+-- 'Value', it will be less efficient than directly emitting an 'Encoding'.+-- (this also means that specifying nothing more than+-- @instance ToJSON Coord@ would be sufficient as a generically decoding+-- instance, but there probably exists no good reason to not specify+-- 'toEncoding' in new instances.) class ToJSON a where -- | Convert a Haskell value to a JSON-friendly intermediate type. toJSON :: a -> Value@@ -288,8 +301,8 @@ -- extension, and then have GHC generate a method body as follows. -- -- @- -- instance ToJSON Coord where- -- toEncoding = 'genericToEncoding' 'defaultOptions'+ -- instance 'ToJSON' Coord where+ -- 'toEncoding' = 'genericToEncoding' 'defaultOptions' -- @ toEncoding :: a -> Encoding@@ -491,7 +504,7 @@ -- -- * "Data.Aeson.TH" provides Template Haskell functions which will derive an -- instance at compile time. The generated instance is optimized for your type--- so will probably be more efficient than the following two options:+-- so it will probably be more efficient than the following option. -- -- * The compiler can provide a default generic implementation for -- 'toJSON1'.@@ -509,19 +522,25 @@ -- -- data Pair = Pair { pairFst :: a, pairSnd :: b } deriving 'Generic1' ----- instance ToJSON a => ToJSON1 (Pair a)+-- instance 'ToJSON' a => 'ToJSON1' (Pair a) -- @ ----- If @DefaultSignatures@ doesn't give exactly the results you want,+-- If the default implementation doesn't give exactly the results you want, -- you can customize the generic encoding with only a tiny amount of -- effort, using 'genericLiftToJSON' and 'genericLiftToEncoding' with -- your preferred 'Options': -- -- @--- instance ToJSON a => ToJSON1 (Pair a) where--- liftToJSON = 'genericLiftToJSON' 'defaultOptions'--- liftToEncoding = 'genericLiftToEncoding' 'defaultOptions'+-- customOptions = 'defaultOptions'+-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'+-- }+--+-- instance 'ToJSON' a => 'ToJSON1' (Pair a) where+-- 'liftToJSON' = 'genericLiftToJSON' customOptions+-- 'liftToEncoding' = 'genericLiftToEncoding' customOptions -- @+--+-- See also 'ToJSON'. class ToJSON1 f where liftToJSON :: (a -> Value) -> ([a] -> Value) -> f a -> Value @@ -588,7 +607,7 @@ -- @ -- newtype F a = F [a] ----- -- This instance encodes String as an array of chars+-- -- This instance encodes 'String' as an array of chars -- instance 'ToJSON1' F where -- 'liftToJSON' tj _ (F xs) = 'liftToJSON' tj ('listValue' tj) xs -- 'liftToEncoding' te _ (F xs) = 'liftToEncoding' te ('listEncoding' te) xs@@ -2809,8 +2828,8 @@ packChunks lbs = S.unsafeCreate (fromIntegral $ L.length lbs) (copyChunks lbs) where- copyChunks !L.Empty !_pf = return ()- copyChunks !(L.Chunk (S.PS fpbuf o l) lbs') !pf = do+ copyChunks L.Empty _pf = return ()+ copyChunks (L.Chunk (S.PS fpbuf o l) lbs') pf = do withForeignPtr fpbuf $ \pbuf -> copyBytes pf (pbuf `plusPtr` o) l copyChunks lbs' (pf `plusPtr` l)
aeson.cabal view
@@ -1,5 +1,5 @@ name: aeson-version: 1.1.1.0+version: 1.1.2.0 license: BSD3 license-file: LICENSE category: Text, Web, JSON
benchmarks/AesonCompareAutoInstances.hs view
@@ -43,7 +43,7 @@ d = Record { testOne = 1234.56789 , testTwo = True- , testThree = Product "Hello World!" 'a' $+ , testThree = Product "Hello World!" 'a' Record { testOne = 9876.54321 , testTwo = False@@ -80,7 +80,7 @@ d' = Record' { testOne' = 1234.56789 , testTwo' = True- , testThree' = Product' "Hello World!" 'a' $+ , testThree' = Product' "Hello World!" 'a' Record' { testOne' = 9876.54321 , testTwo' = False
benchmarks/AesonEncode.hs view
@@ -7,7 +7,6 @@ import Prelude.Compat import Control.DeepSeq-import Control.Exception import Control.Monad import Data.Aeson import Data.Attoparsec.ByteString (IResult(..), parseWith)@@ -25,7 +24,7 @@ (c:a) -> (c,a) [] -> error "Unexpected empty list" let count = read cnt :: Int- forM_ args $ \arg -> bracket (openFile arg ReadMode) hClose $ \h -> do+ forM_ args $ \arg -> withFile arg ReadMode $ \h -> do putStrLn $ arg ++ ":" let refill = B.hGet h 16384 result0 <- parseWith refill json =<< refill@@ -35,7 +34,7 @@ start <- getCurrentTime let loop !n r | n >= count = return ()- | otherwise = {-# SCC "loop" #-} do+ | otherwise = {-# SCC "loop" #-} rnf (encode r) `seq` loop (n+1) r loop 0 r0 delta <- flip diffUTCTime start `fmap` getCurrentTime
benchmarks/AesonMap.hs view
@@ -97,16 +97,16 @@ value10000 = value 10000 encodedValue10 :: LBS.ByteString-encodedValue10 = B.encode $ value10+encodedValue10 = B.encode value10 encodedValue100 :: LBS.ByteString-encodedValue100 = B.encode $ value100+encodedValue100 = B.encode value100 encodedValue1000 :: LBS.ByteString-encodedValue1000 = B.encode $ value1000+encodedValue1000 = B.encode value1000 encodedValue10000 :: LBS.ByteString-encodedValue10000 = B.encode $ value10000+encodedValue10000 = B.encode value10000 ------------------------------------------------------------------------------- -- Helpers
benchmarks/AesonParse.hs view
@@ -8,7 +8,6 @@ import Prelude.Compat import "aeson-benchmarks" Data.Aeson-import Control.Exception import Control.Monad import Data.Attoparsec.ByteString (IResult(..), parseWith) import Data.Time.Clock@@ -21,7 +20,7 @@ (bs:cnt:args) <- getArgs let count = read cnt :: Int blkSize = read bs- forM_ args $ \arg -> bracket (openFile arg ReadMode) hClose $ \h -> do+ forM_ args $ \arg -> withFile arg ReadMode $ \h -> do putStrLn $ arg ++ ":" start <- getCurrentTime let loop !good !bad
benchmarks/AesonTuples.hs view
@@ -1,5 +1,3 @@-module Main where- module Main (main) where import Prelude ()
benchmarks/Compare/JsonBench.hs view
@@ -3,7 +3,6 @@ -- https://github.com/chadaustin/buffer-builder/blob/master/test.json {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}@@ -65,10 +64,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 `seq` () 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 `seq` () eyeColorTable :: [(Text, EyeColor)] eyeColorTable = [("brown", Brown), ("green", Green), ("blue", Blue)]
benchmarks/CompareWithJSON.hs view
@@ -9,6 +9,7 @@ import Blaze.ByteString.Builder.Char.Utf8 (fromString) import Control.DeepSeq (NFData(rnf)) import Criterion.Main+import Data.Maybe (fromMaybe) import qualified Data.Aeson as A import qualified Data.Aeson.Text as A import qualified Data.ByteString.Lazy as BL@@ -35,14 +36,10 @@ J.Error _ -> error "fail to parse via JSON" decodeA :: BL.ByteString -> A.Value-decodeA s = case A.decode s of- Just v -> v- Nothing -> error "fail to parse via Aeson"+decodeA s = fromMaybe (error "fail to parse via Aeson") $ A.decode s decodeA' :: BL.ByteString -> A.Value-decodeA' s = case A.decode' s of- Just v -> v- Nothing -> error "fail to parse via Aeson"+decodeA' s = fromMaybe (error "fail to parse via Aeson") $ A.decode' s encodeJ :: J.JSValue -> BL.ByteString encodeJ = toLazyByteString . fromString . J.encode
benchmarks/Dates.hs view
@@ -22,22 +22,22 @@ defaultMain [ bgroup "decode" [ bgroup "UTCTime" [- env file1 $ \ ~bs -> bench "whole" $ nf utcTime bs- , env file2 $ \ ~bs -> bench "fractional" $ nf utcTime bs+ env file1 $ \bs -> bench "whole" $ nf utcTime bs+ , env file2 $ \bs -> bench "fractional" $ nf utcTime bs ] , bgroup "ZonedTime" [- env file1 $ \ ~bs -> bench "whole" $ nf zTime bs- , env file2 $ \ ~bs -> bench "fractional" $ nf zTime bs+ env file1 $ \bs -> bench "whole" $ nf zTime bs+ , env file2 $ \bs -> bench "fractional" $ nf zTime bs ] ] , bgroup "encode" [ bgroup "UTCTime" [- env (utcTime <$> file1) $ \ ~ts -> bench "whole" $ nf encode ts- , env (utcTime <$> file2) $ \ ~ts -> bench "fractional" $ nf encode ts+ env (utcTime <$> file1) $ \ts -> bench "whole" $ nf encode ts+ , env (utcTime <$> file2) $ \ts -> bench "fractional" $ nf encode ts ] , bgroup "ZonedTime" [- env (zTime <$> file1) $ \ ~ts -> bench "whole" $ nf encode ts- , env (zTime <$> file2) $ \ ~ts -> bench "fractional" $ nf encode ts+ env (zTime <$> file1) $ \ts -> bench "whole" $ nf encode ts+ , env (zTime <$> file2) $ \ts -> bench "fractional" $ nf encode ts ] ] ]
benchmarks/ReadFile.hs view
@@ -20,7 +20,7 @@ main = do (cnt:args) <- getArgs let count = read cnt :: Int- forM_ args $ \arg -> bracket (openFile arg ReadMode) hClose $ \h -> do+ forM_ args $ \arg -> withFile arg ReadMode $ \h -> do putStrLn $ arg ++ ":" start <- getCurrentTime let loop !n
benchmarks/Typed/Common.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE CPP #-}+#ifdef HAS_BOTH_AESON_AND_BENCHMARKS {-# LANGUAGE PackageImports #-}+#endif {-# OPTIONS_GHC -fno-warn-unused-imports #-}
changelog.md view
@@ -1,5 +1,11 @@ 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.2.0++* Fix an accidental change in the format of `deriveJSON`. Thanks to Xia Li-yao!++* Documentation improvements regarding `ToJSON`, `FromJSON`, and `SumEncoding`. Thanks to Xia Li-yao and Lennart Spitzner!+ ### 1.1.1.0 * Added a pure implementation of the C FFI code, the C FFI code. If you wish to use the pure haskell version set the `cffi` flag to `False`. This should make aeson compile when C isn't available, such as for GHCJS. Thanks to James Parker & Marcin Tolysz!
examples/Twitter.hs view
@@ -29,6 +29,9 @@ import GHC.Generics (Generic) import Prelude hiding (id) +{-# ANN module "Hlint: ignore Use camelCase" #-}+{-# ANN module "Hlint: ignore Use newtype instead of data" #-}+ data Metadata = Metadata { result_type :: Text } deriving (Eq, Show, Typeable, Data, Generic)
examples/Twitter/Generic.hs view
@@ -1,6 +1,5 @@ -- Use GHC generics to automatically generate good instances. {-# LANGUAGE CPP #-}-{-# LANGUAGE PackageImports #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Twitter.Generic
examples/Twitter/Manual.hs view
@@ -1,10 +1,13 @@ -- Manually write instances. {-# LANGUAGE CPP #-}-{-# LANGUAGE PackageImports #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-}++#ifdef HAS_BOTH_AESON_AND_BENCHMARKS+{-# LANGUAGE PackageImports #-}+#endif module Twitter.Manual (
pure/Data/Aeson/Parser/UnescapePure.hs view
@@ -52,23 +52,23 @@ {-# INLINE setByte1 #-} setByte2 :: (Num a, Bits b, Bits a, Integral b) => a -> b -> a-setByte2 point word = point .|. ((fromIntegral $ word .&. 0x3f) `shiftL` 6)+setByte2 point word = point .|. (fromIntegral (word .&. 0x3f) `shiftL` 6) {-# INLINE setByte2 #-} setByte2Top :: (Num a, Bits b, Bits a, Integral b) => a -> b -> a-setByte2Top point word = point .|. ((fromIntegral $ word .&. 0x1f) `shiftL` 6)+setByte2Top point word = point .|. (fromIntegral (word .&. 0x1f) `shiftL` 6) {-# INLINE setByte2Top #-} setByte3 :: (Num a, Bits b, Bits a, Integral b) => a -> b -> a-setByte3 point word = point .|. ((fromIntegral $ word .&. 0x3f) `shiftL` 12)+setByte3 point word = point .|. (fromIntegral (word .&. 0x3f) `shiftL` 12) {-# INLINE setByte3 #-} setByte3Top :: (Num a, Bits b, Bits a, Integral b) => a -> b -> a-setByte3Top point word = point .|. ((fromIntegral $ word .&. 0xf) `shiftL` 12)+setByte3Top point word = point .|. (fromIntegral (word .&. 0xf) `shiftL` 12) {-# INLINE setByte3Top #-} setByte4 :: (Num a, Bits b, Bits a, Integral b) => a -> b -> a-setByte4 point word = point .|. ((fromIntegral $ word .&. 0x7) `shiftL` 18)+setByte4 point word = point .|. (fromIntegral (word .&. 0x7) `shiftL` 18) {-# INLINE setByte4 #-} decode :: Utf -> Word32 -> Word8 -> (Utf, Word32)@@ -207,12 +207,12 @@ let u = w' .|. w in -- Get next state based on surrogates.- let st =- if u >= 0xd800 && u <= 0xdbff then -- High surrogate.+ let st+ | u >= 0xd800 && u <= 0xdbff = -- High surrogate. StateS0- else if u >= 0xdc00 && u <= 0xdfff then -- Low surrogate.+ | u >= 0xdc00 && u <= 0xdfff = -- Low surrogate. throwDecodeError- else+ | otherwise = StateNone in writeAndReturn dest pos u st
tests/Encoders.hs view
@@ -341,3 +341,16 @@ thGADTParseJSONDefault :: Value -> Parser (GADT String) thGADTParseJSONDefault = $(mkParseJSON defaultOptions ''GADT)++--------------------------------------------------------------------------------+-- OneConstructor encoders/decoders+--------------------------------------------------------------------------------++thOneConstructorToJSONDefault :: OneConstructor -> Value+thOneConstructorToJSONDefault = $(mkToJSON defaultOptions ''OneConstructor)++thOneConstructorToEncodingDefault :: OneConstructor -> Encoding+thOneConstructorToEncodingDefault = $(mkToEncoding defaultOptions ''OneConstructor)++thOneConstructorParseJSONDefault :: Value -> Parser OneConstructor+thOneConstructorParseJSONDefault = $(mkParseJSON defaultOptions ''OneConstructor)
tests/Instances.hs view
@@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Instances () where@@ -44,6 +43,8 @@ #if !MIN_VERSION_base(4,8,0) && !MIN_VERSION_QuickCheck(2,8,3) import Numeric.Natural #endif++{-# ANN module ("HLint: ignore Use fewer imports"::String) #-} -- "System" types.
tests/Properties.hs view
@@ -33,7 +33,7 @@ import Numeric.Natural (Natural) import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.QuickCheck (Arbitrary(..), Property, (===), (.&&.), counterexample)+import Test.QuickCheck (Arbitrary(..), Property, Testable, (===), (.&&.), counterexample) import Types import qualified Data.Attoparsec.Lazy as L import qualified Data.ByteString.Lazy.Char8 as L@@ -149,6 +149,11 @@ -- Value properties -------------------------------------------------------------------------------- +-- | Add the formatted @Value@ to the printed counterexample when the property+-- fails.+checkValue :: Testable a => (Value -> a) -> Value -> Property+checkValue prop v = counterexample (L.unpack (encode v)) (prop v)+ isString :: Value -> Bool isString (String _) = True isString _ = False@@ -182,7 +187,13 @@ isUntaggedValueETI (Array a) = length a == 2 isUntaggedValueETI _ = False +isEmptyArray :: Value -> Property+isEmptyArray = checkValue isEmptyArray' +isEmptyArray' :: Value -> Bool+isEmptyArray' = (Array mempty ==)++ -------------------------------------------------------------------------------- @@ -224,7 +235,7 @@ [ testProperty "Identity Char" $ roundTripEq (undefined :: I Int) , testProperty "Identity Char" $ roundTripEq (undefined :: I Char)- , testProperty "Identity [Char]" $ roundTripEq (undefined :: I [Char])+ , testProperty "Identity [Char]" $ roundTripEq (undefined :: I String) , testProperty "[Identity Char]" $ roundTripEq (undefined :: [I Char]) , testProperty "Compose I I Int" $ roundTripEq (undefined :: LogScaled (Compose I I Int))@@ -410,23 +421,29 @@ , testProperty "ObjectWithSingleField unary" (toParseJSON1 thSomeTypeLiftParseJSONObjectWithSingleField thSomeTypeLiftToJSONObjectWithSingleField) ]- , testGroup "Approx" [- testProperty "string" (isString . thApproxToJSONUnwrap)- , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thApproxToJSONDefault)- , testGroup "roundTrip" [- testProperty "string" (toParseJSON thApproxParseJSONUnwrap thApproxToJSONUnwrap)- , testProperty "ObjectWithSingleField" (toParseJSON thApproxParseJSONDefault thApproxToJSONDefault)- ]+ ]+ , testGroup "Approx" [+ testProperty "string" (isString . thApproxToJSONUnwrap)+ , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thApproxToJSONDefault)+ , testGroup "roundTrip" [+ testProperty "string" (toParseJSON thApproxParseJSONUnwrap thApproxToJSONUnwrap)+ , testProperty "ObjectWithSingleField" (toParseJSON thApproxParseJSONDefault thApproxToJSONDefault) ]- , testGroup "GADT" [- testProperty "string" (isString . thGADTToJSONUnwrap)- , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thGADTToJSONDefault)- , testGroup "roundTrip" [- testProperty "string" (toParseJSON thGADTParseJSONUnwrap thGADTToJSONUnwrap)- , testProperty "ObjectWithSingleField" (toParseJSON thGADTParseJSONDefault thGADTToJSONDefault)- ]+ ]+ , testGroup "GADT" [+ testProperty "string" (isString . thGADTToJSONUnwrap)+ , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thGADTToJSONDefault)+ , testGroup "roundTrip" [+ testProperty "string" (toParseJSON thGADTParseJSONUnwrap thGADTToJSONUnwrap)+ , testProperty "ObjectWithSingleField" (toParseJSON thGADTParseJSONDefault thGADTToJSONDefault) ] ]+ , testGroup "OneConstructor" [+ testProperty "default" (isEmptyArray . thOneConstructorToJSONDefault)+ , testGroup "roundTrip" [+ testProperty "default" (toParseJSON thOneConstructorParseJSONDefault thOneConstructorToJSONDefault)+ ]+ ] ] , testGroup "toEncoding" [ testProperty "NullaryString" $@@ -466,6 +483,9 @@ thSomeTypeLiftToJSONObjectWithSingleField `sameAs1` thSomeTypeLiftToEncodingObjectWithSingleField , testProperty "SomeTypeObjectWithSingleField unary agree" $ thSomeTypeToEncodingObjectWithSingleField `sameAs1Agree` thSomeTypeLiftToEncodingObjectWithSingleField++ , testProperty "OneConstructor" $+ thOneConstructorToJSONDefault `sameAs` thOneConstructorToEncodingDefault ] ] ]
tests/SerializationFormatSpec.hs view
@@ -86,7 +86,7 @@ , 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 [Char] Int" "{\"ab\":1,\"cd\":3}" (M.fromList [("ab",1),("cd",3)] :: M.Map String 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)@@ -197,9 +197,9 @@ jsonDecodingExamples = [ -- Maybe serialising is lossy -- https://github.com/bos/aeson/issues/376- MaybeExample "Nothing" "null" (Just $ Nothing :: Maybe (Maybe Int))+ 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)))+ , 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)
tests/UnitTests.hs view
@@ -74,14 +74,14 @@ assertEqual "" "camel_api_case" (camelTo2 '_' "CamelAPICase") ] , testGroup "encoding" [- testCase "goodProducer" $ goodProducer+ testCase "goodProducer" goodProducer ] , testGroup "utctime" [- testCase "good" $ utcTimeGood- , testCase "bad" $ utcTimeBad+ testCase "good" utcTimeGood+ , testCase "bad" utcTimeBad ] , testGroup "formatError" [- testCase "example 1" $ formatErrorExample+ testCase "example 1" formatErrorExample ] , testGroup ".:, .:?, .:!" $ fmap (testCase "-") dotColonMark , testGroup "JSONPath" $ fmap (testCase "-") jsonPath@@ -91,6 +91,7 @@ , testGroup "FromJSONKey" $ fmap (testCase "-") fromJSONKeyAssertions , testCase "PR #455" pr455 , testCase "Unescape string (PR #477)" unescapeString+ , testCase "Show Options" showOptions ] roundTripCamel :: String -> Assertion@@ -186,11 +187,9 @@ where parseWithRead :: String -> LT.Text -> UTCTime parseWithRead f s =- case parseTime defaultTimeLocale f . LT.unpack $ s of- Nothing -> error "parseTime input malformed"- Just t -> t+ fromMaybe (error "parseTime input malformed") . parseTime defaultTimeLocale f . LT.unpack $ s parseWithAeson :: LT.Text -> Maybe UTCTime- parseWithAeson s = decode . LT.encodeUtf8 $ (LT.concat ["\"", s, "\""])+ parseWithAeson s = decode . LT.encodeUtf8 $ LT.concat ["\"", s, "\""] -- Test that a few non-timezone qualified timestamp formats get -- rejected if decoding to UTCTime.@@ -206,7 +205,7 @@ verifyFailParse "2015-01-03 12:13.000Z" -- decimal at the end, but no seconds where verifyFailParse (s :: LT.Text) =- let (dec :: Maybe UTCTime) = decode . LT.encodeUtf8 $ (LT.concat ["\"", s, "\""]) in+ let (dec :: Maybe UTCTime) = decode . LT.encodeUtf8 $ LT.concat ["\"", s, "\""] in assertEqual "verify failure" Nothing dec -- Non identifier keys should be escaped & enclosed in brackets@@ -234,11 +233,11 @@ , assertEqual ".: 42" (Just (T1 (Just 42))) (decode ex2 :: Maybe T1) , assertEqual ".: null" (Just (T1 Nothing)) (decode ex3 :: Maybe T1) - , assertEqual ".:? not-present" (Just (T2 (Nothing))) (decode ex1 :: Maybe T2)+ , assertEqual ".:? not-present" (Just (T2 Nothing)) (decode ex1 :: Maybe T2) , assertEqual ".:? 42" (Just (T2 (Just 42))) (decode ex2 :: Maybe T2) , assertEqual ".:? null" (Just (T2 Nothing)) (decode ex3 :: Maybe T2) - , assertEqual ".:! not-present" (Just (T3 (Nothing))) (decode ex1 :: Maybe T3)+ , assertEqual ".:! not-present" (Just (T3 Nothing)) (decode ex1 :: Maybe T3) , assertEqual ".:! 42" (Just (T3 (Just 42))) (decode ex2 :: Maybe T3) , assertEqual ".:! null" Nothing (decode ex3 :: Maybe T3) ]@@ -482,6 +481,20 @@ where foo :: Foo Int foo = FooCons FooNil++showOptions :: Assertion+showOptions =+ assertEqual+ "Show Options"+ ( "Options {"+ ++ "fieldLabelModifier =~ \"exampleField\""+ ++ ", constructorTagModifier =~ \"ExampleConstructor\""+ ++ ", allNullaryToStringTag = True"+ ++ ", omitNothingFields = False"+ ++ ", sumEncoding = TaggedObject {tagFieldName = \"tag\", contentsFieldName = \"contents\"}"+ ++ ", unwrapUnaryRecords = False"+ ++ "}")+ (show defaultOptions) deriveJSON defaultOptions{omitNothingFields=True} ''MyRecord