Add Serialize instance for Vector.Vector

Author:    ianandsingh <[email protected]>

benchmark/Main.hs

@@ -26,6 +26,7 @@ import qualified Data.Text as TextS
 import qualified Data.Text.Lazy as TextL
 import qualified Data.ByteString as StrictByteString
 import qualified Data.ByteString.Lazy as LazyByteString
+import qualified Data.Vector as Vector
 
 import Test.Tasty.Bench
 
@@ -175,13 +176,15 @@ main = do
     !strictByteString <- genStrictByteString 1000
     !lazyByteString <- genLazyByteString 20 50 -- 20 chunks of bytestring that
                                                -- are of length 50 each.
+    !vectorA <- genVectorA 1000
 
     -- Asserts
     unless (TextS.length strictText == 1000)
          (error "TextS.length strictText == 1000")
     unless (TextL.length lazyText == 1000)
          (error "TextL.length lazyText == 1000")
-
+    unless (Vector.length vectorA == 1000)
+         (error "Vector.length vectorA == 1000")
     unless (StrictByteString.length strictByteString == 1000)
          (error "StrictByteString.length strictByteString == 1000")
     unless (LazyByteString.length lazyByteString == 1000)
@@ -194,6 +197,7 @@ main = do
         , bencher "Lazy.Text" lazyText 100
         , bencher "Strict.ByteString" strictByteString 100
         , bencher "Lazy.ByteString" lazyByteString 100
+        , bencher "Vector" vectorA 100
         ]
 
     where
@@ -212,3 +216,8 @@ main = do
 
     genLazyByteString n m = do
         LazyByteString.fromChunks <$> replicateM n (genStrictByteString m)
+
+    genVectorA n = do
+        let genInt = generate (arbitrary :: Gen Int)
+        vectorA <- Vector.replicateM n genInt
+        return $ force vectorA

cabal.project.set-1

@@ -8,4 +8,5 @@ source-repository-package
 
 constraints:
      text == 1.2.5.0
-   , bytestring == 0.10.10.0
+   , bytestring == 0.10.10.0
+   , vector == 0.12.2.0

src/Streamly/Data/Serialize/Instances.hs

@@ -13,16 +13,21 @@ module Streamly.Data.Serialize.Instances () where
 --------------------------------------------------------------------------------
 
 import Data.Fixed (Fixed)
+import Data.Int (Int64)
 import Data.Maybe (fromJust)
+import Data.Proxy (Proxy (..))
 import Data.Scientific (Scientific)
 import Data.Time (Day, TimeOfDay, LocalTime, DiffTime, UTCTime)
 import Streamly.Data.Serialize.Instances.Text ()
 import Streamly.Data.Serialize.Instances.ByteString ()
 import Streamly.Internal.Data.Serialize (Serialize(..))
+import Streamly.Internal.Data.Unbox (MutableByteArray)
 
 import qualified Data.Aeson as Aeson
 import qualified Data.Vector as Vector
+import qualified Data.Vector.Mutable as MVector
 import qualified Streamly.Internal.Data.Serialize.TH as Serialize
+import qualified Streamly.Internal.Data.Unbox as Unbox
 
 --------------------------------------------------------------------------------
 -- Time
@@ -65,16 +70,40 @@ instance Serialize Aeson.Value where
 -- Vector.Vector
 --------------------------------------------------------------------------------
 
--- TODO: Serialize it independently
-
--- XXX Extremely inefficient serialization of Vector
 instance Serialize a => Serialize (Vector.Vector a) where
-    {-# INLINE size #-}
-    size i val = size i (Vector.toList val)
 
-    {-# INLINE deserialize #-}
-    deserialize off arr end =
-        fmap Vector.fromList <$> deserialize off arr end
+    {-# INLINE size #-}
+    size :: Int -> (Vector.Vector a) -> Int
+    size acc = Vector.foldl' size (acc + Unbox.sizeOf (Proxy :: Proxy Int64))
 
     {-# INLINE serialize #-}
-    serialize off arr val = serialize off arr (Vector.toList val)
+    serialize :: Int -> MutableByteArray -> (Vector.Vector a) -> IO Int
+    serialize off arr val = do
+        let len = Vector.length val
+        finalOffset <-
+            Vector.foldM'
+                (\curOff v -> serialize curOff arr v)
+                (off + Unbox.sizeOf (Proxy :: Proxy Int64))
+                val
+        Unbox.pokeByteIndex off arr ((fromIntegral :: Int -> Int64) len)
+        pure finalOffset
+
+    {-# INLINE deserialize #-}
+    deserialize :: Int -> MutableByteArray -> Int -> IO (Int, Vector.Vector a)
+    deserialize off arr s = do
+
+        (off1, len64) <- deserialize off arr s
+        let len = (fromIntegral :: Int64 -> Int) len64
+        val <- MVector.new len
+        (off2, val1) <- fillVector len 0 off1 val
+        val2 <- Vector.freeze val1
+        pure (off2, val2)
+
+        where
+
+        fillVector len acc off1 val
+            | acc >= len = pure (off1, val)
+            | otherwise = do
+                (off2, v) <- deserialize off1 arr s
+                MVector.write val acc v
+                fillVector len (acc + 1) off2 val

streamly-serialize-instances.cabal

@@ -118,7 +118,7 @@ library
                     , streamly-core  == 0.2.0.*
                     , text           >= 1.2      && < 2.1
                     , bytestring     >= 0.10.0   && < 0.13.0
-                    , vector
+                    , vector         >= 0.12     && < 0.14
                     , aeson
                     , time
                     , scientific
@@ -164,6 +164,7 @@ test-suite serialization-tests
        , time
        , text
        , bytestring     >= 0.10.0   && < 0.13.0
+       , vector
 
 benchmark serialization-benchmarks
     -- Import common warning flags.
@@ -201,3 +202,4 @@ benchmark serialization-benchmarks
        , text
        , QuickCheck
        , bytestring     >= 0.10.0   && < 0.13.0
+       , vector

test/Main.hs

@@ -23,6 +23,7 @@ import Data.Time (UTCTime)
 
 import qualified Data.Text as TextS
 import qualified Data.Text.Lazy as TextL
+import qualified Data.Vector as Vector
 
 import Data.ByteString as StrictByteString
 import Data.ByteString.Lazy as LazyByteString
@@ -92,6 +93,9 @@ testCases = do
     prop "Strict Text"
         $ \(x :: TextS.Text) -> roundtrip x
 
+    prop "Vector"
+        $ \(x :: Vector.Vector String) -> roundtrip x
+
     prop "Lazy Text"
         $ \(x :: TextL.Text) -> roundtrip x