git.iko.soy/typeable/aeson
on master help sign in
Backport lazyToStrictByteString for compatibility
commitaf31dc95e931d2a6a1a826556274bf811d1df578 authorRyan Scott <ryan.gl.scott@gmail.com> dateSat 25 Jun 2016, 15:20 (10 years ago) parentb2346d1
2 files changed+45−4
compare with master
unifiedsplit
Data/Aeson/Parser/Internal.hs+3−2 Data/Aeson/Types/ToJSON.hs+42−2
Data/Aeson/Parser/Internal.hs+3−2
@@ -48,6 +48,7 @@ import Data.Text.Internal.Unsafe.Char (ord)
4848import Data.Vector as Vector (Vector, empty, fromList, reverse)
4949import Data.Word (Word8)
5050import Foreign.ForeignPtr (withForeignPtr)
51+import Foreign.Marshal.Utils (copyBytes)
5152import Foreign.Ptr (Ptr, minusPtr, plusPtr)
5253import Foreign.Storable (poke)
5354import System.IO.Unsafe (unsafePerformIO)
@@ -261,7 +262,7 @@ unescape s = unsafePerformIO $ do
261262 let newlen = p `minusPtr` ptr
262263 slop = len - newlen
263264 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
265266 else return (PS fp 0 newlen)
266267 where
267268 go ptr = do
@@ -380,7 +381,7 @@ word8 w ptr = do
380381copy :: ByteString -> Ptr Word8 -> Z.ZeptoT IO (Ptr Word8)
381382copy (PS fp off len) ptr =
382383 liftIO . withForeignPtr fp $ \src -> do
383− B.memcpy ptr (src `plusPtr` off) len
384+ copyBytes ptr (src `plusPtr` off) len
384385 return $! ptr `plusPtr` len
385386
386387charUtf8 :: Char -> Ptr Word8 -> Z.ZeptoT IO (Ptr Word8)
Data/Aeson/Types/ToJSON.hs+42−2
@@ -1,3 +1,4 @@
1+{-# LANGUAGE BangPatterns #-}
12{-# LANGUAGE CPP #-}
23{-# LANGUAGE DataKinds #-}
34{-# LANGUAGE DefaultSignatures #-}
@@ -96,6 +97,7 @@ import Foreign.Storable (Storable)
9697import GHC.Generics
9798import Numeric.Natural (Natural)
9899
100+import qualified Data.ByteString as S
99101import qualified Data.ByteString.Lazy as L
100102import qualified Data.DList as DList
101103import qualified Data.HashMap.Strict as H
@@ -118,6 +120,15 @@ import qualified Data.Vector.Primitive as VP
118120import qualified Data.Vector.Storable as VS
119121import qualified Data.Vector.Unboxed as VU
120122
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+
121132toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
122133toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b)
123134{-# INLINE toJSONPair #-}
@@ -448,7 +459,11 @@ toJSONKeyTextEnc :: (a -> Encoding' Text) -> ToJSONKeyFunction a
448459toJSONKeyTextEnc e = ToJSONKeyText tot e
449460 where
450461 -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
451− tot = T.dropAround (== '"') . T.decodeLatin1 . L.toStrict . E.encodingToLazyByteString . e
462+ tot = T.dropAround (== '"')
463+ . T.decodeLatin1
464+ . lazyToStrictByteString
465+ . E.encodingToLazyByteString
466+ . e
452467
453468-- | Contravariant map, as 'ToJSONKeyFunction' is a contravariant functor.
454469contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
@@ -1943,7 +1958,7 @@ stringEncoding :: Encoding' Text -> Value
19431958stringEncoding = String
19441959 . T.dropAround (== '"')
19451960 . T.decodeLatin1
1946− . L.toStrict
1961+ . lazyToStrictByteString
19471962 . E.encodingToLazyByteString
19481963{-# INLINE stringEncoding #-}
19491964
@@ -2583,3 +2598,28 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
25832598 {-# INLINE toJSON #-}
25842599 toEncoding = toEncoding2
25852600 {-# 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