af31dc9 · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

Backport lazyToStrictByteString for compatibility

af31dc9Ryan Scott10 years ago

Data/Aeson/Parser/Internal.hs+3−2

compare with master

unifiedsplit

@@ -48,6 +48,7 @@ import Data.Text.Internal.Unsafe.Char (ord)

48import Data.Vector as Vector (Vector, empty, fromList, reverse)

49import Data.Word (Word8)

50import Foreign.ForeignPtr (withForeignPtr)

51+import Foreign.Marshal.Utils (copyBytes)

51import Foreign.Ptr (Ptr, minusPtr, plusPtr)

52import Foreign.Ptr (Ptr, minusPtr, plusPtr)

52import Foreign.Storable (poke)

53import Foreign.Storable (poke)

53import System.IO.Unsafe (unsafePerformIO)

54import System.IO.Unsafe (unsafePerformIO)

@@ -261,7 +262,7 @@ unescape s = unsafePerformIO $ do

261 let newlen = p `minusPtr` ptr

262 let newlen = p `minusPtr` ptr

262 slop = len - newlen

263 slop = len - newlen

263 Right <$> if slop >= 128 && slop >= len `quot` 4

264 Right <$> if slop >= 128 && slop >= len `quot` 4

264− then B.create newlen $ \np -> B.memcpy np ptr newlen

265+ then B.create newlen $ \np -> copyBytes np ptr newlen

265 else return (PS fp 0 newlen)

266 else return (PS fp 0 newlen)

266 where

267 where

267 go ptr = do

268 go ptr = do

@@ -380,7 +381,7 @@ word8 w ptr = do

380copy :: ByteString -> Ptr Word8 -> Z.ZeptoT IO (Ptr Word8)

381copy :: ByteString -> Ptr Word8 -> Z.ZeptoT IO (Ptr Word8)

381copy (PS fp off len) ptr =

382copy (PS fp off len) ptr =

382 liftIO . withForeignPtr fp $ \src -> do

383 liftIO . withForeignPtr fp $ \src -> do

383− B.memcpy ptr (src `plusPtr` off) len

384+ copyBytes ptr (src `plusPtr` off) len

384 return $! ptr `plusPtr` len

385 return $! ptr `plusPtr` len

385

386

386charUtf8 :: Char -> Ptr Word8 -> Z.ZeptoT IO (Ptr Word8)

387charUtf8 :: Char -> Ptr Word8 -> Z.ZeptoT IO (Ptr Word8)

Data/Aeson/Types/ToJSON.hs+42−2

@@ -1,3 +1,4 @@

1+{-# LANGUAGE BangPatterns #-}

1{-# LANGUAGE CPP #-}

2{-# LANGUAGE CPP #-}

2{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE DefaultSignatures #-}

4{-# LANGUAGE DefaultSignatures #-}

@@ -96,6 +97,7 @@ import Foreign.Storable (Storable)

96import GHC.Generics

97import GHC.Generics

97import Numeric.Natural (Natural)

98import Numeric.Natural (Natural)

100+import qualified Data.ByteString as S

99import qualified Data.ByteString.Lazy as L

101import qualified Data.ByteString.Lazy as L

100import qualified Data.DList as DList

102import qualified Data.DList as DList

101import qualified Data.HashMap.Strict as H

103import qualified Data.HashMap.Strict as H

@@ -118,6 +120,15 @@ import qualified Data.Vector.Primitive as VP

118import qualified Data.Vector.Storable as VS

120import qualified Data.Vector.Storable as VS

119import qualified Data.Vector.Unboxed as VU

121import qualified Data.Vector.Unboxed as VU

120

122

123+#if !(MIN_VERSION_bytestring(0,10,0))

124+import Foreign.ForeignPtr (withForeignPtr)

125+import Foreign.Marshal.Utils (copyBytes)

126+import Foreign.Ptr (plusPtr)

127+

128+import qualified Data.ByteString.Internal as S

129+import qualified Data.ByteString.Lazy.Internal as L

130+#endif

131+

121toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value

132toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value

122toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b)

133toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b)

123{-# INLINE toJSONPair #-}

134{-# INLINE toJSONPair #-}

@@ -448,7 +459,11 @@ toJSONKeyTextEnc :: (a -> Encoding' Text) -> ToJSONKeyFunction a

448toJSONKeyTextEnc e = ToJSONKeyText tot e

459toJSONKeyTextEnc e = ToJSONKeyText tot e

449 where

460 where

450 -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm

461 -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm

462+ tot = T.dropAround (== '"')

463+ . T.decodeLatin1

464+ . lazyToStrictByteString

451− tot = T.dropAround (== '"') . T.decodeLatin1 . L.toStrict . E.encodingToLazyByteString . e

465+ . E.encodingToLazyByteString

466+ . e

452

467

453-- | Contravariant map, as 'ToJSONKeyFunction' is a contravariant functor.

468-- | Contravariant map, as 'ToJSONKeyFunction' is a contravariant functor.

454contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b

469contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b

@@ -1943,7 +1958,7 @@ stringEncoding :: Encoding' Text -> Value

1943stringEncoding = String

1958stringEncoding = String

1944 . T.dropAround (== '"')

1959 . T.dropAround (== '"')

1945 . T.decodeLatin1

1960 . T.decodeLatin1

1946− . L.toStrict

1961+ . lazyToStrictByteString

1947 . E.encodingToLazyByteString

1962 . E.encodingToLazyByteString

1948{-# INLINE stringEncoding #-}

1963{-# INLINE stringEncoding #-}

1949

1964

@@ -2583,3 +2598,28 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,

2583 {-# INLINE toJSON #-}

2598 {-# INLINE toJSON #-}

2584 toEncoding = toEncoding2

2599 toEncoding = toEncoding2

2585 {-# INLINE toEncoding #-}

2600 {-# INLINE toEncoding #-}

2601+

2602+-------------------------------------------------------------------------------

2603+-- pre-bytestring-0.10 compatibility

2604+-------------------------------------------------------------------------------

2605+

2606+{-# INLINE lazyToStrictByteString #-}

2607+lazyToStrictByteString :: L.ByteString -> S.ByteString

2608+#if MIN_VERSION_bytestring(0,10,0)

2609+lazyToStrictByteString = L.toStrict

2610+#else

2611+lazyToStrictByteString = packChunks

2612+

2613+-- packChunks is taken from the blaze-builder package.

2614+

2615+-- | Pack the chunks of a lazy bytestring into a single strict bytestring.

2616+packChunks :: L.ByteString -> S.ByteString

2617+packChunks lbs = do

2618+ S.unsafeCreate (fromIntegral $ L.length lbs) (copyChunks lbs)

2619+ where

2620+ copyChunks !L.Empty !_pf = return ()

2621+ copyChunks !(L.Chunk (S.PS fpbuf o l) lbs') !pf = do

2622+ withForeignPtr fpbuf $ \pbuf ->

2623+ copyBytes pf (pbuf `plusPtr` o) l

2624+ copyChunks lbs' (pf `plusPtr` l)

2625+#endif