aeson 1.2.4.0 → 1.3.0.0
raw patch · 42 files changed
+490/−1029 lines, 42 filesdep ~generic-derivingdep ~textPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: generic-deriving, text
API changes (from Hackage documentation)
+ Data.Aeson: decodeFileStrict :: (FromJSON a) => FilePath -> IO (Maybe a)
+ Data.Aeson: decodeFileStrict' :: (FromJSON a) => FilePath -> IO (Maybe a)
+ Data.Aeson: eitherDecodeFileStrict :: (FromJSON a) => FilePath -> IO (Either String a)
+ Data.Aeson: eitherDecodeFileStrict' :: (FromJSON a) => FilePath -> IO (Either String a)
+ Data.Aeson: encodeFile :: (ToJSON a) => FilePath -> a -> IO ()
- Data.Aeson: withEmbeddedJSON :: (FromJSON a) => String -> (Value -> Parser a) -> Value -> Parser a
+ Data.Aeson: withEmbeddedJSON :: String -> (Value -> Parser a) -> Value -> Parser a
- Data.Aeson.Types: withEmbeddedJSON :: (FromJSON a) => String -> (Value -> Parser a) -> Value -> Parser a
+ Data.Aeson.Types: withEmbeddedJSON :: String -> (Value -> Parser a) -> Value -> Parser a
Files
- Data/Aeson.hs +45/−0
- Data/Aeson/Encoding/Builder.hs +1/−74
- Data/Aeson/TH.hs +29/−69
- Data/Aeson/Text.hs +2/−2
- Data/Aeson/Types/FromJSON.hs +3/−3
- Data/Aeson/Types/ToJSON.hs +24/−18
- aeson.cabal +3/−3
- attoparsec-iso8601/Data/Attoparsec/Time.hs +3/−3
- benchmarks/AesonCompareAutoInstances.hs +0/−282
- benchmarks/AesonFoldable.hs +13/−41
- benchmarks/AesonMap.hs +38/−55
- benchmarks/AesonParse.hs +1/−2
- benchmarks/AutoCompare.hs +73/−0
- benchmarks/Compare.hs +1/−2
- benchmarks/Compare/BufferBuilder.hs +0/−1
- benchmarks/Compare/JsonBuilder.hs +0/−1
- benchmarks/CompareWithJSON.hs +20/−31
- benchmarks/Dates.hs +0/−1
- benchmarks/Escape.hs +16/−10
- benchmarks/Micro.hs +6/−5
- benchmarks/Options.hs +0/−3
- benchmarks/Typed/Common.hs +0/−10
- benchmarks/Typed/Generic.hs +13/−30
- benchmarks/Typed/Manual.hs +13/−30
- benchmarks/Typed/TH.hs +13/−30
- benchmarks/aeson-benchmarks.cabal +132/−76
- changelog.md +15/−0
- examples/Twitter.hs +0/−1
- examples/Twitter/Generic.hs +0/−36
- examples/Twitter/Manual.hs +0/−136
- examples/Twitter/Options.hs +0/−23
- examples/Twitter/TH.hs +0/−17
- ffi/Data/Aeson/Parser/UnescapeFFI.hs +1/−1
- pure/Data/Aeson/Parser/UnescapePure.hs +5/−23
- stack-bench.yaml +3/−4
- stack-ffi-unescape.yaml +3/−1
- stack-lts10.yaml +9/−0
- stack-lts6.yaml +1/−1
- stack-lts7.yaml +1/−1
- stack-lts8.yaml +1/−1
- stack-lts9.yaml +1/−1
- stack-nightly.yaml +1/−1
Data/Aeson.hs view
@@ -38,11 +38,16 @@ , eitherDecode , eitherDecode' , encode+ , encodeFile -- ** Variants for strict bytestrings , decodeStrict+ , decodeFileStrict , decodeStrict'+ , decodeFileStrict' , eitherDecodeStrict+ , eitherDecodeFileStrict , eitherDecodeStrict'+ , eitherDecodeFileStrict' -- * Core JSON types , Value(..) , Encoding@@ -143,6 +148,10 @@ encode :: (ToJSON a) => a -> L.ByteString encode = encodingToLazyByteString . toEncoding +-- | Efficiently serialize a JSON value as a lazy 'L.ByteString' and write it to a file.+encodeFile :: (ToJSON a) => FilePath -> a -> IO ()+encodeFile fp = L.writeFile fp . encode+ -- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'. -- If this fails due to incomplete or invalid input, 'Nothing' is -- returned.@@ -169,6 +178,18 @@ decodeStrict = decodeStrictWith jsonEOF fromJSON {-# INLINE decodeStrict #-} +-- | Efficiently deserialize a JSON value from a file.+-- If this fails due to incomplete or invalid input, 'Nothing' is+-- returned.+--+-- The input file's content must consist solely of a JSON document,+-- with no trailing data except for whitespace.+--+-- This function parses immediately, but defers conversion. See+-- 'json' for details.+decodeFileStrict :: (FromJSON a) => FilePath -> IO (Maybe a)+decodeFileStrict = fmap decodeStrict . B.readFile+ -- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'. -- If this fails due to incomplete or invalid input, 'Nothing' is -- returned.@@ -195,6 +216,18 @@ decodeStrict' = decodeStrictWith jsonEOF' fromJSON {-# INLINE decodeStrict' #-} +-- | Efficiently deserialize a JSON value from a file.+-- If this fails due to incomplete or invalid input, 'Nothing' is+-- returned.+--+-- The input file's content must consist solely of a JSON document,+-- with no trailing data except for whitespace.+--+-- This function parses and performs conversion immediately. See+-- 'json'' for details.+decodeFileStrict' :: (FromJSON a) => FilePath -> IO (Maybe a)+decodeFileStrict' = fmap decodeStrict' . B.readFile+ eitherFormatError :: Either (JSONPath, String) a -> Either String a eitherFormatError = either (Left . uncurry formatError) Right {-# INLINE eitherFormatError #-}@@ -210,6 +243,12 @@ eitherFormatError . eitherDecodeStrictWith jsonEOF ifromJSON {-# INLINE eitherDecodeStrict #-} +-- | Like 'decodeFileStrict' but returns an error message when decoding fails.+eitherDecodeFileStrict :: (FromJSON a) => FilePath -> IO (Either String a)+eitherDecodeFileStrict =+ fmap (eitherFormatError . eitherDecodeStrictWith jsonEOF ifromJSON) . B.readFile+{-# INLINE eitherDecodeFileStrict #-}+ -- | Like 'decode'' but returns an error message when decoding fails. eitherDecode' :: (FromJSON a) => L.ByteString -> Either String a eitherDecode' = eitherFormatError . eitherDecodeWith jsonEOF' ifromJSON@@ -220,6 +259,12 @@ eitherDecodeStrict' = eitherFormatError . eitherDecodeStrictWith jsonEOF' ifromJSON {-# INLINE eitherDecodeStrict' #-}++-- | Like 'decodeFileStrict'' but returns an error message when decoding fails.+eitherDecodeFileStrict' :: (FromJSON a) => FilePath -> IO (Either String a)+eitherDecodeFileStrict' =+ fmap (eitherFormatError . eitherDecodeStrictWith jsonEOF' ifromJSON) . B.readFile+{-# INLINE eitherDecodeFileStrict' #-} -- $use --
Data/Aeson/Encoding/Builder.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-} -- | -- Module: Data.Aeson.Encoding.Builder@@ -47,6 +46,7 @@ import Data.Char (chr, ord) import Data.Monoid ((<>)) import Data.Scientific (Scientific, base10Exponent, coefficient)+import Data.Text.Encoding (encodeUtf8BuilderEscaped) import Data.Time (UTCTime(..)) import Data.Time.Calendar (Day(..), toGregorian) import Data.Time.LocalTime@@ -55,20 +55,6 @@ import qualified Data.Text as T import qualified Data.Vector as V -#if MIN_VERSION_bytestring(0,10,4)-import Data.Text.Encoding (encodeUtf8BuilderEscaped)-#else-import Data.Bits ((.&.))-import Data.Text.Internal (Text(..))-import Data.Text.Internal.Unsafe.Shift (shiftR)-import Foreign.Ptr (minusPtr, plusPtr)-import Foreign.Storable (poke)-import qualified Data.ByteString.Builder.Internal as B-import qualified Data.ByteString.Builder.Prim.Internal as BP-import qualified Data.Text.Array as A-import qualified Data.Text.Internal.Encoding.Utf16 as U16-#endif- -- | Encode a JSON value to a "Data.ByteString" 'B.Builder'. -- -- Use this function if you are encoding over the wire, or need to@@ -268,62 +254,3 @@ digit :: Int -> Char digit x = chr (x + 48)--#if !(MIN_VERSION_bytestring(0,10,4))--- | Encode text using UTF-8 encoding and escape the ASCII characters using--- a 'BP.BoundedPrim'.------ Use this function is to implement efficient encoders for text-based formats--- like JSON or HTML.-{-# INLINE encodeUtf8BuilderEscaped #-}--- TODO: Extend documentation with references to source code in @blaze-html@--- or @aeson@ that uses this function.-encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder-encodeUtf8BuilderEscaped be =- -- manual eta-expansion to ensure inlining works as expected- \txt -> B.builder (mkBuildstep txt)- where- bound = max 4 $ BP.sizeBound be-- mkBuildstep (Text arr off len) !k =- outerLoop off- where- iend = off + len-- 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- -- is smaller than 8, as this will save on divisions.- | otherwise = return $ B.bufferFull bound op0 (outerLoop i0)- where- outRemaining = (ope `minusPtr` op0) `div` bound- inpRemaining = iend - i0-- goPartial !iendTmp = go i0 op0- where- go !i !op- | i < iendTmp = case A.unsafeIndex arr i of- w | w <= 0x7F ->- BP.runB be (fromIntegral w) op >>= go (i + 1)- | w <= 0x7FF -> do- poke8 0 $ (w `shiftR` 6) + 0xC0- poke8 1 $ (w .&. 0x3f) + 0x80- go (i + 1) (op `plusPtr` 2)- | 0xD800 <= w && w <= 0xDBFF -> do- let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))- poke8 0 $ (c `shiftR` 18) + 0xF0- poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80- poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80- poke8 3 $ (c .&. 0x3F) + 0x80- go (i + 2) (op `plusPtr` 4)- | otherwise -> do- poke8 0 $ (w `shiftR` 12) + 0xE0- poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80- poke8 2 $ (w .&. 0x3F) + 0x80- go (i + 1) (op `plusPtr` 3)- | otherwise =- outerLoop i (B.BufferRange op ope)- where- poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)-#endif
Data/Aeson/TH.hs view
@@ -117,13 +117,14 @@ ) where import Prelude ()-import Prelude.Compat hiding (exp)+import Prelude.Compat import Control.Applicative ((<|>))-import Data.Aeson (Object, (.=), (.:), FromJSON(..), FromJSON1(..), FromJSON2(..), ToJSON(..), ToJSON1(..), ToJSON2(..))+import Data.Aeson (Object, (.:), FromJSON(..), FromJSON1(..), FromJSON2(..), ToJSON(..), ToJSON1(..), ToJSON2(..)) import Data.Aeson.Types (Options(..), Parser, SumEncoding(..), Value(..), defaultOptions, defaultTaggedObject) import Data.Aeson.Types.Internal ((<?>), JSONPathElement(Key)) import Data.Aeson.Types.FromJSON (parseOptionalFieldWith)+import Data.Aeson.Types.ToJSON (fromPairs, pair) import Control.Monad (liftM2, unless, when) import Data.Foldable (foldr') #if MIN_VERSION_template_haskell(2,8,0) && !MIN_VERSION_template_haskell(2,10,0)@@ -133,6 +134,7 @@ import Data.List.NonEmpty ((<|), NonEmpty((:|))) import Data.Map (Map) import Data.Maybe (catMaybes, fromMaybe, mapMaybe)+import qualified Data.Monoid as Monoid import Data.Set (Set) #if MIN_VERSION_template_haskell(2,8,0) import Language.Haskell.TH hiding (Arity)@@ -147,7 +149,6 @@ import Language.Haskell.TH.Syntax (mkNameG_tc) #endif import Text.Printf (printf)-import qualified Data.Aeson as A import qualified Data.Aeson.Encoding.Internal as E import qualified Data.Foldable as F (all) import qualified Data.HashMap.Strict as H (lookup, toList)@@ -382,13 +383,13 @@ value pairs where- pairs contentsFieldName = listE [toPair target contentsFieldName value]+ pairs contentsFieldName = pairE contentsFieldName value -- | Wrap fields of a record constructor. See 'sumToValue'. recordSumToValue :: ToJSONFun -> Options -> Bool -> Bool -> Name -> ExpQ -> ExpQ recordSumToValue target opts multiCons nullary conName pairs = sumToValue target opts multiCons nullary conName- (objectExp target pairs)+ (fromPairsE pairs) (const pairs) -- | Wrap fields of a constructor.@@ -423,12 +424,12 @@ TaggedObject{tagFieldName, contentsFieldName} -> -- TODO: Maybe throw an error in case -- tagFieldName overwrites a field in pairs.- let tag = toPair target tagFieldName (conStr target opts conName)+ let tag = pairE tagFieldName (conStr target opts conName) content = pairs contentsFieldName- in objectExp target $- if nullary then listE [tag] else infixApp tag [|(:)|] content+ in fromPairsE $+ if nullary then tag else infixApp tag [|(Monoid.<>)|] content ObjectWithSingleField ->- object target [(conString opts conName, value)]+ objectE [(conString opts conName, value)] UntaggedValue | nullary -> conStr target opts conName UntaggedValue -> value | otherwise = value@@ -469,15 +470,15 @@ argTys' <- mapM resolveTypeSynonyms argTys args <- newNameList "arg" $ length argTys' let pairs | omitNothingFields opts = infixApp maybeFields- [|(++)|]+ [|(Monoid.<>)|] restFields- | otherwise = listE $ map pureToPair argCons+ | otherwise = mconcatE (map pureToPair argCons) argCons = zip3 (map varE args) argTys' fields - maybeFields = [|catMaybes|] `appE` listE (map maybeToPair maybes)+ maybeFields = mconcatE (map maybeToPair maybes) - restFields = listE $ map pureToPair rest+ restFields = mconcatE (map pureToPair rest) (maybes0, rest0) = partition isMaybe argCons (options, rest) = partition isOption rest0@@ -489,11 +490,11 @@ toPairLifted lifted (arg, argTy, field) = let toValue = dispatchToJSON target jc conName tvMap argTy fieldName = fieldLabel opts field- e arg' = toPair target fieldName (toValue `appE` arg')+ e arg' = pairE fieldName (toValue `appE` arg') in if lifted then do x <- newName "x"- infixApp (lam1E (varP x) (e (varE x))) [|(<$>)|] arg+ [|maybe mempty|] `appE` lam1E (varP x) (e (varE x)) `appE` arg else e arg match (conP conName $ map varP args)@@ -534,10 +535,6 @@ (<^>) a b = infixApp a [|(E.><)|] b infixr 6 <^> -(<:>) :: ExpQ -> ExpQ -> ExpQ-(<:>) a b = a <^> [|E.colon|] <^> b-infixr 5 <:>- (<%>) :: ExpQ -> ExpQ -> ExpQ (<%>) a b = a <^> [|E.comma|] <^> b infixr 4 <%>@@ -565,62 +562,25 @@ doE (newMV:stmts++[ret])) -- | Wrap an associative list of keys and quoted values in a quoted 'Object'.-object :: ToJSONFun -> [(String, ExpQ)] -> ExpQ-object target = wrapObject target . catPairs target . fmap (uncurry (toPair target))---- |--- - When deriving 'ToJSON', map a list of quoted key-value pairs to an--- expression of the list of pairs.--- - When deriving 'ToEncoding', map a list of quoted 'Encoding's representing--- key-value pairs to a comma-separated 'Encoding' of them.------ > catPairs Value [ [|(k0,v0)|], [|(k1,v1)|] ] = [| [(k0,v0), (k1,v1)] |]--- > catPairs Encoding [ [|"\"k0\":v0"|], [|"\"k1\":v1"|] ] = [| "\"k0\":v0,\"k1\":v1" |]-catPairs :: ToJSONFun -> [ExpQ] -> ExpQ-catPairs Value = listE-catPairs Encoding = foldr1 (<%>)+objectE :: [(String, ExpQ)] -> ExpQ+objectE = fromPairsE . mconcatE . fmap (uncurry pairE) --- |--- - When deriving 'ToJSON', wrap a quoted list of key-value pairs in an 'Object'.--- - When deriving 'ToEncoding', wrap a quoted list of encoded key-value pairs--- in an encoded 'Object'.+-- | 'mconcat' a list of fixed length. ----- > objectExp Value [| [(k0,v0), (k1,v1)] |] = [| Object (fromList [(k0,v0), (k1,v1)]) |]--- > objectExp Encoding [| ["\"k0\":v0", "\"k1\":v1"] |] = [| "{\"k0\":v0,\"k1\":v1}" |]-objectExp :: ToJSONFun -> ExpQ -> ExpQ-objectExp target = wrapObject target . catPairsExp target+-- > mconcatE [ [|x|], [|y|], [|z|] ] = [| x <> (y <> z) |]+mconcatE :: [ExpQ] -> ExpQ+mconcatE [] = [|Monoid.mempty|]+mconcatE [x] = x+mconcatE (x : xs) = infixApp x [|(Monoid.<>)|] (mconcatE xs) --- | Counterpart of 'catPairsExp' when the list of pairs is already quoted.------ > objectExp Value [| [(k0,v0), (k1,v1)] |] = [| [(k0,v0), (k1,v1)] |]--- > objectExp Encoding [| ["\"k0\":v0", "\"k1\":v1"] |] = [| "\"k0\":v0,\"k1\":v1" |]-catPairsExp :: ToJSONFun -> ExpQ -> ExpQ-catPairsExp Value e = e-catPairsExp Encoding e = [|commaSep|] `appE` e+fromPairsE :: ExpQ -> ExpQ+fromPairsE = ([|fromPairs|] `appE`) -- | Create (an encoding of) a key-value pair. ----- > toPair Value "k" [|v|] = [|("k",v)|] -- The quoted string is actually Text.--- > toPair Encoding "k" [|"v"|] = [|"\"k\":v"|]-toPair :: ToJSONFun -> String -> ExpQ -> ExpQ-toPair Value k v = infixApp [|T.pack k|] [|(.=)|] v-toPair Encoding k v = [|E.string k|] <:> v---- | Map an associative list in an 'Object'.------ > wrapObject Value [| [(k0,v0), (k1,v1)] |] = [| Object (fromList [(k0,v0), (k1,v1)]) |]--- > wrapObject Encoding [| "\"k0\":v0,\"k1\":v1" |] = [| "{\"k0\":v0,\"k1\":v1}" |]-wrapObject :: ToJSONFun -> ExpQ -> ExpQ-wrapObject Value e = [|A.object|] `appE` e-wrapObject Encoding e = [|E.wrapObject|] `appE` e---- | Separate 'Encoding's by commas.------ > commaSep ["a","b","c"] = "a,b,c"-commaSep :: [E.Encoding] -> E.Encoding-commaSep [] = E.empty-commaSep [x] = x-commaSep (x : xs) = x E.>< E.comma E.>< commaSep xs+-- > pairE "k" [|v|] = [|pair "k" v|]+pairE :: String -> ExpQ -> ExpQ+pairE k v = [|pair k|] `appE` v -------------------------------------------------------------------------------- -- FromJSON
Data/Aeson/Text.hs view
@@ -46,8 +46,8 @@ -- embedded efficiently in a text-based protocol. -- -- If you are going to immediately encode straight to a--- 'L.ByteString', it is more efficient to use 'encodeToBuilder'--- instead.+-- 'L.ByteString', it is more efficient to use 'encode' (lazy ByteString)+-- or @'fromEncoding' . 'toEncoding'@ (ByteString.Builder) instead. -- -- /Note:/ Uses 'toJSON' encodeToTextBuilder :: ToJSON a => a -> Builder
Data/Aeson/Types/FromJSON.hs view
@@ -669,7 +669,7 @@ {-# INLINE withBool #-} -- | Decode a nested JSON-encoded string.-withEmbeddedJSON :: (FromJSON a) => String -> (Value -> Parser a) -> Value -> Parser a+withEmbeddedJSON :: String -> (Value -> Parser a) -> Value -> Parser a withEmbeddedJSON _ innerParser (String txt) = either fail innerParser $ eitherDecode (Compat.fromStrict $ T.encodeUtf8 txt) where@@ -1042,8 +1042,8 @@ instance INCOHERENT_ (Selector s, FromJSON a) => FromRecord arity (S1 s (K1 i (Maybe a))) where- parseRecord _ _ (Just lab) obj = (M1 . K1) <$> obj .:? lab- parseRecord opts _ Nothing obj = (M1 . K1) <$> obj .:? pack label+ parseRecord _ _ (Just lab) obj = M1 . K1 <$> obj .:? lab+ parseRecord opts _ Nothing obj = M1 . K1 <$> obj .:? pack label where label = fieldLabelModifier opts $ selName (undefined :: t s (K1 i (Maybe a)) p)
Data/Aeson/Types/ToJSON.hs view
@@ -50,6 +50,8 @@ , contramapToJSONKeyFunction -- * Object key-value pairs , KeyValue(..)+ , KeyValuePair(..)+ , FromPairs(..) -- * Functions needed for documentation -- * Encoding functions , listEncoding@@ -853,14 +855,14 @@ , TaggedObject' enc pairs arity a isRecord , FromPairs enc pairs , FromString enc- , GKeyValue enc pairs+ , KeyValuePair enc pairs , Constructor c ) => TaggedObject enc arity (C1 c a) where taggedObject opts targs tagFieldName contentsFieldName = fromPairs . (tag <>) . contents where- tag = tagFieldName `gPair`+ tag = tagFieldName `pair` (fromString (constructorTagModifier opts (conName (undefined :: t c a p))) :: enc) contents =@@ -872,11 +874,11 @@ -> String -> f a -> Tagged isRecord pairs instance ( GToJSON enc arity f- , GKeyValue enc pairs+ , KeyValuePair enc pairs ) => TaggedObject' enc pairs arity f False where taggedObject' opts targs contentsFieldName =- Tagged . (contentsFieldName `gPair`) . gToJSON opts targs+ Tagged . (contentsFieldName `pair`) . gToJSON opts targs instance OVERLAPPING_ Monoid pairs => TaggedObject' enc pairs arity U1 False where taggedObject' _ _ _ _ = Tagged mempty@@ -1005,7 +1007,7 @@ instance ( Selector s , GToJSON enc arity a- , GKeyValue enc pairs+ , KeyValuePair enc pairs ) => RecordToPairs enc pairs arity (S1 s a) where recordToPairs = fieldToPair@@ -1014,7 +1016,7 @@ instance INCOHERENT_ ( Selector s , GToJSON enc arity (K1 i (Maybe a))- , GKeyValue enc pairs+ , KeyValuePair enc pairs , Monoid pairs ) => RecordToPairs enc pairs arity (S1 s (K1 i (Maybe a))) where@@ -1026,7 +1028,7 @@ instance INCOHERENT_ ( Selector s , GToJSON enc arity (K1 i (Maybe a))- , GKeyValue enc pairs+ , KeyValuePair enc pairs , Monoid pairs ) => RecordToPairs enc pairs arity (S1 s (K1 i (Semigroup.Option a))) where@@ -1038,13 +1040,13 @@ fieldToPair :: (Selector s , GToJSON enc arity a- , GKeyValue enc pairs)+ , KeyValuePair enc pairs) => Options -> ToArgs enc arity p -> S1 s a p -> pairs fieldToPair opts targs m1 = let key = fieldLabelModifier opts (selName m1) value = gToJSON opts targs (unM1 m1)- in key `gPair` value+ in key `pair` value {-# INLINE fieldToPair #-} --------------------------------------------------------------------------------@@ -1098,12 +1100,12 @@ instance ( GToJSON enc arity a , ConsToJSON enc arity a , FromPairs enc pairs- , GKeyValue enc pairs+ , KeyValuePair enc pairs , Constructor c ) => SumToJSON' ObjectWithSingleField enc arity (C1 c a) where sumToJSON' opts targs =- Tagged . fromPairs . (typ `gPair`) . gToJSON opts targs+ Tagged . fromPairs . (typ `pair`) . gToJSON opts targs where typ = constructorTagModifier opts $ conName (undefined :: t c a p)@@ -2716,20 +2718,24 @@ -------------------------------------------------------------------------------- +-- | Wrap a list of pairs as an object. class Monoid pairs => FromPairs enc pairs | enc -> pairs where fromPairs :: pairs -> enc -instance FromPairs Encoding Series where+instance (a ~ Value) => FromPairs (Encoding' a) Series where fromPairs = E.pairs instance FromPairs Value (DList Pair) where fromPairs = object . toList -class Monoid kv => GKeyValue v kv where- gPair :: String -> v -> kv+-- | Like 'KeyValue' but the value is already converted to JSON+-- ('Value' or 'Encoding'), and the result actually represents lists of pairs+-- so it can be readily concatenated.+class Monoid kv => KeyValuePair v kv where+ pair :: String -> v -> kv -instance ToJSON v => GKeyValue v (DList Pair) where- gPair k v = DList.singleton (pack k .= v)+instance (v ~ Value) => KeyValuePair v (DList Pair) where+ pair k v = DList.singleton (pack k .= v) -instance GKeyValue Encoding Series where- gPair = E.pairStr+instance (e ~ Encoding) => KeyValuePair e Series where+ pair = E.pairStr
aeson.cabal view
@@ -1,5 +1,5 @@ name: aeson-version: 1.2.4.0+version: 1.3.0.0 license: BSD3 license-file: LICENSE category: Text, Web, JSON@@ -125,7 +125,7 @@ scientific >= 0.3.4.7 && < 0.4, tagged >=0.8.3 && <0.9, template-haskell >= 2.7,- text >= 1.1.1.0,+ text >= 1.2.3, th-abstraction >= 0.2.2 && < 0.3, time >= 1.1.1.4, time-locale-compat >= 0.1.1 && < 0.2,@@ -212,7 +212,7 @@ directory, dlist, filepath,- generic-deriving >= 1.10 && < 1.12,+ generic-deriving >= 1.10 && < 1.13, ghc-prim >= 0.2, hashable >= 1.2.4.0, scientific,
attoparsec-iso8601/Data/Attoparsec/Time.hs view
@@ -42,9 +42,9 @@ day :: Parser Day day = do absOrNeg <- negate <$ char '-' <|> id <$ char '+' <|> pure id- y <- decimal <* char '-'- m <- twoDigits <* char '-'- d <- twoDigits+ y <- (decimal <* char '-') <|> fail "date must be of form [+,-]YYYY-MM-DD"+ m <- (twoDigits <* char '-') <|> fail "date must be of form [+,-]YYYY-MM-DD"+ d <- twoDigits <|> fail "date must be of form [+,-]YYYY-MM-DD" maybe (fail "invalid date") return (fromGregorianValid (absOrNeg y) m d) -- | Parse a two-digit integer (e.g. day of month, hour).
− benchmarks/AesonCompareAutoInstances.hs
@@ -1,282 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TemplateHaskell #-}--module Main (main) where--import Prelude ()-import Prelude.Compat--import Control.Monad-import Control.DeepSeq (NFData, rnf, deepseq)-import Criterion.Main hiding (defaultOptions)-import Data.Aeson-import Data.Aeson.Encoding-import Data.Aeson.TH-import Data.Aeson.Types-import Data.ByteString.Lazy (ByteString)-import Data.Data (Data)-import Data.Typeable (Typeable)-import GHC.Generics (Generic, Rep)-import Options--toBS :: Encoding -> ByteString-toBS = encodingToLazyByteString--gEncode :: (Generic a, GToEncoding Zero (Rep a)) => a -> ByteString-gEncode = toBS . genericToEncoding opts------------------------------------------------------------------------------------data D a = Nullary- | Unary Int- | Product String Char a- | Record { testOne :: Double- , testTwo :: Bool- , testThree :: D a- }- deriving (Show, Eq)--deriveJSON opts ''D--instance NFData a => NFData (D a) where- rnf Nullary = ()- rnf (Unary n) = rnf n- rnf (Product s c x) = s `deepseq` c `deepseq` rnf x- rnf (Record d b y) = d `deepseq` b `deepseq` rnf y--type T = D (D (D ()))--d :: T-d = Record- { testOne = 1234.56789- , testTwo = True- , testThree = Product "Hello World!" 'a'- Record- { testOne = 9876.54321- , testTwo = False- , testThree = Product "Yeehaa!!!" '\n' Nullary- }- }------------------------------------------------------------------------------------data D' a = Nullary'- | Unary' Int- | Product' String Char a- | Record' { testOne' :: Double- , testTwo' :: Bool- , testThree' :: D' a- }- deriving (Show, Eq, Generic)--instance ToJSON a => ToJSON (D' a) where- toJSON = genericToJSON opts--instance FromJSON a => FromJSON (D' a) where- parseJSON = genericParseJSON opts--instance NFData a => NFData (D' a) where- rnf Nullary' = ()- rnf (Unary' n) = rnf n- rnf (Product' s c x) = s `deepseq` c `deepseq` rnf x- rnf (Record' d b y) = d `deepseq` b `deepseq` rnf y--type T' = D' (D' (D' ()))--d' :: T'-d' = Record'- { testOne' = 1234.56789- , testTwo' = True- , testThree' = Product' "Hello World!" 'a'- Record'- { testOne' = 9876.54321- , testTwo' = False- , testThree' = Product' "Yeehaa!!!" '\n' Nullary'- }- }------------------------------------------------------------------------------------data BigRecord = BigRecord- { field01 :: !Int, field02 :: !Int, field03 :: !Int, field04 :: !Int, field05 :: !Int- , field06 :: !Int, field07 :: !Int, field08 :: !Int, field09 :: !Int, field10 :: !Int- , field11 :: !Int, field12 :: !Int, field13 :: !Int, field14 :: !Int, field15 :: !Int- , field16 :: !Int, field17 :: !Int, field18 :: !Int, field19 :: !Int, field20 :: !Int- , field21 :: !Int, field22 :: !Int, field23 :: !Int, field24 :: !Int, field25 :: !Int- } deriving (Show, Eq, Generic)--instance NFData BigRecord--bigRecord = BigRecord 1 2 3 4 5- 6 7 8 9 10- 11 12 13 14 15- 16 17 18 19 20- 21 22 23 24 25--return []--gBigRecordToJSON :: BigRecord -> Value-gBigRecordToJSON = genericToJSON opts--gBigRecordEncode :: BigRecord -> ByteString-gBigRecordEncode = gEncode--gBigRecordFromJSON :: Value -> Result BigRecord-gBigRecordFromJSON = parse $ genericParseJSON opts--thBigRecordToJSON :: BigRecord -> Value-thBigRecordToJSON = $(mkToJSON opts ''BigRecord)--thBigRecordEncode :: BigRecord -> ByteString-thBigRecordEncode = toBS . $(mkToEncoding opts ''BigRecord)--thBigRecordFromJSON :: Value -> Result BigRecord-thBigRecordFromJSON = parse $(mkParseJSON opts ''BigRecord)------------------------------------------------------------------------------------data BigProduct = BigProduct- !Int !Int !Int !Int !Int- !Int !Int !Int !Int !Int- !Int !Int !Int !Int !Int- !Int !Int !Int !Int !Int- !Int !Int !Int !Int !Int- deriving (Show, Eq, Generic)--instance NFData BigProduct--bigProduct = BigProduct 1 2 3 4 5- 6 7 8 9 10- 11 12 13 14 15- 16 17 18 19 20- 21 22 23 24 25--return []--gBigProductToJSON :: BigProduct -> Value-gBigProductToJSON = genericToJSON opts--gBigProductEncode :: BigProduct -> ByteString-gBigProductEncode = gEncode--gBigProductFromJSON :: Value -> Result BigProduct-gBigProductFromJSON = parse $ genericParseJSON opts--thBigProductToJSON :: BigProduct -> Value-thBigProductToJSON = $(mkToJSON opts ''BigProduct)--thBigProductEncode :: BigProduct -> ByteString-thBigProductEncode = toBS . $(mkToEncoding opts ''BigProduct)--thBigProductFromJSON :: Value -> Result BigProduct-thBigProductFromJSON = parse $(mkParseJSON opts ''BigProduct)------------------------------------------------------------------------------------data BigSum = F01 | F02 | F03 | F04 | F05- | F06 | F07 | F08 | F09 | F10- | F11 | F12 | F13 | F14 | F15- | F16 | F17 | F18 | F19 | F20- | F21 | F22 | F23 | F24 | F25- deriving (Show, Eq, Generic)--instance NFData BigSum--bigSum = F25--return []--gBigSumToJSON :: BigSum -> Value-gBigSumToJSON = genericToJSON opts--gBigSumEncode :: BigSum -> ByteString-gBigSumEncode = gEncode--gBigSumFromJSON :: Value -> Result BigSum-gBigSumFromJSON = parse $ genericParseJSON opts--thBigSumToJSON :: BigSum -> Value-thBigSumToJSON = $(mkToJSON opts ''BigSum)--thBigSumEncode :: BigSum -> ByteString-thBigSumEncode = toBS . $(mkToEncoding opts ''BigSum)--thBigSumFromJSON :: Value -> Result BigSum-thBigSumFromJSON = parse $(mkParseJSON opts ''BigSum)------------------------------------------------------------------------------------type FJ a = Value -> Result a--runBench :: IO ()-runBench = defaultMain- [ let v = toJSON d- in (d, d', v) `deepseq`- bgroup "D"- [ group "toJSON" (nf toJSON d)- (nf toJSON d')- , group "encode" (nf encode d)- (nf encode d')- , group "fromJSON" (nf ( fromJSON :: FJ T ) v)- (nf ( fromJSON :: FJ T') v)- ]- , let v = thBigRecordToJSON bigRecord- in bigRecord `deepseq` v `deepseq`- bgroup "BigRecord"- [ group "toJSON" (nf thBigRecordToJSON bigRecord)- (nf gBigRecordToJSON bigRecord)- , group "encode" (nf thBigRecordEncode bigRecord)- (nf gBigRecordEncode bigRecord)- , group "fromJSON" (nf (thBigRecordFromJSON :: FJ BigRecord) v)- (nf ( gBigRecordFromJSON :: FJ BigRecord) v)- ]- , let v = thBigProductToJSON bigProduct- in bigProduct `deepseq` v `deepseq`- bgroup "BigProduct"- [ group "toJSON" (nf thBigProductToJSON bigProduct)- (nf gBigProductToJSON bigProduct)- , group "encode" (nf thBigProductEncode bigProduct)- (nf gBigProductEncode bigProduct)- , group "fromJSON" (nf (thBigProductFromJSON :: FJ BigProduct) v)- (nf (gBigProductFromJSON :: FJ BigProduct) v)- ]- , let v = thBigSumToJSON bigSum- in bigSum `deepseq` v `deepseq`- bgroup "BigSum"- [ group "toJSON" (nf thBigSumToJSON bigSum)- (nf gBigSumToJSON bigSum)- , group "encode" (nf thBigSumEncode bigSum)- (nf gBigSumEncode bigSum)- , group "fromJSON" (nf (thBigSumFromJSON :: FJ BigSum) v)- (nf (gBigSumFromJSON :: FJ BigSum) v)- ]- ]--group n th gen = bgroup n [ bench "th" th- , bench "generic" gen- ]--sanityCheck = do- check d toJSON fromJSON encode- check d' toJSON fromJSON encode- check bigRecord thBigRecordToJSON thBigRecordFromJSON thBigRecordEncode- check bigRecord gBigRecordToJSON gBigRecordFromJSON gBigRecordEncode- check bigProduct thBigProductToJSON thBigProductFromJSON thBigProductEncode- check bigProduct gBigProductToJSON gBigProductFromJSON gBigProductEncode- check bigSum thBigSumToJSON thBigSumFromJSON thBigSumEncode- check bigSum gBigSumToJSON gBigSumFromJSON gBigSumEncode--check :: (Show a, Eq a)- => a -> (a -> Value) -> (Value -> Result a) -> (a -> ByteString) -> IO ()-check x toJSON fromJSON encode = do- unless (Success x == (fromJSON . toJSON) x) $ fail $ "toJSON: " ++ show x- unless (Success x == (decode' . encode) x) $ fail $ "encode: " ++ show x- where- decode' s = case decode s of- Just v -> fromJSON v- Nothing -> fail ""--main = do- sanityCheck- runBench
benchmarks/AesonFoldable.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PackageImports #-} module Main (main) where @@ -9,8 +8,7 @@ import Prelude.Compat import Data.Foldable (toList)-import qualified "aeson" Data.Aeson as A-import qualified "aeson-benchmarks" Data.Aeson as B+import qualified Data.Aeson as A import qualified Data.Sequence as S import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U@@ -21,10 +19,6 @@ newtype L f = L { getL :: f Int } -instance Foldable f => B.ToJSON (L f) where- toJSON = error "do not use this"- toEncoding = B.toEncoding . toList . getL- instance Foldable f => A.ToJSON (L f) where toJSON = error "do not use this" toEncoding = A.toEncoding . toList . getL@@ -35,10 +29,6 @@ newtype F f = F { getF :: f Int } -instance Foldable f => B.ToJSON (F f) where- toJSON = error "do not use this"- toEncoding = B.foldable . getF- instance Foldable f => A.ToJSON (F f) where toJSON = error "do not use this" toEncoding = A.foldable . getF@@ -63,52 +53,34 @@ -- Main ------------------------------------------------------------------------------- -benchEncodeA+benchEncode :: A.ToJSON a => String -> a -> Benchmark-benchEncodeA name val+benchEncode name val = bench ("A " ++ name) $ nf A.encode val -benchEncodeB- :: B.ToJSON a- => String- -> a- -> Benchmark-benchEncodeB name val- = bench ("B " ++ name) $ nf B.encode val- main :: IO () main = defaultMain [ bgroup "encode" [ bgroup "List"- [ benchEncodeB "-" valueList- , benchEncodeB "L" $ L valueList- , benchEncodeB "F" $ F valueList- , benchEncodeA "-" valueList- , benchEncodeA "L" $ L valueList- , benchEncodeA "F" $ F valueList+ [ benchEncode "-" valueList+ , benchEncode "L" $ L valueList+ , benchEncode "F" $ F valueList ] , bgroup "Seq"- [ benchEncodeB "-" valueSeq- , benchEncodeB "L" $ L valueSeq- , benchEncodeB "F" $ F valueSeq- , benchEncodeA "-" valueSeq- , benchEncodeA "L" $ L valueSeq- , benchEncodeA "F" $ F valueSeq+ [ benchEncode "-" valueSeq+ , benchEncode "L" $ L valueSeq+ , benchEncode "F" $ F valueSeq ] , bgroup "Vector"- [ benchEncodeB "-" valueVector- , benchEncodeB "L" $ L valueVector- , benchEncodeB "F" $ F valueVector- , benchEncodeA "-" valueVector- , benchEncodeA "L" $ L valueVector- , benchEncodeA "F" $ F valueVector+ [ benchEncode "-" valueVector+ , benchEncode "L" $ L valueVector+ , benchEncode "F" $ F valueVector ] , bgroup "Vector.Unboxed"- [ benchEncodeB "-" valueUVector- , benchEncodeA "-" valueUVector+ [ benchEncode "-" valueUVector ] ] ]
benchmarks/AesonMap.hs view
@@ -1,6 +1,4 @@ {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PackageImports #-} {-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -fno-warn-orphans #-}@@ -15,9 +13,8 @@ import Data.Hashable import Data.Proxy (Proxy (..)) import Data.Tagged (Tagged (..))-import qualified "aeson" Data.Aeson as A-import qualified "aeson-benchmarks" Data.Aeson as B-import qualified "aeson-benchmarks" Data.Aeson.Types as B (fromJSONKeyCoerce)+import Data.Aeson+import Data.Aeson.Types (fromJSONKeyCoerce) import qualified Data.ByteString.Lazy as LBS import qualified Data.HashMap.Strict as HM import qualified Data.Map as M@@ -47,10 +44,10 @@ instance Hashable T1 where hashWithSalt salt (T1 t) = hashWithSalt salt t -instance B.FromJSON T1 where- parseJSON = B.withText "T1" $ pure . T1-instance B.FromJSONKey T1 where- fromJSONKey = B.FromJSONKeyText T1+instance FromJSON T1 where+ parseJSON = withText "T1" $ pure . T1+instance FromJSONKey T1 where+ fromJSONKey = FromJSONKeyText T1 ------------------------------------------------------------------------------- -- Coerce@@ -64,10 +61,10 @@ instance Hashable T2 where hashWithSalt salt (T2 t) = hashWithSalt salt t -instance B.FromJSON T2 where- parseJSON = B.withText "T2" $ pure . T2-instance B.FromJSONKey T2 where- fromJSONKey = B.fromJSONKeyCoerce+instance FromJSON T2 where+ parseJSON = withText "T2" $ pure . T2+instance FromJSONKey T2 where+ fromJSONKey = fromJSONKeyCoerce ------------------------------------------------------------------------------- -- TextParser@@ -81,10 +78,10 @@ instance Hashable T3 where hashWithSalt salt (T3 t) = hashWithSalt salt t -instance B.FromJSON T3 where- parseJSON = B.withText "T3" $ pure . T3-instance B.FromJSONKey T3 where- fromJSONKey = B.FromJSONKeyTextParser (pure . T3)+instance FromJSON T3 where+ parseJSON = withText "T3" $ pure . T3+instance FromJSONKey T3 where+ fromJSONKey = FromJSONKeyTextParser (pure . T3) ------------------------------------------------------------------------------- -- Values@@ -97,40 +94,30 @@ value10000 = value 10000 encodedValue10 :: LBS.ByteString-encodedValue10 = B.encode value10+encodedValue10 = encode value10 encodedValue100 :: LBS.ByteString-encodedValue100 = B.encode value100+encodedValue100 = encode value100 encodedValue1000 :: LBS.ByteString-encodedValue1000 = B.encode value1000+encodedValue1000 = encode value1000 encodedValue10000 :: LBS.ByteString-encodedValue10000 = B.encode value10000+encodedValue10000 = encode value10000 ------------------------------------------------------------------------------- -- Helpers ------------------------------------------------------------------------------- -decodeHMB- :: (B.FromJSONKey k, Eq k, Hashable k)- => Proxy k -> LBS.ByteString -> Maybe (HM.HashMap k T.Text)-decodeHMB _ = B.decode--decodeHMA- :: (A.FromJSON (HM.HashMap k T.Text), Eq k, Hashable k)+decodeHM+ :: (FromJSON (HM.HashMap k T.Text), Eq k, Hashable k) => Proxy k -> LBS.ByteString -> Maybe (HM.HashMap k T.Text)-decodeHMA _ = A.decode--decodeMapB- :: (B.FromJSONKey k, Ord k)- => Proxy k -> LBS.ByteString -> Maybe (M.Map k T.Text)-decodeMapB _ = B.decode+decodeHM _ = decode -decodeMapA- :: (A.FromJSON (M.Map k T.Text), Ord k)+decodeMap+ :: (FromJSON (M.Map k T.Text), Ord k) => Proxy k -> LBS.ByteString -> Maybe (M.Map k T.Text)-decodeMapA _ = A.decode+decodeMap _ = decode proxyText :: Proxy T.Text proxyText = Proxy@@ -156,15 +143,14 @@ -> LBS.ByteString -> Benchmark benchDecodeHM name val = bgroup name- [ bench "Text" $ nf (decodeHMB proxyText) val- , bench "Identity" $ nf (decodeHMB proxyT1) val- , bench "Coerce" $ nf (decodeHMB proxyT2) val- , bench "Parser" $ nf (decodeHMB proxyT3) val- , bench "aeson-hackage" $ nf (decodeHMA proxyText) val- , bench "Tagged Text" $ nf (decodeHMB $ proxyTagged proxyText) val- , bench "Tagged Identity" $ nf (decodeHMB $ proxyTagged proxyT1) val- , bench "Tagged Coerce" $ nf (decodeHMB $ proxyTagged proxyT2) val- , bench "Tagged Parser" $ nf (decodeHMB $ proxyTagged proxyT3) val+ [ bench "Text" $ nf (decodeHM proxyText) val+ , bench "Identity" $ nf (decodeHM proxyT1) val+ , bench "Coerce" $ nf (decodeHM proxyT2) val+ , bench "Parser" $ nf (decodeHM proxyT3) val+ , bench "Tagged Text" $ nf (decodeHM $ proxyTagged proxyText) val+ , bench "Tagged Identity" $ nf (decodeHM $ proxyTagged proxyT1) val+ , bench "Tagged Coerce" $ nf (decodeHM $ proxyTagged proxyT2) val+ , bench "Tagged Parser" $ nf (decodeHM $ proxyTagged proxyT3) val ] benchDecodeMap@@ -172,11 +158,10 @@ -> LBS.ByteString -> Benchmark benchDecodeMap name val = bgroup name- [ bench "Text" $ nf (decodeMapB proxyText) val- , bench "Identity" $ nf (decodeMapB proxyT1) val- , bench "Coerce" $ nf (decodeMapB proxyT2) val- , bench "Parser" $ nf (decodeMapB proxyT3) val- , bench "aeson-hackage" $ nf (decodeMapA proxyText) val+ [ bench "Text" $ nf (decodeMap proxyText) val+ , bench "Identity" $ nf (decodeMap proxyT1) val+ , bench "Coerce" $ nf (decodeMap proxyT2) val+ , bench "Parser" $ nf (decodeMap proxyT3) val ] benchEncodeHM@@ -184,8 +169,7 @@ -> HM.HashMap T.Text T.Text -> Benchmark benchEncodeHM name val = bgroup name- [ bench "Text" $ nf B.encode val- , bench "aeson-0.11" $ nf A.encode val+ [ bench "Text" $ nf encode val ] benchEncodeMap@@ -193,8 +177,7 @@ -> HM.HashMap T.Text T.Text -> Benchmark benchEncodeMap name val = bgroup name- [ bench "Text" $ nf B.encode val'- , bench "aeson-0.11" $ nf A.encode val'+ [ bench "Text" $ nf encode val' ] where val' :: M.Map T.Text T.Text
benchmarks/AesonParse.hs view
@@ -1,13 +1,12 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PackageImports #-} module Main (main) where import Prelude () import Prelude.Compat -import "aeson-benchmarks" Data.Aeson+import Data.Aeson import Control.Monad import Data.Attoparsec.ByteString (IResult(..), parseWith) import Data.Time.Clock
+ benchmarks/AutoCompare.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main (main) where++import Control.DeepSeq+import Control.Monad+import Criterion.Main+import Data.Aeson++import qualified Auto.T.D as T+import qualified Auto.T.BigRecord as T+import qualified Auto.T.BigProduct as T+import qualified Auto.T.BigSum as T+import qualified Auto.G.D as G+import qualified Auto.G.BigRecord as G+import qualified Auto.G.BigProduct as G+import qualified Auto.G.BigSum as G++--------------------------------------------------------------------------------++runBench :: IO ()+runBench = defaultMain+ [ compareBench "D" T.d G.d+ , compareBench "BigRecord" T.bigRecord G.bigRecord+ , compareBench "BigProduct" T.bigProduct G.bigProduct+ , compareBench "BigSum" T.bigSum G.bigSum+ ]++group :: String -> Benchmarkable -> Benchmarkable -> Benchmark+group n th gen = bgroup n [ bench "th" th+ , bench "generic" gen+ ]++compareBench+ :: forall a b+ . (ToJSON a, FromJSON a, NFData a, ToJSON b, FromJSON b, NFData b)+ => String -> a -> b -> Benchmark+compareBench name a b = v `deepseq` bgroup name+ [ group "toJSON" (nf toJSON a)+ (nf toJSON b)+ , group "encode" (nf encode a)+ (nf encode b)+ , group "fromJSON" (nf (fromJSON :: Value -> Result a) v)+ (nf (fromJSON :: Value -> Result b) v)+ ] where+ v = toJSON a -- == toJSON b++sanityCheck :: IO ()+sanityCheck = do+ check T.d+ check G.d+ check T.bigRecord+ check G.bigRecord+ check T.bigProduct+ check G.bigProduct+ check T.bigSum+ check G.bigSum++check :: (Show a, Eq a, FromJSON a, ToJSON a)+ => a -> IO ()+check x = do+ unless (Success x == (fromJSON . toJSON) x) $ fail $ "toJSON: " ++ show x+ unless (Success x == (decode_ . encode) x) $ fail $ "encode: " ++ show x+ where+ decode_ s = case decode s of+ Just v -> fromJSON v+ Nothing -> fail ""++main :: IO ()+main = do+ sanityCheck+ runBench
benchmarks/Compare.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} module Main (main) where@@ -14,7 +13,7 @@ import Twitter import Twitter.Manual () import Typed.Common-import qualified "aeson-benchmarks" Data.Aeson as Aeson+import qualified Data.Aeson as Aeson import qualified Compare.JsonBench as JsonBench main :: IO ()
benchmarks/Compare/BufferBuilder.hs view
@@ -12,7 +12,6 @@ import Data.BufferBuilder.Json import Data.Int (Int64) import Data.Monoid ((<>))-import Prelude hiding (id) import Twitter import qualified Data.BufferBuilder.Utf8 as UB
benchmarks/Compare/JsonBuilder.hs view
@@ -10,7 +10,6 @@ import Data.Json.Builder import Data.Monoid ((<>))-import Prelude hiding (id) import Twitter instance JsObject Metadata where
benchmarks/CompareWithJSON.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE PackageImports #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main (main) where@@ -11,10 +10,9 @@ import Control.DeepSeq (NFData(rnf)) import Criterion.Main import Data.Maybe (fromMaybe)-import qualified "aeson-benchmarks" Data.Aeson as A-import qualified "aeson-benchmarks" Data.Aeson.Text as A-import qualified "aeson-benchmarks" Data.Aeson.Parser.Internal as I-import qualified "aeson" Data.Aeson as B+import qualified Data.Aeson as A+import qualified Data.Aeson.Text as A+import qualified Data.Aeson.Parser.Internal as I import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL import qualified Data.Text.Lazy as TL@@ -39,20 +37,14 @@ J.Ok v -> v J.Error _ -> error "fail to parse via JSON" -decodeA :: BL.ByteString -> A.Value-decodeA s = fromMaybe (error "fail to parse via Aeson") $ A.decode s--decodeA' :: BL.ByteString -> A.Value-decodeA' s = fromMaybe (error "fail to parse via Aeson") $ A.decode' s--decodeAS :: BS.ByteString -> A.Value-decodeAS s = fromMaybe (error "fail to parse via Aeson") $ A.decodeStrict' s+decode :: BL.ByteString -> A.Value+decode s = fromMaybe (error "fail to parse via Aeson") $ A.decode s -decodeB :: BL.ByteString -> B.Value-decodeB s = fromMaybe (error "fail to parse via Aeson") $ B.decode s+decode' :: BL.ByteString -> A.Value+decode' s = fromMaybe (error "fail to parse via Aeson") $ A.decode' s -decodeBS :: BS.ByteString -> B.Value-decodeBS s = fromMaybe (error "fail to parse via Aeson") $ B.decodeStrict' s+decodeS :: BS.ByteString -> A.Value+decodeS s = fromMaybe (error "fail to parse via Aeson") $ A.decodeStrict' s decodeIP :: BL.ByteString -> A.Value decodeIP s = fromMaybe (error "fail to parse via Parser.decodeWith") $@@ -80,32 +72,29 @@ defaultMain [ bgroup "decode" [ bgroup "en" [- bench "aeson/lazy" $ nf decodeA enA- , bench "aeson/strict" $ nf decodeA' enA- , bench "aeson/stricter" $ nf decodeAS enS- , bench "aeson/hackage" $ nf decodeB enA- , bench "aeson/hackage'" $ nf decodeBS enS+ bench "aeson/lazy" $ nf decode enA+ , bench "aeson/strict" $ nf decode' enA+ , bench "aeson/stricter" $ nf decodeS enS , bench "aeson/parser" $ nf decodeIP enA , bench "json" $ nf decodeJ enJ ] , bgroup "jp" [- bench "aeson" $ nf decodeA jpA- , bench "aeson/stricter" $ nf decodeAS jpS- , bench "aeson/hackage" $ nf decodeB jpA+ bench "aeson" $ nf decode jpA+ , bench "aeson/stricter" $ nf decodeS jpS , bench "json" $ nf decodeJ jpJ ] ] , bgroup "encode" [ bgroup "en" [- bench "aeson-to-bytestring" $ nf A.encode (decodeA enA)- , bench "aeson-via-text-to-bytestring" $ nf encodeViaText (decodeA enA)- , bench "aeson-to-text" $ nf encodeToText (decodeA enA)+ bench "aeson-to-bytestring" $ nf A.encode (decode enA)+ , bench "aeson-via-text-to-bytestring" $ nf encodeViaText (decode enA)+ , bench "aeson-to-text" $ nf encodeToText (decode enA) , bench "json" $ nf encodeJ (decodeJ enJ) ] , bgroup "jp" [- bench "aeson-to-bytestring" $ nf A.encode (decodeA jpA)- , bench "aeson-via-text-to-bytestring" $ nf encodeViaText (decodeA jpA)- , bench "aeson-to-text" $ nf encodeToText (decodeA jpA)+ bench "aeson-to-bytestring" $ nf A.encode (decode jpA)+ , bench "aeson-via-text-to-bytestring" $ nf encodeViaText (decode jpA)+ , bench "aeson-to-text" $ nf encodeToText (decode jpA) , bench "json" $ nf encodeJ (decodeJ jpJ) ] ]
benchmarks/Dates.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -fsimpl-tick-factor=0 #-} module Main (main) where import Prelude ()
benchmarks/Escape.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-} module Main (main) where @@ -7,19 +7,25 @@ import Prelude.Compat import Criterion.Main-import qualified "aeson-benchmarks" Data.Aeson.Parser.UnescapeFFI as FFI-import qualified "aeson-benchmarks" Data.Aeson.Parser.UnescapePure as Pure+import qualified Data.Aeson.Parser.UnescapeFFI as FFI+import qualified Data.Aeson.Parser.UnescapePure as Pure import qualified Data.ByteString.Char8 as BS--n :: Int-n = 10000--input :: BS.ByteString-input = BS.concat $ replicate n $ BS.pack "\\\""+import System.Environment (getArgs, withArgs) main :: IO ()-main = defaultMain+main = do+ args_ <- getArgs+ let (args, p, n) =+ case args_ of+ "--pattern" : p : args_ -> k p args_+ _ -> k "\\\"" args_+ k p args_ =+ case args_ of+ "--repeat" : n : args_ -> (args_, p, read n)+ args_ -> (args_, p, 10000)+ input = BS.concat $ replicate n $ BS.pack p+ withArgs args $ defaultMain [ bench "ffi" $ whnf FFI.unescapeText input , bench "pure" $ whnf Pure.unescapeText input ]
benchmarks/Micro.hs view
@@ -4,8 +4,9 @@ import Prelude.Compat import Criterion.Main-import qualified Data.Aeson.Encoding.Builder as AB-import qualified Data.ByteString.Builder as B++-- Encoding is a newtype wrapper around Builder+import Data.Aeson.Encoding (text, string, encodingToLazyByteString) import qualified Data.Text as T main :: IO ()@@ -13,8 +14,8 @@ let txt = "append (append b (primBounded w1 x1)) (primBounded w2 x2)" defaultMain [ bgroup "string" [- bench "text" $ nf (B.toLazyByteString . AB.text) (T.pack txt)- , bench "string direct" $ nf (B.toLazyByteString . AB.string) txt- , bench "string via text" $ nf (B.toLazyByteString . AB.text . T.pack) txt+ bench "text" $ nf (encodingToLazyByteString . text) (T.pack txt)+ , bench "string direct" $ nf (encodingToLazyByteString . string) txt+ , bench "string via text" $ nf (encodingToLazyByteString . text . T.pack) txt ] ]
benchmarks/Options.hs view
@@ -1,8 +1,5 @@ module Options (opts) where -import Prelude ()-import Prelude.Compat- import Data.Aeson.Types opts :: Options
benchmarks/Typed/Common.hs view
@@ -1,8 +1,3 @@-{-# LANGUAGE CPP #-}-#ifdef HAS_BOTH_AESON_AND_BENCHMARKS-{-# LANGUAGE PackageImports #-}-#endif- {-# OPTIONS_GHC -fno-warn-unused-imports #-} module Typed.Common (load) where@@ -14,12 +9,7 @@ import System.Exit import System.IO -#ifndef HAS_BOTH_AESON_AND_BENCHMARKS import Data.Aeson hiding (Result)-#else-import "aeson" Data.Aeson hiding (Result)-import qualified "aeson-benchmarks" Data.Aeson as B-#endif load :: FromJSON a => FilePath -> IO a load fileName = do
benchmarks/Typed/Generic.hs view
@@ -1,60 +1,43 @@-{-# LANGUAGE PackageImports #-} module Typed.Generic (benchmarks, decodeBenchmarks) where import Prelude () import Prelude.Compat -import "aeson" Data.Aeson hiding (Result)+import Data.Aeson hiding (Result) import Criterion import Data.ByteString.Lazy as L import Twitter.Generic import Typed.Common-import qualified "aeson-benchmarks" Data.Aeson as B -encodeDirectA :: Result -> L.ByteString-encodeDirectA = encode--encodeViaValueA :: Result -> L.ByteString-encodeViaValueA = encode . toJSON--encodeDirectB :: Result -> L.ByteString-encodeDirectB = B.encode+encodeDirect :: Result -> L.ByteString+encodeDirect = encode -encodeViaValueB :: Result -> L.ByteString-encodeViaValueB = B.encode . B.toJSON+encodeViaValue :: Result -> L.ByteString+encodeViaValue = encode . toJSON benchmarks :: Benchmark benchmarks = env ((,) <$> load "json-data/twitter100.json" <*> load "json-data/jp100.json") $ \ ~(twitter100, jp100) -> bgroup "encodeGeneric" [ bgroup "direct" [- bench "twitter100" $ nf encodeDirectB twitter100- , bench "jp100" $ nf encodeDirectB jp100- , bench "twitter100 baseline" $ nf encodeDirectA twitter100- , bench "jp100 baseline" $ nf encodeDirectA jp100+ bench "twitter100" $ nf encodeDirect twitter100+ , bench "jp100" $ nf encodeDirect jp100 ] , bgroup "viaValue" [- bench "twitter100" $ nf encodeViaValueB twitter100- , bench "jp100" $ nf encodeViaValueB jp100- , bench "twitter100 baseline" $ nf encodeViaValueA twitter100- , bench "jp100 baseline" $ nf encodeViaValueA jp100+ bench "twitter100" $ nf encodeViaValue twitter100+ , bench "jp100" $ nf encodeViaValue jp100 ] ] -decodeDirectA :: L.ByteString -> Maybe Result-decodeDirectA = decode--decodeDirectB :: L.ByteString -> Maybe Result-decodeDirectB = B.decode+decodeDirect :: L.ByteString -> Maybe Result+decodeDirect = decode decodeBenchmarks :: Benchmark decodeBenchmarks = env ((,) <$> L.readFile "json-data/twitter100.json" <*> L.readFile "json-data/jp100.json") $ \ ~(twitter100, jp100) -> bgroup "decodeGeneric" [ bgroup "direct"- [ bench "twitter100" $ nf decodeDirectB twitter100- , bench "jp100" $ nf decodeDirectB jp100- , bench "twitter100 baseline" $ nf decodeDirectA twitter100- , bench "jp100 baseline" $ nf decodeDirectA jp100+ [ bench "twitter100" $ nf decodeDirect twitter100+ , bench "jp100" $ nf decodeDirect jp100 ] ]
benchmarks/Typed/Manual.hs view
@@ -1,60 +1,43 @@-{-# LANGUAGE PackageImports #-} module Typed.Manual (benchmarks, decodeBenchmarks) where import Prelude () import Prelude.Compat -import "aeson" Data.Aeson hiding (Result)+import Data.Aeson hiding (Result) import Criterion import Data.ByteString.Lazy as L import Twitter.Manual import Typed.Common-import qualified "aeson-benchmarks" Data.Aeson as B -encodeDirectA :: Result -> L.ByteString-encodeDirectA = encode--encodeViaValueA :: Result -> L.ByteString-encodeViaValueA = encode . toJSON--encodeDirectB :: Result -> L.ByteString-encodeDirectB = B.encode+encodeDirect :: Result -> L.ByteString+encodeDirect = encode -encodeViaValueB :: Result -> L.ByteString-encodeViaValueB = B.encode . B.toJSON+encodeViaValue :: Result -> L.ByteString+encodeViaValue = encode . toJSON benchmarks :: Benchmark benchmarks = env ((,) <$> load "json-data/twitter100.json" <*> load "json-data/jp100.json") $ \ ~(twitter100, jp100) -> bgroup "encodeManual" [ bgroup "direct" [- bench "twitter100" $ nf encodeDirectB twitter100- , bench "jp100" $ nf encodeDirectB jp100- , bench "twitter100 baseline" $ nf encodeDirectA twitter100- , bench "jp100 baseline" $ nf encodeDirectA jp100+ bench "twitter100" $ nf encodeDirect twitter100+ , bench "jp100" $ nf encodeDirect jp100 ] , bgroup "viaValue" [- bench "twitter100" $ nf encodeViaValueB twitter100- , bench "jp100" $ nf encodeViaValueB jp100- , bench "twitter100 baseline" $ nf encodeViaValueA twitter100- , bench "jp100 baseline" $ nf encodeViaValueA jp100+ bench "twitter100" $ nf encodeViaValue twitter100+ , bench "jp100" $ nf encodeViaValue jp100 ] ] -decodeDirectA :: L.ByteString -> Maybe Result-decodeDirectA = decode--decodeDirectB :: L.ByteString -> Maybe Result-decodeDirectB = B.decode+decodeDirect :: L.ByteString -> Maybe Result+decodeDirect = decode decodeBenchmarks :: Benchmark decodeBenchmarks = env ((,) <$> L.readFile "json-data/twitter100.json" <*> L.readFile "json-data/jp100.json") $ \ ~(twitter100, jp100) -> bgroup "decodeManual" [ bgroup "direct"- [ bench "twitter100" $ nf decodeDirectB twitter100- , bench "jp100" $ nf decodeDirectB jp100- , bench "twitter100 baseline" $ nf decodeDirectA twitter100- , bench "jp100 baseline" $ nf decodeDirectA jp100+ [ bench "twitter100" $ nf decodeDirect twitter100+ , bench "jp100" $ nf decodeDirect jp100 ] ]
benchmarks/Typed/TH.hs view
@@ -1,60 +1,43 @@-{-# LANGUAGE PackageImports #-} module Typed.TH (benchmarks, decodeBenchmarks) where import Prelude () import Prelude.Compat -import "aeson" Data.Aeson hiding (Result)+import Data.Aeson hiding (Result) import Criterion import Data.ByteString.Lazy as L import Twitter.TH import Typed.Common-import qualified "aeson-benchmarks" Data.Aeson as B -encodeDirectA :: Result -> L.ByteString-encodeDirectA = encode--encodeViaValueA :: Result -> L.ByteString-encodeViaValueA = encode . toJSON--encodeDirectB :: Result -> L.ByteString-encodeDirectB = B.encode+encodeDirect :: Result -> L.ByteString+encodeDirect = encode -encodeViaValueB :: Result -> L.ByteString-encodeViaValueB = B.encode . B.toJSON+encodeViaValue :: Result -> L.ByteString+encodeViaValue = encode . toJSON benchmarks :: Benchmark benchmarks = env ((,) <$> load "json-data/twitter100.json" <*> load "json-data/jp100.json") $ \ ~(twitter100, jp100) -> bgroup "encodeTH" [ bgroup "direct" [- bench "twitter100" $ nf encodeDirectB twitter100- , bench "jp100" $ nf encodeDirectB jp100- , bench "twitter100 baseline" $ nf encodeDirectA twitter100- , bench "jp100 baseline" $ nf encodeDirectA jp100+ bench "twitter100" $ nf encodeDirect twitter100+ , bench "jp100" $ nf encodeDirect jp100 ] , bgroup "viaValue" [- bench "twitter100" $ nf encodeViaValueA twitter100- , bench "jp100" $ nf encodeViaValueA jp100- , bench "twitter100 baseline" $ nf encodeViaValueB twitter100- , bench "jp100 baseline" $ nf encodeViaValueB jp100+ bench "twitter100" $ nf encodeViaValue twitter100+ , bench "jp100" $ nf encodeViaValue jp100 ] ] -decodeDirectA :: L.ByteString -> Maybe Result-decodeDirectA = decode--decodeDirectB :: L.ByteString -> Maybe Result-decodeDirectB = B.decode+decodeDirect :: L.ByteString -> Maybe Result+decodeDirect = decode decodeBenchmarks :: Benchmark decodeBenchmarks = env ((,) <$> L.readFile "json-data/twitter100.json" <*> L.readFile "json-data/jp100.json") $ \ ~(twitter100, jp100) -> bgroup "decodeTH" [ bgroup "direct"- [ bench "twitter100" $ nf decodeDirectB twitter100- , bench "jp100" $ nf decodeDirectB jp100- , bench "twitter100 baseline" $ nf decodeDirectA twitter100- , bench "jp100 baseline" $ nf decodeDirectA jp100+ [ bench "twitter100" $ nf decodeDirect twitter100+ , bench "jp100" $ nf decodeDirect jp100 ] ]
benchmarks/aeson-benchmarks.cabal view
@@ -1,100 +1,153 @@ name: aeson-benchmarks version: 0 build-type: Simple--cabal-version: >=1.8+cabal-version: >=1.10 flag bytestring-builder description: Depend on the bytestring-builder package for backwards compatibility. default: False manual: False +flag local-aeson+ description: Build the local version of aeson, to avoid rebuilding aeson's+ reverse dependencies for benchmarking (statistics, criterion).+ default: True+ manual: True+ library default-language: Haskell2010- hs-source-dirs: .. . ../ffi ../pure ../attoparsec-iso8601- c-sources: ../cbits/unescape_string.c- exposed-modules:- Data.Aeson- Data.Aeson.Encoding- Data.Aeson.Encoding.Builder- Data.Aeson.Encoding.Internal- Data.Aeson.Internal- Data.Aeson.Internal.Functions- Data.Aeson.Internal.Time- Data.Aeson.Parser- Data.Aeson.Parser.Internal- Data.Aeson.Parser.Time- Data.Aeson.Parser.Unescape- Data.Aeson.Parser.UnescapeFFI- Data.Aeson.Parser.UnescapePure- Data.Aeson.TH- Data.Aeson.Text- Data.Aeson.Types- Data.Aeson.Types.Class- Data.Aeson.Types.FromJSON- Data.Aeson.Types.Generic- Data.Aeson.Types.Internal- Data.Aeson.Types.ToJSON- Data.Attoparsec.Time- Data.Attoparsec.Time.Internal - build-depends:- attoparsec >= 0.13.0.1,- base == 4.*,- base-compat >= 0.9.1 && <0.10,- time-locale-compat >=0.1.1 && <0.2,- containers,- deepseq,- dlist >= 0.2,- fail == 4.9.*,- ghc-prim >= 0.2,- hashable >= 1.1.2.0,- mtl,- scientific >= 0.3.4.7 && < 0.4,- syb,- tagged >=0.8.3 && <0.9,- template-haskell >= 2.4,- text >= 1.1.1.0,- th-abstraction >= 0.2.2 && < 0.3,- time,- transformers,- unordered-containers >= 0.2.3.0,- uuid-types >= 1.0.3 && <1.1,- vector >= 0.7.1- if flag(bytestring-builder) build-depends: bytestring >= 0.9 && < 0.10.4, bytestring-builder >= 0.10.4 && < 1 else build-depends: bytestring >= 0.10.4 - if impl(ghc >=7.8)- cpp-options: -DHAS_COERCIBLE+ if flag(local-aeson) - 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+ 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.10,+ time-locale-compat >=0.1.1 && <0.2,+ containers,+ deepseq,+ dlist >= 0.2,+ fail == 4.9.*,+ ghc-prim >= 0.2,+ hashable >= 1.1.2.0,+ mtl,+ scientific >= 0.3.4.7 && < 0.4,+ syb,+ tagged >=0.8.3 && <0.9,+ template-haskell >= 2.4,+ text >= 1.2.3,+ th-abstraction >= 0.2.2 && < 0.3,+ time,+ transformers,+ unordered-containers >= 0.2.3.0,+ uuid-types >= 1.0.3 && <1.1,+ vector >= 0.7.1 - include-dirs: ../include+ 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 - ghc-options: -O2 -Wall- cpp-options: -DGENERICS+ if impl(ghc >=7.8)+ cpp-options: -DHAS_COERCIBLE -executable aeson-benchmark-escape- main-is: Escape.hs- hs-source-dirs: ../examples .+ 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++ include-dirs: ../include++ ghc-options: -O2 -Wall+ cpp-options: -DGENERICS++ exposed-modules:+ Data.Aeson+ Data.Aeson.Compat+ Data.Aeson.Encoding+ Data.Aeson.Encoding.Builder+ Data.Aeson.Encoding.Internal+ Data.Aeson.Internal+ Data.Aeson.Internal.Functions+ Data.Aeson.Internal.Time+ Data.Aeson.Parser+ Data.Aeson.Parser.Internal+ Data.Aeson.Parser.Time+ Data.Aeson.Parser.Unescape+ Data.Aeson.Parser.UnescapeFFI+ Data.Aeson.Parser.UnescapePure+ Data.Aeson.TH+ Data.Aeson.Text+ Data.Aeson.Types+ Data.Aeson.Types.Class+ Data.Aeson.Types.FromJSON+ Data.Aeson.Types.Generic+ Data.Aeson.Types.Internal+ Data.Aeson.Types.ToJSON+ Data.Attoparsec.Time+ Data.Attoparsec.Time.Internal++ else++ build-depends: aeson++ reexported-modules:+ Data.Aeson,+ Data.Aeson.Encoding,+ Data.Aeson.Parser.Internal,+ Data.Aeson.Text,+ Data.Aeson.TH,+ Data.Aeson.Types++executable aeson-benchmark-auto-compare+ default-language: Haskell2010+ main-is: AutoCompare.hs+ hs-source-dirs: . ghc-options: -Wall -O2 -rtsopts+ other-modules:+ Auto.T.D+ Auto.T.BigRecord+ Auto.T.BigProduct+ Auto.T.BigSum+ Auto.G.D+ Auto.G.BigRecord+ Auto.G.BigProduct+ Auto.G.BigSum+ Options build-depends: aeson-benchmarks, base,- base-compat,- bytestring,- criterion >= 1.0,+ criterion, deepseq,- ghc-prim,- text+ template-haskell +executable aeson-benchmark-escape+ default-language: Haskell2010+ main-is: Escape.hs+ hs-source-dirs: ../examples .+ ghc-options: -Wall -O2 -rtsopts+ if flag(local-aeson)+ build-depends:+ aeson-benchmarks,+ base,+ base-compat,+ bytestring,+ criterion >= 1.0,+ deepseq,+ ghc-prim,+ text+ else+ -- Disabled because of inaccessible internals+ buildable: False+ executable aeson-benchmark-compare+ default-language: Haskell2010 main-is: Compare.hs hs-source-dirs: ../examples . ghc-options: -Wall -O2 -rtsopts@@ -118,6 +171,7 @@ text executable aeson-benchmark-micro+ default-language: Haskell2010 main-is: Micro.hs hs-source-dirs: ../examples . ghc-options: -Wall -O2 -rtsopts@@ -132,12 +186,10 @@ text executable aeson-benchmark-typed+ default-language: Haskell2010 main-is: Typed.hs hs-source-dirs: ../examples . ghc-options: -Wall -O2 -rtsopts- -- We must help ourself in situations when there is both- -- aeson and aeson-benchmakrs- cpp-options: -DHAS_BOTH_AESON_AND_BENCHMARKS other-modules: Twitter Twitter.Generic@@ -149,7 +201,6 @@ Typed.Manual Typed.TH build-depends:- aeson, aeson-benchmarks, base, base-compat,@@ -166,11 +217,10 @@ build-depends: bytestring >= 0.10.4 executable aeson-benchmark-compare-with-json+ default-language: Haskell2010 main-is: CompareWithJSON.hs ghc-options: -Wall -O2 -rtsopts- cpp-options: -DHAS_BOTH_AESON_AND_BENCHMARKS build-depends:- aeson, aeson-benchmarks, base, base-compat,@@ -182,6 +232,7 @@ text executable aeson-benchmark-aeson-encode+ default-language: Haskell2010 main-is: AesonEncode.hs ghc-options: -Wall -O2 -rtsopts build-depends:@@ -194,6 +245,7 @@ time executable aeson-benchmark-aeson-parse+ default-language: Haskell2010 main-is: AesonParse.hs ghc-options: -Wall -O2 -rtsopts build-depends:@@ -205,6 +257,7 @@ time executable aeson-benchmark-json-parse+ default-language: Haskell2010 main-is: JsonParse.hs ghc-options: -Wall -O2 -rtsopts build-depends:@@ -215,6 +268,7 @@ time executable aeson-benchmark-dates+ default-language: Haskell2010 main-is: Dates.hs ghc-options: -Wall -O2 -rtsopts build-depends:@@ -226,12 +280,14 @@ aeson-benchmarks, text, time+ if impl(ghc >= 8.2)+ ghc-options: -Wno-simplifiable-class-constraints executable aeson-benchmark-map+ default-language: Haskell2010 main-is: AesonMap.hs ghc-options: -Wall -O2 -rtsopts build-depends:- aeson, aeson-benchmarks, base, base-compat,@@ -245,10 +301,10 @@ unordered-containers executable aeson-benchmark-foldable+ default-language: Haskell2010 main-is: AesonFoldable.hs ghc-options: -Wall -O2 -rtsopts build-depends:- aeson, aeson-benchmarks, base, base-compat,
changelog.md view
@@ -1,8 +1,23 @@ 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.3.0.0++Breaking changes:+* `GKeyValue` has been renamed to `KeyValuePair`, thanks to Xia Li-yao+* Removed unused `FromJSON` constraint in `withEmbeddedJson`, thanks to Tristan Seligmann++Other improvements:+* Optimizations of TH toEncoding, thanks to Xia Li-yao+* Optimizations of hex decoding when using the default/pure unescape implementation, thanks to Xia Li-yao+* Improved error message on `Day` parse failures, thanks to Gershom Bazerman+* Add `encodeFile` as well as `decodeFile*` variants, thanks to Markus Hauck+* Documentation fixes, thanks to Lennart Spitzner+* CPP cleanup, thanks to Ryan Scott+ ### 1.2.4.0 * Add `Ord` instance for `JSONPathElement`, thanks to Simon Hengel.+ ### 1.2.3.0
examples/Twitter.hs view
@@ -27,7 +27,6 @@ import Data.Int (Int64) import Data.Text (Text) import GHC.Generics (Generic)-import Prelude hiding (id) {-# ANN module "Hlint: ignore Use camelCase" #-} {-# ANN module "Hlint: ignore Use newtype instead of data" #-}
examples/Twitter/Generic.hs view
@@ -1,12 +1,7 @@ -- Use GHC generics to automatically generate good instances. -{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -#ifdef HAS_BOTH_AESON_AND_BENCHMARKS-{-# LANGUAGE PackageImports #-}-#endif- module Twitter.Generic ( Metadata(..)@@ -21,12 +16,7 @@ import Twitter import Twitter.Options -#ifndef HAS_BOTH_AESON_AND_BENCHMARKS import Data.Aeson (ToJSON (..), FromJSON (..), genericToJSON, genericToEncoding, genericParseJSON)-#else-import "aeson" Data.Aeson (ToJSON (..), FromJSON (..), genericToJSON, genericToEncoding, genericParseJSON)-import qualified "aeson-benchmarks" Data.Aeson as B-#endif instance ToJSON Metadata where toJSON = genericToJSON twitterOptions@@ -51,29 +41,3 @@ toEncoding = genericToEncoding twitterOptions instance FromJSON Result where parseJSON = genericParseJSON twitterOptions--#ifdef HAS_BOTH_AESON_AND_BENCHMARKS-instance B.ToJSON Metadata where- toJSON = B.genericToJSON btwitterOptions- toEncoding = B.genericToEncoding btwitterOptions-instance B.FromJSON Metadata where- parseJSON = B.genericParseJSON btwitterOptions--instance B.ToJSON Geo where- toJSON = B.genericToJSON btwitterOptions- toEncoding = B.genericToEncoding btwitterOptions-instance B.FromJSON Geo where- parseJSON = B.genericParseJSON btwitterOptions--instance B.ToJSON Story where- toJSON = B.genericToJSON btwitterOptions- toEncoding = B.genericToEncoding btwitterOptions-instance B.FromJSON Story where- parseJSON = B.genericParseJSON btwitterOptions--instance B.ToJSON Result where- toJSON = B.genericToJSON btwitterOptions- toEncoding = B.genericToEncoding btwitterOptions-instance B.FromJSON Result where- parseJSON = B.genericParseJSON btwitterOptions-#endif
examples/Twitter/Manual.hs view
@@ -1,14 +1,9 @@ -- Manually write instances. -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -#ifdef HAS_BOTH_AESON_AND_BENCHMARKS-{-# LANGUAGE PackageImports #-}-#endif- module Twitter.Manual ( Metadata(..)@@ -22,15 +17,9 @@ import Control.Applicative import Data.Monoid ((<>))-import Prelude hiding (id) import Twitter -#ifndef HAS_BOTH_AESON_AND_BENCHMARKS import Data.Aeson hiding (Result)-#else-import "aeson" Data.Aeson hiding (Result)-import qualified "aeson-benchmarks" Data.Aeson as B-#endif instance ToJSON Metadata where @@ -155,128 +144,3 @@ <*> v .: "max_id_str" <*> v .: "query" parseJSON _ = empty--#ifdef HAS_BOTH_AESON_AND_BENCHMARKS-instance B.ToJSON Metadata where- toJSON Metadata{..} = B.object [- "result_type" B..= result_type- ]-- toEncoding Metadata{..} = B.pairs $- "result_type" B..= result_type--instance B.FromJSON Metadata where- parseJSON (B.Object v) = Metadata <$> v B..: "result_type"- parseJSON _ = empty--instance B.ToJSON Geo where- toJSON Geo{..} = B.object [- "type_" B..= type_- , "coordinates" B..= coordinates- ]-- toEncoding Geo{..} = B.pairs $- "type_" B..= type_- <> "coordinates" B..= coordinates--instance B.FromJSON Geo where- parseJSON (B.Object v) = Geo <$>- v B..: "type_"- <*> v B..: "coordinates"- parseJSON _ = empty--instance B.ToJSON Story where- toJSON Story{..} = B.object [- "from_user_id_str" B..= from_user_id_str- , "profile_image_url" B..= profile_image_url- , "created_at" B..= created_at- , "from_user" B..= from_user- , "id_str" B..= id_str- , "metadata" B..= metadata- , "to_user_id" B..= to_user_id- , "text" B..= text- , "id" B..= id_- , "from_user_id" B..= from_user_id- , "geo" B..= geo- , "iso_language_code" B..= iso_language_code- , "to_user_id_str" B..= to_user_id_str- , "source" B..= source- ]-- toEncoding Story{..} = B.pairs $- "from_user_id_str" B..= from_user_id_str- <> "profile_image_url" B..= profile_image_url- <> "created_at" B..= created_at- <> "from_user" B..= from_user- <> "id_str" B..= id_str- <> "metadata" B..= metadata- <> "to_user_id" B..= to_user_id- <> "text" B..= text- <> "id" B..= id_- <> "from_user_id" B..= from_user_id- <> "geo" B..= geo- <> "iso_language_code" B..= iso_language_code- <> "to_user_id_str" B..= to_user_id_str- <> "source" B..= source--instance B.FromJSON Story where- parseJSON (B.Object v) = Story <$>- v B..: "from_user_id_str"- <*> v B..: "profile_image_url"- <*> v B..: "created_at"- <*> v B..: "from_user"- <*> v B..: "id_str"- <*> v B..: "metadata"- <*> v B..: "to_user_id"- <*> v B..: "text"- <*> v B..: "id"- <*> v B..: "from_user_id"- <*> v B..: "geo"- <*> v B..: "iso_language_code"- <*> v B..: "to_user_id_str"- <*> v B..: "source"- parseJSON _ = empty--instance B.ToJSON Result where- toJSON Result{..} = B.object [- "results" B..= results- , "max_id" B..= max_id- , "since_id" B..= since_id- , "refresh_url" B..= refresh_url- , "next_page" B..= next_page- , "results_per_page" B..= results_per_page- , "page" B..= page- , "completed_in" B..= completed_in- , "since_id_str" B..= since_id_str- , "max_id_str" B..= max_id_str- , "query" B..= query- ]-- toEncoding Result{..} = B.pairs $- "results" B..= results- <> "max_id" B..= max_id- <> "since_id" B..= since_id- <> "refresh_url" B..= refresh_url- <> "next_page" B..= next_page- <> "results_per_page" B..= results_per_page- <> "page" B..= page- <> "completed_in" B..= completed_in- <> "since_id_str" B..= since_id_str- <> "max_id_str" B..= max_id_str- <> "query" B..= query--instance B.FromJSON Result where- parseJSON (B.Object v) = Result <$>- v B..: "results"- <*> v B..: "max_id"- <*> v B..: "since_id"- <*> v B..: "refresh_url"- <*> v B..: "next_page"- <*> v B..: "results_per_page"- <*> v B..: "page"- <*> v B..: "completed_in"- <*> v B..: "since_id_str"- <*> v B..: "max_id_str"- <*> v B..: "query"- parseJSON _ = empty-#endif
examples/Twitter/Options.hs view
@@ -1,20 +1,6 @@-{-# LANGUAGE CPP #-}--#ifdef HAS_BOTH_AESON_AND_BENCHMARKS-{-# LANGUAGE PackageImports #-}-#endif- module Twitter.Options (module Twitter.Options) where -#ifndef HAS_BOTH_AESON_AND_BENCHMARKS import Data.Aeson-import Data.Aeson.Types-#else-import "aeson" Data.Aeson-import "aeson" Data.Aeson.Types-import qualified "aeson-benchmarks" Data.Aeson as B-import qualified "aeson-benchmarks" Data.Aeson.Types as B-#endif twitterOptions :: Options twitterOptions = defaultOptions@@ -22,12 +8,3 @@ "id_" -> "id" _ -> x }--#ifdef HAS_BOTH_AESON_AND_BENCHMARKS-btwitterOptions :: B.Options-btwitterOptions = B.defaultOptions- { B.fieldLabelModifier = \x -> case x of- "id_" -> "id"- _ -> x- }-#endif
examples/Twitter/TH.hs view
@@ -1,13 +1,8 @@ -- Use Template Haskell to generate good instances. -{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -#ifdef HAS_BOTH_AESON_AND_BENCHMARKS-{-# LANGUAGE PackageImports #-}-#endif- module Twitter.TH ( Metadata(..)@@ -21,21 +16,9 @@ import Twitter import Twitter.Options -#ifndef HAS_BOTH_AESON_AND_BENCHMARKS import Data.Aeson.TH-#else-import "aeson" Data.Aeson.TH-import qualified "aeson-benchmarks" Data.Aeson.TH as B-#endif $(deriveJSON twitterOptions ''Metadata) $(deriveJSON twitterOptions ''Geo) $(deriveJSON twitterOptions ''Story) $(deriveJSON twitterOptions ''Result)--#ifdef HAS_BOTH_AESON_AND_BENCHMARKS-$(B.deriveJSON btwitterOptions ''Metadata)-$(B.deriveJSON btwitterOptions ''Geo)-$(B.deriveJSON btwitterOptions ''Story)-$(B.deriveJSON btwitterOptions ''Result)-#endif
ffi/Data/Aeson/Parser/UnescapeFFI.hs view
@@ -10,7 +10,7 @@ import Control.Exception (evaluate, throw, try) import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO) import Data.ByteString as B-import Data.ByteString.Internal as B hiding (c2w)+import Data.ByteString.Internal as B import Data.Text.Encoding.Error (UnicodeException (..)) import Data.Text.Internal (Text (..)) import Data.Text.Internal.Private (runText)
pure/Data/Aeson/Parser/UnescapePure.hs view
@@ -120,29 +120,11 @@ _ -> throwDecodeError decodeHex :: Word8 -> Word16-decodeHex 48 = 0 -- '0'-decodeHex 49 = 1 -- '1'-decodeHex 50 = 2 -- '2'-decodeHex 51 = 3 -- '3'-decodeHex 52 = 4 -- '4'-decodeHex 53 = 5 -- '5'-decodeHex 54 = 6 -- '6'-decodeHex 55 = 7 -- '7'-decodeHex 56 = 8 -- '8'-decodeHex 57 = 9 -- '9'-decodeHex 65 = 10 -- 'A'-decodeHex 97 = 10 -- 'a'-decodeHex 66 = 11 -- 'B'-decodeHex 98 = 11 -- 'b'-decodeHex 67 = 12 -- 'C'-decodeHex 99 = 12 -- 'c'-decodeHex 68 = 13 -- 'D'-decodeHex 100 = 13 -- 'd'-decodeHex 69 = 14 -- 'E'-decodeHex 101 = 14 -- 'e'-decodeHex 70 = 15 -- 'F'-decodeHex 102 = 15 -- 'f'-decodeHex _ = throwDecodeError+decodeHex x+ | 48 <= x && x <= 57 = fromIntegral x - 48 -- 0-9+ | 65 <= x && x <= 70 = fromIntegral x - 55 -- A-F+ | 97 <= x && x <= 102 = fromIntegral x - 87 -- a-f+ | otherwise = throwDecodeError unescapeText' :: ByteString -> Text unescapeText' bs = runText $ \done -> do
stack-bench.yaml view
@@ -1,4 +1,4 @@-resolver: lts-8.5+resolver: nightly-2017-12-23 # We use aeson in the snapshot to # - avoid recompilation of criterion # - compare against it@@ -10,6 +10,5 @@ packages: - benchmarks extra-deps:-- aeson-1.2.1.0-- quickcheck-instances-0.3.14-- th-abstraction-0.2.2.0+- aeson-1.2.3.0+- text-1.2.3.0
stack-ffi-unescape.yaml view
@@ -1,7 +1,9 @@-resolver: nightly-2017-09-04+resolver: lts-10.0 packages: - '.' flags: aeson: fast: true cffi: true+extra-deps:+- text-1.2.3.0
+ stack-lts10.yaml view
@@ -0,0 +1,9 @@+resolver: lts-10.0+packages:+- '.'+flags:+ aeson:+ fast: true+ cffi: false+ attoparsec-iso8601:+ fast: true
stack-lts6.yaml view
@@ -1,4 +1,4 @@-resolver: lts-6.30+resolver: lts-6.35 packages: - '.' - attoparsec-iso8601
stack-lts7.yaml view
@@ -1,4 +1,4 @@-resolver: lts-7.19+resolver: lts-7.24 packages: - '.' - attoparsec-iso8601
stack-lts8.yaml view
@@ -1,4 +1,4 @@-resolver: lts-8.5+resolver: lts-8.24 packages: - '.' - attoparsec-iso8601
stack-lts9.yaml view
@@ -1,4 +1,4 @@-resolver: lts-9.3+resolver: lts-9.9 packages: - '.' - attoparsec-iso8601
stack-nightly.yaml view
@@ -1,4 +1,4 @@-resolver: nightly-2017-09-04+resolver: nightly-2018-03-07 packages: - '.' - attoparsec-iso8601