diff --git a/Data/Aeson/Encode.hs b/Data/Aeson/Encode.hs --- a/Data/Aeson/Encode.hs +++ b/Data/Aeson/Encode.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, BangPatterns, OverloadedStrings #-} +{-# LANGUAGE BangPatterns, OverloadedStrings #-} -- | -- Module: Data.Aeson.Encode @@ -19,14 +19,9 @@ module Data.Aeson.Encode ( encode -#if MIN_VERSION_bytestring(0,10,4) -- * Encoding to Builders , encodeToByteStringBuilder , encodeToTextBuilder -#else - -- * Encoding to Text Builders - , encodeToTextBuilder -#endif -- * Deprecated , fromValue @@ -43,18 +38,7 @@ import qualified Data.Text as T import qualified Data.Vector as V -#if MIN_VERSION_bytestring(0,10,4) import Data.Aeson.Encode.ByteString (encode, encodeToByteStringBuilder) -#else -import Data.Aeson.Types (ToJSON(toJSON)) -import qualified Data.ByteString.Lazy as BL -import qualified Data.Text.Lazy.Builder as TLB -import qualified Data.Text.Lazy.Encoding as TLE - --- | Encode a JSON 'Value' as a UTF-8 encoded 'BL.ByteString'. -encode :: ToJSON a => a -> BL.ByteString -encode = TLE.encodeUtf8 . TLB.toLazyText . encodeToTextBuilder . toJSON -#endif -- | Encode a JSON 'Value' to a 'Builder', which can be embedded efficiently -- in a text-based protocol. diff --git a/Data/Aeson/Parser/Internal.hs b/Data/Aeson/Parser/Internal.hs --- a/Data/Aeson/Parser/Internal.hs +++ b/Data/Aeson/Parser/Internal.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, BangPatterns, OverloadedStrings #-} +{-# LANGUAGE BangPatterns, CPP, OverloadedStrings #-} -- | -- Module: Data.Aeson.Parser.Internal @@ -28,18 +28,8 @@ , eitherDecodeStrictWith ) where -#if defined(USE_BLAZE_BUILDER) -import Blaze.ByteString.Builder (Builder, fromByteString, toByteString) -import Blaze.ByteString.Builder.Char.Utf8 (fromChar) -import Blaze.ByteString.Builder.Word (fromWord8) -#else -#if MIN_VERSION_bytestring(0,10,2) import Data.ByteString.Builder -#else -import Data.ByteString.Lazy.Builder -#endif (Builder, byteString, toLazyByteString, charUtf8, word8) -#endif import Control.Applicative ((*>), (<$>), (<*), liftA2, pure) import Data.Aeson.Types (Result(..), Value(..)) @@ -133,7 +123,7 @@ commaSeparated :: Parser a -> Word8 -> Parser [a] commaSeparated item endByte = do - w <- peekWord8' + w <- A.peekWord8' if w == endByte then A.anyWord8 >> return [] else loop @@ -164,7 +154,7 @@ -- to preserve interoperability and security. value :: Parser Value value = do - w <- peekWord8' + w <- A.peekWord8' case w of DOUBLE_QUOTE -> A.anyWord8 *> (String <$> jstring_) OPEN_CURLY -> A.anyWord8 *> object_ @@ -179,7 +169,7 @@ -- | Strict version of 'value'. See also 'json''. value' :: Parser Value value' = do - w <- peekWord8' + w <- A.peekWord8' case w of DOUBLE_QUOTE -> do !s <- A.anyWord8 *> jstring_ @@ -331,28 +321,6 @@ jsonEOF' :: Parser Value jsonEOF' = json' <* skipSpace <* endOfInput -#if defined(USE_BLAZE_BUILDER) -byteString :: ByteString -> Builder -byteString = fromByteString -{-# INLINE byteString #-} - -charUtf8 :: Char -> Builder -charUtf8 = fromChar -{-# INLINE charUtf8 #-} - -word8 :: Word8 -> Builder -word8 = fromWord8 -{-# INLINE word8 #-} - -#else toByteString :: Builder -> ByteString toByteString = L.toStrict . toLazyByteString {-# INLINE toByteString #-} -#endif - -peekWord8' :: A.Parser Word8 -#if MIN_VERSION_attoparsec(0,11,1) -peekWord8' = A.peekWord8' -#else -peekWord8' = maybe (fail "not enough bytes") return =<< A.peekWord8 -#endif diff --git a/Data/Aeson/TH.hs b/Data/Aeson/TH.hs --- a/Data/Aeson/TH.hs +++ b/Data/Aeson/TH.hs @@ -103,10 +103,6 @@ import Prelude ( String, (-), Integer, fromIntegral, error ) import Text.Printf ( printf ) import Text.Show ( show ) -#if __GLASGOW_HASKELL__ < 700 -import Control.Monad ( (>>=), (>>) ) -import Prelude ( fromInteger ) -#endif -- from unordered-containers: import qualified Data.HashMap.Strict as H ( lookup, toList ) -- from template-haskell: @@ -876,7 +872,7 @@ applyCon :: Name -> [Name] -> Q [Pred] applyCon con typeNames = return (map apply typeNames) where apply t = -#if __GLASGOW_HASKELL__ >= 709 +#if MIN_VERSION_template_haskell(2,10,0) AppT (ConT con) (VarT t) #else ClassP con [VarT t] diff --git a/Data/Aeson/Types.hs b/Data/Aeson/Types.hs --- a/Data/Aeson/Types.hs +++ b/Data/Aeson/Types.hs @@ -60,6 +60,7 @@ -- * Generic and TH encoding configuration , Options(..) , SumEncoding(..) + , camelTo , defaultOptions , defaultTaggedObject ) where diff --git a/Data/Aeson/Types/Instances.hs b/Data/Aeson/Types/Instances.hs --- a/Data/Aeson/Types/Instances.hs +++ b/Data/Aeson/Types/Instances.hs @@ -497,8 +497,9 @@ parseJSON v = typeMismatch "ZonedTime" v instance ToJSON UTCTime where - toJSON t = String (pack (take 23 str ++ "Z")) - where str = formatTime defaultTimeLocale "%FT%T.%q" t + toJSON t = String $ pack $ formatTime defaultTimeLocale format t + where + format = "%FT%T." ++ formatMillis t ++ "Z" {-# INLINE toJSON #-} instance FromJSON UTCTime where @@ -556,7 +557,8 @@ return mv {-# INLINE toJSON #-} -instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSON (a,b,c,d) where +instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => + FromJSON (a,b,c,d) where parseJSON = withArray "(a,b,c,d)" $ \abcd -> let n = V.length abcd in if n == 4 @@ -568,7 +570,8 @@ show n ++ " into a 4-tuple" {-# INLINE parseJSON #-} -instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON (a,b,c,d,e) where +instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => + ToJSON (a,b,c,d,e) where toJSON (a,b,c,d,e) = Array $ V.create $ do mv <- VM.unsafeNew 5 VM.unsafeWrite mv 0 (toJSON a) @@ -579,7 +582,8 @@ return mv {-# INLINE toJSON #-} -instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) => FromJSON (a,b,c,d,e) where +instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) => + FromJSON (a,b,c,d,e) where parseJSON = withArray "(a,b,c,d,e)" $ \abcde -> let n = V.length abcde in if n == 5 @@ -592,7 +596,8 @@ show n ++ " into a 5-tuple" {-# INLINE parseJSON #-} -instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON (a,b,c,d,e,f) where +instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => + ToJSON (a,b,c,d,e,f) where toJSON (a,b,c,d,e,f) = Array $ V.create $ do mv <- VM.unsafeNew 6 VM.unsafeWrite mv 0 (toJSON a) @@ -604,7 +609,8 @@ return mv {-# INLINE toJSON #-} -instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f) => FromJSON (a,b,c,d,e,f) where +instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, + FromJSON f) => FromJSON (a,b,c,d,e,f) where parseJSON = withArray "(a,b,c,d,e,f)" $ \abcdef -> let n = V.length abcdef in if n == 6 @@ -618,7 +624,8 @@ show n ++ " into a 6-tuple" {-# INLINE parseJSON #-} -instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON (a,b,c,d,e,f,g) where +instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, + ToJSON g) => ToJSON (a,b,c,d,e,f,g) where toJSON (a,b,c,d,e,f,g) = Array $ V.create $ do mv <- VM.unsafeNew 7 VM.unsafeWrite mv 0 (toJSON a) @@ -631,7 +638,8 @@ return mv {-# INLINE toJSON #-} -instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g) => FromJSON (a,b,c,d,e,f,g) where +instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, + FromJSON f, FromJSON g) => FromJSON (a,b,c,d,e,f,g) where parseJSON = withArray "(a,b,c,d,e,f,g)" $ \abcdefg -> let n = V.length abcdefg in if n == 7 @@ -644,6 +652,348 @@ <*> parseJSON (V.unsafeIndex abcdefg 6) else fail $ "cannot unpack array of length " ++ show n ++ " into a 7-tuple" + {-# INLINE parseJSON #-} + +instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, + ToJSON g, ToJSON h) => ToJSON (a,b,c,d,e,f,g,h) where + toJSON (a,b,c,d,e,f,g,h) = Array $ V.create $ do + mv <- VM.unsafeNew 8 + VM.unsafeWrite mv 0 (toJSON a) + VM.unsafeWrite mv 1 (toJSON b) + VM.unsafeWrite mv 2 (toJSON c) + VM.unsafeWrite mv 3 (toJSON d) + VM.unsafeWrite mv 4 (toJSON e) + VM.unsafeWrite mv 5 (toJSON f) + VM.unsafeWrite mv 6 (toJSON g) + VM.unsafeWrite mv 7 (toJSON h) + return mv + {-# INLINE toJSON #-} + +instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, + FromJSON f, FromJSON g, FromJSON h) => + FromJSON (a,b,c,d,e,f,g,h) where + parseJSON = withArray "(a,b,c,d,e,f,g,h)" $ \ary -> + let n = V.length ary + in if n /= 8 + then fail $ "cannot unpack array of length " ++ + show n ++ " into an 8-tuple" + else (,,,,,,,) + <$> parseJSON (V.unsafeIndex ary 0) + <*> parseJSON (V.unsafeIndex ary 1) + <*> parseJSON (V.unsafeIndex ary 2) + <*> parseJSON (V.unsafeIndex ary 3) + <*> parseJSON (V.unsafeIndex ary 4) + <*> parseJSON (V.unsafeIndex ary 5) + <*> parseJSON (V.unsafeIndex ary 6) + <*> parseJSON (V.unsafeIndex ary 7) + {-# INLINE parseJSON #-} + +instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, + ToJSON g, ToJSON h, ToJSON i) => ToJSON (a,b,c,d,e,f,g,h,i) where + toJSON (a,b,c,d,e,f,g,h,i) = Array $ V.create $ do + mv <- VM.unsafeNew 9 + VM.unsafeWrite mv 0 (toJSON a) + VM.unsafeWrite mv 1 (toJSON b) + VM.unsafeWrite mv 2 (toJSON c) + VM.unsafeWrite mv 3 (toJSON d) + VM.unsafeWrite mv 4 (toJSON e) + VM.unsafeWrite mv 5 (toJSON f) + VM.unsafeWrite mv 6 (toJSON g) + VM.unsafeWrite mv 7 (toJSON h) + VM.unsafeWrite mv 8 (toJSON i) + return mv + {-# INLINE toJSON #-} + +instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, + FromJSON f, FromJSON g, FromJSON h, FromJSON i) => + FromJSON (a,b,c,d,e,f,g,h,i) where + parseJSON = withArray "(a,b,c,d,e,f,g,h,i)" $ \ary -> + let n = V.length ary + in if n /= 9 + then fail $ "cannot unpack array of length " ++ + show n ++ " into a 9-tuple" + else (,,,,,,,,) + <$> parseJSON (V.unsafeIndex ary 0) + <*> parseJSON (V.unsafeIndex ary 1) + <*> parseJSON (V.unsafeIndex ary 2) + <*> parseJSON (V.unsafeIndex ary 3) + <*> parseJSON (V.unsafeIndex ary 4) + <*> parseJSON (V.unsafeIndex ary 5) + <*> parseJSON (V.unsafeIndex ary 6) + <*> parseJSON (V.unsafeIndex ary 7) + <*> parseJSON (V.unsafeIndex ary 8) + {-# INLINE parseJSON #-} + +instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, + ToJSON g, ToJSON h, ToJSON i, ToJSON j) => + ToJSON (a,b,c,d,e,f,g,h,i,j) where + toJSON (a,b,c,d,e,f,g,h,i,j) = Array $ V.create $ do + mv <- VM.unsafeNew 10 + VM.unsafeWrite mv 0 (toJSON a) + VM.unsafeWrite mv 1 (toJSON b) + VM.unsafeWrite mv 2 (toJSON c) + VM.unsafeWrite mv 3 (toJSON d) + VM.unsafeWrite mv 4 (toJSON e) + VM.unsafeWrite mv 5 (toJSON f) + VM.unsafeWrite mv 6 (toJSON g) + VM.unsafeWrite mv 7 (toJSON h) + VM.unsafeWrite mv 8 (toJSON i) + VM.unsafeWrite mv 9 (toJSON j) + return mv + {-# INLINE toJSON #-} + +instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, + FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j) => + FromJSON (a,b,c,d,e,f,g,h,i,j) where + parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j)" $ \ary -> + let n = V.length ary + in if n /= 10 + then fail $ "cannot unpack array of length " ++ + show n ++ " into a 10-tuple" + else (,,,,,,,,,) + <$> parseJSON (V.unsafeIndex ary 0) + <*> parseJSON (V.unsafeIndex ary 1) + <*> parseJSON (V.unsafeIndex ary 2) + <*> parseJSON (V.unsafeIndex ary 3) + <*> parseJSON (V.unsafeIndex ary 4) + <*> parseJSON (V.unsafeIndex ary 5) + <*> parseJSON (V.unsafeIndex ary 6) + <*> parseJSON (V.unsafeIndex ary 7) + <*> parseJSON (V.unsafeIndex ary 8) + <*> parseJSON (V.unsafeIndex ary 9) + {-# INLINE parseJSON #-} + +instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, + ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) => + ToJSON (a,b,c,d,e,f,g,h,i,j,k) where + toJSON (a,b,c,d,e,f,g,h,i,j,k) = Array $ V.create $ do + mv <- VM.unsafeNew 11 + VM.unsafeWrite mv 0 (toJSON a) + VM.unsafeWrite mv 1 (toJSON b) + VM.unsafeWrite mv 2 (toJSON c) + VM.unsafeWrite mv 3 (toJSON d) + VM.unsafeWrite mv 4 (toJSON e) + VM.unsafeWrite mv 5 (toJSON f) + VM.unsafeWrite mv 6 (toJSON g) + VM.unsafeWrite mv 7 (toJSON h) + VM.unsafeWrite mv 8 (toJSON i) + VM.unsafeWrite mv 9 (toJSON j) + VM.unsafeWrite mv 10 (toJSON k) + return mv + {-# INLINE toJSON #-} + +instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, + FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, + FromJSON k) => + FromJSON (a,b,c,d,e,f,g,h,i,j,k) where + parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j,k)" $ \ary -> + let n = V.length ary + in if n /= 11 + then fail $ "cannot unpack array of length " ++ + show n ++ " into an 11-tuple" + else (,,,,,,,,,,) + <$> parseJSON (V.unsafeIndex ary 0) + <*> parseJSON (V.unsafeIndex ary 1) + <*> parseJSON (V.unsafeIndex ary 2) + <*> parseJSON (V.unsafeIndex ary 3) + <*> parseJSON (V.unsafeIndex ary 4) + <*> parseJSON (V.unsafeIndex ary 5) + <*> parseJSON (V.unsafeIndex ary 6) + <*> parseJSON (V.unsafeIndex ary 7) + <*> parseJSON (V.unsafeIndex ary 8) + <*> parseJSON (V.unsafeIndex ary 9) + <*> parseJSON (V.unsafeIndex ary 10) + {-# INLINE parseJSON #-} + +instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, + ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) => + ToJSON (a,b,c,d,e,f,g,h,i,j,k,l) where + toJSON (a,b,c,d,e,f,g,h,i,j,k,l) = Array $ V.create $ do + mv <- VM.unsafeNew 12 + VM.unsafeWrite mv 0 (toJSON a) + VM.unsafeWrite mv 1 (toJSON b) + VM.unsafeWrite mv 2 (toJSON c) + VM.unsafeWrite mv 3 (toJSON d) + VM.unsafeWrite mv 4 (toJSON e) + VM.unsafeWrite mv 5 (toJSON f) + VM.unsafeWrite mv 6 (toJSON g) + VM.unsafeWrite mv 7 (toJSON h) + VM.unsafeWrite mv 8 (toJSON i) + VM.unsafeWrite mv 9 (toJSON j) + VM.unsafeWrite mv 10 (toJSON k) + VM.unsafeWrite mv 11 (toJSON l) + return mv + {-# INLINE toJSON #-} + +instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, + FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, + FromJSON k, FromJSON l) => + FromJSON (a,b,c,d,e,f,g,h,i,j,k,l) where + parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j,k,l)" $ \ary -> + let n = V.length ary + in if n /= 12 + then fail $ "cannot unpack array of length " ++ + show n ++ " into a 12-tuple" + else (,,,,,,,,,,,) + <$> parseJSON (V.unsafeIndex ary 0) + <*> parseJSON (V.unsafeIndex ary 1) + <*> parseJSON (V.unsafeIndex ary 2) + <*> parseJSON (V.unsafeIndex ary 3) + <*> parseJSON (V.unsafeIndex ary 4) + <*> parseJSON (V.unsafeIndex ary 5) + <*> parseJSON (V.unsafeIndex ary 6) + <*> parseJSON (V.unsafeIndex ary 7) + <*> parseJSON (V.unsafeIndex ary 8) + <*> parseJSON (V.unsafeIndex ary 9) + <*> parseJSON (V.unsafeIndex ary 10) + <*> parseJSON (V.unsafeIndex ary 11) + {-# INLINE parseJSON #-} + +instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, + ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, + ToJSON m) => + ToJSON (a,b,c,d,e,f,g,h,i,j,k,l,m) where + toJSON (a,b,c,d,e,f,g,h,i,j,k,l,m) = Array $ V.create $ do + mv <- VM.unsafeNew 13 + VM.unsafeWrite mv 0 (toJSON a) + VM.unsafeWrite mv 1 (toJSON b) + VM.unsafeWrite mv 2 (toJSON c) + VM.unsafeWrite mv 3 (toJSON d) + VM.unsafeWrite mv 4 (toJSON e) + VM.unsafeWrite mv 5 (toJSON f) + VM.unsafeWrite mv 6 (toJSON g) + VM.unsafeWrite mv 7 (toJSON h) + VM.unsafeWrite mv 8 (toJSON i) + VM.unsafeWrite mv 9 (toJSON j) + VM.unsafeWrite mv 10 (toJSON k) + VM.unsafeWrite mv 11 (toJSON l) + VM.unsafeWrite mv 12 (toJSON m) + return mv + {-# INLINE toJSON #-} + +instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, + FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, + FromJSON k, FromJSON l, FromJSON m) => + FromJSON (a,b,c,d,e,f,g,h,i,j,k,l,m) where + parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j,k,l,m)" $ \ary -> + let n = V.length ary + in if n /= 13 + then fail $ "cannot unpack array of length " ++ + show n ++ " into a 13-tuple" + else (,,,,,,,,,,,,) + <$> parseJSON (V.unsafeIndex ary 0) + <*> parseJSON (V.unsafeIndex ary 1) + <*> parseJSON (V.unsafeIndex ary 2) + <*> parseJSON (V.unsafeIndex ary 3) + <*> parseJSON (V.unsafeIndex ary 4) + <*> parseJSON (V.unsafeIndex ary 5) + <*> parseJSON (V.unsafeIndex ary 6) + <*> parseJSON (V.unsafeIndex ary 7) + <*> parseJSON (V.unsafeIndex ary 8) + <*> parseJSON (V.unsafeIndex ary 9) + <*> parseJSON (V.unsafeIndex ary 10) + <*> parseJSON (V.unsafeIndex ary 11) + <*> parseJSON (V.unsafeIndex ary 12) + {-# INLINE parseJSON #-} + +instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, + ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, + ToJSON m, ToJSON n) => + ToJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where + toJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = Array $ V.create $ do + mv <- VM.unsafeNew 14 + VM.unsafeWrite mv 0 (toJSON a) + VM.unsafeWrite mv 1 (toJSON b) + VM.unsafeWrite mv 2 (toJSON c) + VM.unsafeWrite mv 3 (toJSON d) + VM.unsafeWrite mv 4 (toJSON e) + VM.unsafeWrite mv 5 (toJSON f) + VM.unsafeWrite mv 6 (toJSON g) + VM.unsafeWrite mv 7 (toJSON h) + VM.unsafeWrite mv 8 (toJSON i) + VM.unsafeWrite mv 9 (toJSON j) + VM.unsafeWrite mv 10 (toJSON k) + VM.unsafeWrite mv 11 (toJSON l) + VM.unsafeWrite mv 12 (toJSON m) + VM.unsafeWrite mv 13 (toJSON n) + return mv + {-# INLINE toJSON #-} + +instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, + FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, + FromJSON k, FromJSON l, FromJSON m, FromJSON n) => + FromJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where + parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j,k,l,m,n)" $ \ary -> + let n = V.length ary + in if n /= 14 + then fail $ "cannot unpack array of length " ++ + show n ++ " into a 14-tuple" + else (,,,,,,,,,,,,,) + <$> parseJSON (V.unsafeIndex ary 0) + <*> parseJSON (V.unsafeIndex ary 1) + <*> parseJSON (V.unsafeIndex ary 2) + <*> parseJSON (V.unsafeIndex ary 3) + <*> parseJSON (V.unsafeIndex ary 4) + <*> parseJSON (V.unsafeIndex ary 5) + <*> parseJSON (V.unsafeIndex ary 6) + <*> parseJSON (V.unsafeIndex ary 7) + <*> parseJSON (V.unsafeIndex ary 8) + <*> parseJSON (V.unsafeIndex ary 9) + <*> parseJSON (V.unsafeIndex ary 10) + <*> parseJSON (V.unsafeIndex ary 11) + <*> parseJSON (V.unsafeIndex ary 12) + <*> parseJSON (V.unsafeIndex ary 13) + {-# INLINE parseJSON #-} + +instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, + ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, + ToJSON m, ToJSON n, ToJSON o) => + ToJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where + toJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = Array $ V.create $ do + mv <- VM.unsafeNew 14 + VM.unsafeWrite mv 0 (toJSON a) + VM.unsafeWrite mv 1 (toJSON b) + VM.unsafeWrite mv 2 (toJSON c) + VM.unsafeWrite mv 3 (toJSON d) + VM.unsafeWrite mv 4 (toJSON e) + VM.unsafeWrite mv 5 (toJSON f) + VM.unsafeWrite mv 6 (toJSON g) + VM.unsafeWrite mv 7 (toJSON h) + VM.unsafeWrite mv 8 (toJSON i) + VM.unsafeWrite mv 9 (toJSON j) + VM.unsafeWrite mv 10 (toJSON k) + VM.unsafeWrite mv 11 (toJSON l) + VM.unsafeWrite mv 12 (toJSON m) + VM.unsafeWrite mv 13 (toJSON n) + VM.unsafeWrite mv 14 (toJSON o) + return mv + {-# INLINE toJSON #-} + +instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, + FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, + FromJSON k, FromJSON l, FromJSON m, FromJSON n, FromJSON o) => + FromJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where + parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)" $ \ary -> + let n = V.length ary + in if n /= 15 + then fail $ "cannot unpack array of length " ++ + show n ++ " into a 14-tuple" + else (,,,,,,,,,,,,,,) + <$> parseJSON (V.unsafeIndex ary 0) + <*> parseJSON (V.unsafeIndex ary 1) + <*> parseJSON (V.unsafeIndex ary 2) + <*> parseJSON (V.unsafeIndex ary 3) + <*> parseJSON (V.unsafeIndex ary 4) + <*> parseJSON (V.unsafeIndex ary 5) + <*> parseJSON (V.unsafeIndex ary 6) + <*> parseJSON (V.unsafeIndex ary 7) + <*> parseJSON (V.unsafeIndex ary 8) + <*> parseJSON (V.unsafeIndex ary 9) + <*> parseJSON (V.unsafeIndex ary 10) + <*> parseJSON (V.unsafeIndex ary 11) + <*> parseJSON (V.unsafeIndex ary 12) + <*> parseJSON (V.unsafeIndex ary 13) + <*> parseJSON (V.unsafeIndex ary 14) {-# INLINE parseJSON #-} instance ToJSON a => ToJSON (Dual a) where diff --git a/Data/Aeson/Types/Internal.hs b/Data/Aeson/Types/Internal.hs --- a/Data/Aeson/Types/Internal.hs +++ b/Data/Aeson/Types/Internal.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, DeriveDataTypeable, GeneralizedNewtypeDeriving, Rank2Types #-} +{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, Rank2Types #-} -- | -- Module: Data.Aeson.Types.Internal diff --git a/aeson.cabal b/aeson.cabal --- a/aeson.cabal +++ b/aeson.cabal @@ -1,5 +1,5 @@ name: aeson -version: 0.7.0.6 +version: 0.8.0.0 license: BSD3 license-file: LICENSE category: Text, Web, JSON @@ -8,7 +8,7 @@ author: Bryan O'Sullivan maintainer: Bryan O'Sullivan stability: experimental -tested-with: GHC == 7.0, GHC == 7.2, GHC == 7.4, GHC == 7.6 +tested-with: GHC == 7.4, GHC == 7.6, GHC == 7.8 synopsis: Fast JSON parsing and encoding cabal-version: >= 1.8 homepage: https://github.com/bos/aeson @@ -66,20 +66,13 @@ benchmarks/*.py benchmarks/Makefile benchmarks/json-data/*.json - changelog + changelog.md examples/*.hs flag developer description: operate in developer mode default: False - -flag blaze-builder - description: Use blaze-builder instead of bytestring >= 0.10 - default: False - -flag new-bytestring-builder - description: Use the new bytestring builder available in bytestring >= 0.10.4.0 - default: False + manual: True library exposed-modules: @@ -91,52 +84,39 @@ Data.Aeson.TH other-modules: + Data.Aeson.Encode.ByteString Data.Aeson.Functions Data.Aeson.Parser.Internal Data.Aeson.Types.Class + Data.Aeson.Types.Generic Data.Aeson.Types.Instances Data.Aeson.Types.Internal - if flag(new-bytestring-builder) - other-modules: Data.Aeson.Encode.ByteString - build-depends: bytestring >= 0.10.4.0, - text >= 1.1.0.0 - else - build-depends: bytestring < 0.10.4.0, - text >= 0.11.1.0 - - if impl(ghc >= 7.2.1) - cpp-options: -DGENERICS - build-depends: ghc-prim >= 0.2, dlist >= 0.2 - other-modules: - Data.Aeson.Types.Generic - build-depends: attoparsec >= 0.11.3.4, base == 4.*, + bytestring >= 0.10.4.0, containers, deepseq, + dlist >= 0.2, + ghc-prim >= 0.2, hashable >= 1.1.2.0, mtl, old-locale, scientific >= 0.3.1 && < 0.4, syb, template-haskell >= 2.4, + text >= 1.1.1.0, time, unordered-containers >= 0.2.3.0, vector >= 0.7.1 - if flag(blaze-builder) - build-depends: blaze-builder >= 0.2.1.4 - cpp-options: -DUSE_BLAZE_BUILDER - else - build-depends: bytestring >= 0.10 - if flag(developer) ghc-options: -Werror ghc-prof-options: -auto-all ghc-options: -O2 -Wall + cpp-options: -DGENERICS test-suite tests type: exitcode-stdio-1.0 @@ -150,30 +130,26 @@ Properties.Deprecated Types - ghc-options: - -Wall -threaded -rtsopts - if impl(ghc < 7.4) - ghc-options: -fcontext-stack=40 - if impl(ghc >= 7.2) - cpp-options: -DGHC_GENERICS + ghc-options: -Wall -threaded -rtsopts + cpp-options: -DGHC_GENERICS build-depends: + HUnit, QuickCheck, aeson, attoparsec, base, - containers, bytestring, + containers, + ghc-prim >= 0.2, template-haskell, test-framework, - test-framework-quickcheck2, test-framework-hunit, - HUnit, + test-framework-quickcheck2, text, time, unordered-containers, - vector, - ghc-prim >= 0.2 + vector source-repository head type: git diff --git a/benchmarks/AesonEncode.hs b/benchmarks/AesonEncode.hs --- a/benchmarks/AesonEncode.hs +++ b/benchmarks/AesonEncode.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns, CPP, OverloadedStrings #-} +{-# LANGUAGE BangPatterns, OverloadedStrings #-} import Control.Exception import Control.Monad @@ -10,16 +10,6 @@ import System.IO import qualified Data.ByteString as B import Control.DeepSeq - -#if !MIN_VERSION_bytestring(0,10,0) -import qualified Data.ByteString.Lazy.Internal as L - -instance NFData L.ByteString where - rnf = go - where go (L.Chunk _ cs) = go cs - go L.Empty = () - {-# INLINE rnf #-} -#endif main :: IO () main = do diff --git a/benchmarks/CompareWithJSON.hs b/benchmarks/CompareWithJSON.hs --- a/benchmarks/CompareWithJSON.hs +++ b/benchmarks/CompareWithJSON.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} import Blaze.ByteString.Builder (toLazyByteString) @@ -13,14 +12,6 @@ import qualified Data.Text.Lazy.Builder as TLB import qualified Data.Text.Lazy.Encoding as TLE -#if !MIN_VERSION_bytestring(0,10,0) -import qualified Data.ByteString.Lazy.Internal as BL - -instance NFData BL.ByteString where - rnf (BL.Chunk _ bs) = rnf bs - rnf BL.Empty = () -#endif - instance (NFData v) => NFData (J.JSObject v) where rnf o = rnf (J.fromJSObject o) @@ -46,13 +37,11 @@ encodeJ :: J.JSValue -> BL.ByteString encodeJ = toLazyByteString . fromString . J.encode -#if MIN_VERSION_bytestring(0,10,4) encodeToText :: A.Value -> TL.Text encodeToText = TLB.toLazyText . A.encodeToTextBuilder . A.toJSON encodeViaText :: A.Value -> BL.ByteString encodeViaText = TLE.encodeUtf8 . encodeToText -#endif main :: IO () main = do @@ -76,18 +65,14 @@ , bgroup "encode" [ bgroup "en" [ bench "aeson-to-bytestring" $ nf A.encode (decodeA enA) -#if MIN_VERSION_bytestring(0,10,4) , bench "aeson-via-text-to-bytestring" $ nf encodeViaText (decodeA enA) , bench "aeson-to-text" $ nf encodeToText (decodeA enA) -#endif , bench "json" $ nf encodeJ (decodeJ enJ) ] , bgroup "jp" [ bench "aeson-to-bytestring" $ nf A.encode (decodeA jpA) -#if MIN_VERSION_bytestring(0,10,4) , bench "aeson-via-text-to-bytestring" $ nf encodeViaText (decodeA jpA) , bench "aeson-to-text" $ nf encodeToText (decodeA jpA) -#endif , bench "json" $ nf encodeJ (decodeJ jpJ) ] ] diff --git a/changelog b/changelog deleted file mode 100644 --- a/changelog +++ /dev/null @@ -1,119 +0,0 @@ -0.7.0.0 - - * The performance of encoding to and decoding of bytestrings - have both improved by up to 2x, while also using less - memory. - - * New dependency: the scientific package lets us parse - floating point numbers more quickly and accurately. - - * eitherDecode, decodeStrictWith: fixed bugs. - - * Added FromJSON and ToJSON instances for Tree and Scientific. - - * Fixed the ToJSON instances for UTCTime and ZonedTime. - -0.6 series - - * Much improved documentation. - - * Angle brackets are now escaped in JSON strings, to help avoid XSS - attacks. - - * Fixed up handling of nullary constructors when using generic - encoding. - - * Added ToJSON/FromJSON instances for: - - * The Fixed class - * ISO-8601 dates: UTCTime, ZonedTime, and TimeZone - - * Added accessor functions for inspecting Values. - - * Added eitherDecode function that returns an error message if - decoding fails. - -0.5 to 0.6 - - * This release introduces a slightly obscure, but - backwards-incompatible, change. - - In the generic APIs of versions 0.4 and 0.5, fields whose - names began with a "_" character would have this character - removed. This no longer occurs, as it was both buggy and - surprising (https://github.com/bos/aeson/issues/53). - - * Fixed a bug in generic decoding of nullary constructors - (https://github.com/bos/aeson/issues/62). - -0.4 to 0.5 - - * When used with the UTF-8 encoding performance improvements - introduced in version 0.11.1.12 of the text package, this - release improves aeson's JSON encoding performance by 33% - relative to aeson 0.4. - - As part of achieving this improvement, an API change was - necessary. The fromValue function in the - Data.Aeson.Encode module now uses the text package's - Builder type instead of the blaze-builder package's - Builder type. - -0.3 to 0.4 - - * The new decode function complements the longstanding - encode function, and makes the API simpler. - - * New examples make it easier to learn to use the package - (https://github.com/bos/aeson/tree/master/examples). - - * Generics support - - aeson's support for data-type generic programming makes it - possible to use JSON encodings of most data types without - writing any boilerplate instances. - - Thanks to Bas Van Dijk, aeson now supports the two major - schemes for doing datatype-generic programming: - - * the modern mechanism, built into GHC itself - (http://www.haskell.org/ghc/docs/latest/html/users_guide/generic-programming.html) - - * the older mechanism, based on SYB (aka "scrap your - boilerplate") - - The modern GHC-based generic mechanism is fast and terse: in - fact, its performance is generally comparable in performance - to hand-written and TH-derived ToJSON and FromJSON - instances. To see how to use GHC generics, refer to - examples/Generic.hs. - - The SYB-based generics support lives in Data.Aeson.Generic - and is provided mainly for users of GHC older than 7.2. SYB - is far slower (by about 10x) than the more modern generic - mechanism. To see how to use SYB generics, refer to - examples/GenericSYB.hs. - - * We switched the intermediate representation of JSON objects - from Data.Map to Data.HashMap which has improved type - conversion performance. - - * Instances of ToJSON and FromJSON for tuples are between 45% - and 70% faster than in 0.3. - - * Evaluation control - - This version of aeson makes explicit the decoupling between - *identifying* an element of a JSON document and *converting* - it to Haskell. See the Data.Aeson.Parser documentation for - details. - - The normal aeson decode function performs identification - strictly, but defers conversion until needed. This can - result in improved performance (e.g. if the results of some - conversions are never needed), but at a cost in increased - memory consumption. - - The new decode' function performs identification and - conversion immediately. This incurs an up-front cost in CPU - cycles, but reduces reduce memory consumption. diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,125 @@ +0.8.0.0 + +* Add ToJSON and FromJSON instances for tuples of up to 15 elements. + +0.7.1.0 + +* Major compiler and library compatibility changes: we have dropped + support for GHC older than 7.4, text older than 1.1, and bytestring + older than 0.10.4.0. Supporting the older versions had become + increasingly difficult, to the point where it was no longer worth + it. + +0.7.0.0 + +* The performance of encoding to and decoding of bytestrings have both + improved by up to 2x, while also using less memory. + +* New dependency: the scientific package lets us parse floating point + numbers more quickly and accurately. + +* eitherDecode, decodeStrictWith: fixed bugs. + +* Added FromJSON and ToJSON instances for Tree and Scientific. + +* Fixed the ToJSON instances for UTCTime and ZonedTime. + +0.6 series + +* Much improved documentation. + +* Angle brackets are now escaped in JSON strings, to help avoid XSS + attacks. + +* Fixed up handling of nullary constructors when using generic + encoding. + +* Added ToJSON/FromJSON instances for: + + * The Fixed class + * ISO-8601 dates: UTCTime, ZonedTime, and TimeZone + +* Added accessor functions for inspecting Values. + +* Added eitherDecode function that returns an error message if + decoding fails. + +0.5 to 0.6 + +* This release introduces a slightly obscure, but + backwards-incompatible, change. + + In the generic APIs of versions 0.4 and 0.5, fields whose names + began with a "_" character would have this character removed. This + no longer occurs, as it was both buggy and surprising + (https://github.com/bos/aeson/issues/53). + +* Fixed a bug in generic decoding of nullary constructors + (https://github.com/bos/aeson/issues/62). + +0.4 to 0.5 + +* When used with the UTF-8 encoding performance improvements + introduced in version 0.11.1.12 of the text package, this release + improves aeson's JSON encoding performance by 33% relative to aeson + 0.4. + + As part of achieving this improvement, an API change was necessary. + The fromValue function in the Data.Aeson.Encode module now uses the + text package's Builder type instead of the blaze-builder package's + Builder type. + +0.3 to 0.4 + +* The new decode function complements the longstanding encode + function, and makes the API simpler. + +* New examples make it easier to learn to use the package + (https://github.com/bos/aeson/tree/master/examples). + +* Generics support + + aeson's support for data-type generic programming makes it possible + to use JSON encodings of most data types without writing any + boilerplate instances. + + Thanks to Bas Van Dijk, aeson now supports the two major schemes for + doing datatype-generic programming: + + * the modern mechanism, built into GHC itself + (http://www.haskell.org/ghc/docs/latest/html/users_guide/generic-programming.html) + + * the older mechanism, based on SYB (aka "scrap your + boilerplate") + + The modern GHC-based generic mechanism is fast and terse: in fact, + its performance is generally comparable in performance to + hand-written and TH-derived ToJSON and FromJSON instances. To see + how to use GHC generics, refer to examples/Generic.hs. + + The SYB-based generics support lives in Data.Aeson.Generic and is + provided mainly for users of GHC older than 7.2. SYB is far slower + (by about 10x) than the more modern generic mechanism. To see how + to use SYB generics, refer to examples/GenericSYB.hs. + +* We switched the intermediate representation of JSON objects from + Data.Map to Data.HashMap which has improved type conversion + performance. + +* Instances of ToJSON and FromJSON for tuples are between 45% and 70% + faster than in 0.3. + +* Evaluation control + + This version of aeson makes explicit the decoupling between + *identifying* an element of a JSON document and *converting* it to + Haskell. See the Data.Aeson.Parser documentation for details. + + The normal aeson decode function performs identification strictly, + but defers conversion until needed. This can result in improved + performance (e.g. if the results of some conversions are never + needed), but at a cost in increased memory consumption. + + The new decode' function performs identification and conversion + immediately. This incurs an up-front cost in CPU cycles, but + reduces reduce memory consumption. diff --git a/examples/TemplateHaskell.hs b/examples/TemplateHaskell.hs --- a/examples/TemplateHaskell.hs +++ b/examples/TemplateHaskell.hs @@ -7,7 +7,7 @@ {-# LANGUAGE OverloadedStrings #-} import Data.Aeson (decode, encode) -import Data.Aeson.TH (deriveJSON) +import Data.Aeson.TH (deriveJSON, defaultOptions) import qualified Data.ByteString.Lazy.Char8 as BL data Coord = Coord { x :: Double, y :: Double } @@ -19,7 +19,7 @@ -- names of the type's fields. We don't want to transform them, so we -- use the identity function. -$(deriveJSON id ''Coord) +$(deriveJSON defaultOptions ''Coord) main :: IO () main = do diff --git a/tests/Properties.hs b/tests/Properties.hs --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -5,10 +5,11 @@ import Data.Aeson.Encode import Data.Aeson.Parser (value) import Data.Aeson.Types +import Data.Char (toUpper) import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.Framework.Providers.HUnit (testCase) -import Test.HUnit (assertFailure, assertEqual) +import Test.HUnit (Assertion, assertFailure, assertEqual) import Test.QuickCheck (Arbitrary(..)) import qualified Data.Vector as V import qualified Data.Attoparsec.Lazy as L @@ -28,13 +29,14 @@ import qualified Data.Map as Map #endif -{- -roundTripCaml :: String -> Bool -roundTripCaml s = s == (camlFrom '_' $ camlTo '_' s) + +roundTripCamel :: String -> Assertion +roundTripCamel name = assertEqual "" name (camelFrom '_' $ camelTo '_' name) where - camlFrom :: Char -> String -> String - camlFrom c = concatMap capitalize $ split c --} + camelFrom c s = let (p:ps) = split c s + in concat $ p : map capitalize ps + split c s = map L.unpack $ L.split c $ L.pack s + capitalize t = toUpper (head t) : tail t encodeDouble :: Double -> Double -> Bool encodeDouble num denom @@ -116,10 +118,11 @@ testProperty "encodeDouble" encodeDouble , testProperty "encodeInteger" encodeInteger ], - -- testGroup "camlCase" [ - -- testProperty "camlTo" $ roundTripCaml "AnApiMethod" - -- , testProperty "camlTo" $ roundTripCaml "anotherMethodType" - -- ], + testGroup "camelCase" [ + testCase "camelTo" $ roundTripCamel "aName" + , testCase "camelTo" $ roundTripCamel "another" + , testCase "camelTo" $ roundTripCamel "someOtherName" + ], testGroup "roundTrip" [ testProperty "Bool" $ roundTripEq True , testProperty "Double" $ roundTripEq (1 :: Approx Double)