cereal-vector 0.1.0.0 → 0.2.0.0

raw patch · 5 files changed

+181/−116 lines, 5 filesdep +QuickCheckdep +cereal-vectordep ~basedep ~bytestringdep ~cerealPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, cereal-vector

Dependency ranges changed: base, bytestring, cereal, vector

API changes (from Hackage documentation)

Files

• Data/Vector/Serialize.hs +54/−70
• Data/Vector/Storable/Serialize.hs +0/−41
• Data/Vector/Storable/UnsafeSerialize.hs +52/−0
• cereal-vector.cabal +20/−5
• test/test.hs +55/−0

@@ -1,94 +1,78 @@-{-# LANGUAGE CPP #-}--- #define TEST-#ifdef TEST-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TemplateHaskell #-}-#endif {-# OPTIONS_GHC -Wall -fno-warn-orphans #-}---- | 'Data.Serialize' functions for 'Data.Vector.Generic.Vector'--- vectors. Orphan instances are provided for 'Data.Vector' and--- 'Data.Vector.Primitive' vectors.+-- | "Data.Serialize" functions for "Data.Vector.Generic"+-- vectors. Orphan instances are provided for "Data.Vector",+-- "Data.Vector.Unboxed", "Data.Vector.Storable", and+-- "Data.Vector.Primitive" vectors. ----- Instances are /not/ provided for 'Data.Vector.Unbox' vectors, as--- they must be declared on an individual basis for each type the--- vectors may contain. The 'genericGet' and 'genericPut' functions--- should still work for these vectors without declaring instances.--- --- The serialized format is an 'Int64' representing the--- length of the 'Vector', followed by the serialized contents of each--- element.--- --- Note that the instances specialized for 'Data.Vector.Storable' are--- much more performant for storable vectors.-#ifndef TEST-module Data.Vector.Serialize (genericGetVector, genericPutVector) where-#endif+-- The serialized format is an 'Int64' representing the length of the+-- vector, followed by the "Data.Serialize"d contents of each element.+--+-- Note that the functions in "Data.Vector.Storable.UnsafeSerialize"+-- perform much better when serialization does not need to account for+-- host endianness and word size.+module Data.Vector.Serialize (+    genericGetVector+  , genericPutVector+  , genericGetVectorWith+  , genericPutVectorWith+  ) where  import Control.Monad  import Data.Int (Int64) import Data.Serialize (Get, Putter, Serialize(..))-import qualified Data.Vector as V+import qualified Data.Vector           as V import qualified Data.Vector.Primitive as VP-import qualified Data.Vector.Generic as VG--#ifdef TEST-import Data.Serialize (decode, encode)-import Data.Vector.Storable.Serialize ()-import qualified Data.Vector.Storable as VS-import qualified Data.Vector.Unboxed as VU-import Test.QuickCheck.All-#endif+import qualified Data.Vector.Unboxed   as VU+import qualified Data.Vector.Generic   as VG+import qualified Data.Vector.Storable  as VS --- | Read a 'Data.Vector.Generic.Vector'.-genericGetVector :: (Serialize a, VG.Vector v a) => Get (v a)-genericGetVector = do +-- | Read a 'Data.Vector.Generic.Vector' using custom 'Get' for the+-- vector's elements.+genericGetVectorWith :: (VG.Vector v a) => Get a -> Get (v a)+{-# INLINE genericGetVectorWith #-}+genericGetVectorWith getter = do   len64 <- get :: Get Int64   when (len64 > fromIntegral (maxBound :: Int)) $     fail "Host can't deserialize a Vector longer than (maxBound :: Int)"-  VG.replicateM (fromIntegral len64) get+  VG.replicateM (fromIntegral len64) getter +-- | Write a 'Data.Vector.Generic.Vector' using custom 'Putter' for+-- the vector's elements.+genericPutVectorWith :: (VG.Vector v a) => Putter a -> Putter (v a)+{-# INLINE genericPutVectorWith #-}+genericPutVectorWith putter v = do+  put ((fromIntegral $ VG.length v) :: Int64)+  VG.mapM_ putter v++ -- | Write a 'Data.Vector.Generic.Vector'. genericPutVector :: (Serialize a, VG.Vector v a) => Putter (v a)-genericPutVector v = do-  put ((fromIntegral $ VG.length v) :: Int64)-  VG.mapM_ put v+{-# INLINE genericPutVector #-}+genericPutVector = genericPutVectorWith put +-- | Read a 'Data.Vector.Generic.Vector'.+genericGetVector :: (Serialize a, VG.Vector v a) => Get (v a)+{-# INLINE genericGetVector #-}+genericGetVector = genericGetVectorWith get++ instance (Serialize a) => Serialize (V.Vector a) where   get = genericGetVector ; put = genericPutVector+  {-# INLINE get #-}+  {-# INLINE put #-}  instance (Serialize a, VP.Prim a) => Serialize (VP.Vector a) where   get = genericGetVector ; put = genericPutVector--#ifdef TEST-prop_vec :: [Int] -> Bool-prop_vec xs = Right xsv == decode (encode xsv)-  where xsv = V.fromList xs--prop_vec_tuple :: [[Int]] -> [Either [Bool] Double] -> Bool-prop_vec_tuple xs ys = Right (xsv, ysv) == decode (encode (xsv, ysv))-  where (xsv, ysv) = (V.fromList xs, V.fromList ys)--prop_prim :: [Int] -> Bool-prop_prim xs = Right xsv == decode (encode xsv)-  where xsv = VP.fromList xs+  {-# INLINE get #-}+  {-# INLINE put #-} -instance Serialize (VU.Vector Int) where+instance (Serialize a, VU.Unbox a) => Serialize (VU.Vector a) where   get = genericGetVector ; put = genericPutVector--prop_unbox :: [Int] -> Bool-prop_unbox xs = Right xsv == decode (encode xsv)-  where xsv = VU.fromList xs--prop_storable :: [Int] -> Bool-prop_storable xs = Right xsv == decode (encode xsv)-  where xsv = VS.fromList xs--prop_storable_tuple :: [Int64] -> [Double] -> Bool-prop_storable_tuple xs ys = Right (xsv, ysv) == decode (encode (xsv, ysv))-  where (xsv, ysv) = (VS.fromList xs, VS.fromList ys)+  {-# INLINE get #-}+  {-# INLINE put #-} -main :: IO ()-main = void $ $quickCheckAll-#endif+instance (Serialize a, VS.Storable a) => Serialize (VS.Vector a) where+  get = genericGetVector ; put = genericPutVector+  {-# INLINE get #-}+  {-# INLINE put #-}

@@ -1,41 +0,0 @@-{-# LANGUAGE CPP, ScopedTypeVariables #-}-{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}---- | Efficient 'Data.Serialize' instance for 'Data.Vector.Storable'--- vectors. The serialized format is an 'Int64' representing the--- length of the 'Vector', followed by the raw bytes.-module Data.Vector.Storable.Serialize () where--import Control.Monad (when)--import qualified Data.ByteString.Internal as BS-import Data.Int (Int64)-import Data.Serialize (Get, getBytes, putByteString, Serialize(..))-import Data.Vector.Storable ( unsafeFromForeignPtr0-                            , unsafeToForeignPtr0-                            , Vector)-import Data.Vector.Storable.Internal (updPtr)--import Foreign.ForeignPtr (castForeignPtr)-import Foreign.Marshal.Array (advancePtr)-import Foreign.Storable (Storable, sizeOf)--instance forall a. Storable a => Serialize (Vector a) where-  get = do -    len64 <- (get :: Get Int64)-    when (len64 > fromIntegral (maxBound :: Int)) $-      fail "Host can't deserialize a Vector longer than (maxBound :: Int)"-    let len    = fromIntegral len64-        nbytes = len * sizeOf (undefined :: a)-    bs <- getBytes nbytes-    let (fp, off, _)    = BS.toForeignPtr bs-        fp' | off /= 0  = updPtr (`advancePtr` off) fp-            | otherwise = fp-    return $ unsafeFromForeignPtr0 (castForeignPtr fp') len--  put v = do-    let (fp, len) = unsafeToForeignPtr0 v-        nbytes    = (len * sizeOf (undefined :: a))-        bs        = BS.fromForeignPtr (castForeignPtr fp) 0 nbytes-    put ((fromIntegral len) :: Int64)-    putByteString bs

@@ -0,0 +1,52 @@+{-# LANGUAGE ScopedTypeVariables, Unsafe #-}+{-# OPTIONS_GHC -Wall #-}++-- | Efficient, but unsafe 'Get' and 'Putter' for+-- "Data.Vector.Storable" vectors. The serialized format is an 'Int64'+-- representing the length of the 'Vector', followed by the raw+-- bytes. Therefore behavior may be unpredictable if serialized data+-- is transferred between machines with different word size or+-- endianness.+module Data.Vector.Storable.UnsafeSerialize (+    unsafeGetVector+  , unsafePutVector+) where++import Control.Monad (when)++import qualified Data.ByteString.Internal as BS+import Data.Int (Int64)+import Data.Serialize (Get, getBytes, putByteString, Putter, Serialize(..))+import Data.Vector.Storable ( unsafeFromForeignPtr0+                            , unsafeToForeignPtr0+                            , Vector)+import Data.Vector.Storable.Internal (updPtr)++import Foreign.ForeignPtr (castForeignPtr)+import Foreign.Marshal.Array (advancePtr)+import Foreign.Storable (Storable, sizeOf)++-- | Get a 'Vector' in host order, endian form, and word width.+unsafeGetVector :: forall a. Storable a => Get (Vector a)+{-# INLINE unsafeGetVector #-}+unsafeGetVector = do +  len64 <- get :: Get Int64+  when (len64 > fromIntegral (maxBound :: Int)) $+    fail "Host can't deserialize a Vector longer than (maxBound :: Int)"+  let len    = fromIntegral len64+      nbytes = len * sizeOf (undefined :: a)+  bs <- getBytes nbytes+  let (fp, off, _)    = BS.toForeignPtr bs+      fp' | off /= 0  = updPtr (`advancePtr` off) fp+          | otherwise = fp+  return $ unsafeFromForeignPtr0 (castForeignPtr fp') len++-- | Put a 'Vector' in host order, endian form, and word width.+unsafePutVector :: forall a. Storable a => Putter (Vector a)+{-# INLINE unsafePutVector #-}+unsafePutVector v = do+  let (fp, len) = unsafeToForeignPtr0 v+      nbytes    = len * sizeOf (undefined :: a)+      bs        = BS.fromForeignPtr (castForeignPtr fp) 0 nbytes+  put (fromIntegral len :: Int64)+  putByteString bs

@@ -1,5 +1,5 @@ name:                cereal-vector-version:             0.1.0.0+version:             0.2.0.0 synopsis:            Serialize instances for Data.Vector types. homepage:            https://github.com/acfoltzer/cereal-vector bug-reports:         https://github.com/acfoltzer/cereal-vector/issues@@ -17,9 +17,24 @@   location: git://github.com/acfoltzer/cereal-vector.git  library-  exposed-modules:     Data.Vector.Serialize-                     , Data.Vector.Storable.Serialize+  exposed-modules:     Data.Vector.Serialize, +                       Data.Vector.Storable.UnsafeSerialize   build-depends:       base == 4.*-                     , vector == 0.9.*                     +                     , vector >= 0.9                      , cereal == 0.3.*-                     , bytestring == 0.9.*+                     , bytestring >= 0.9++test-suite test+  type:           exitcode-stdio-1.0+  hs-source-dirs: test+  main-is:        test.hs+  other-modules:++  ghc-options:+    -Wall -O2+  build-depends:+    base,+    vector,+    cereal,+    cereal-vector,+    QuickCheck

@@ -0,0 +1,55 @@+{-# LANGUAGE TemplateHaskell #-}+import Control.Monad++import Data.Int       (Int64)+import Data.Serialize (decode, encode, getTwoOf, putTwoOf, runGet, runPut)+import qualified Data.Vector           as V+import qualified Data.Vector.Primitive as VP+-- import qualified Data.Vector.Generic   as VG+import qualified Data.Vector.Storable  as VS+import qualified Data.Vector.Unboxed   as VU++import Test.QuickCheck.All++import Data.Vector.Serialize ()+import Data.Vector.Storable.UnsafeSerialize+++prop_vec :: [Int] -> Bool+prop_vec xs = Right xsv == decode (encode xsv)+  where xsv = V.fromList xs++prop_vec_tuple :: [[Int]] -> [Either [Bool] Double] -> Bool+prop_vec_tuple xs ys = Right (xsv, ysv) == decode (encode (xsv, ysv))+  where (xsv, ysv) = (V.fromList xs, V.fromList ys)++prop_prim :: [Int] -> Bool+prop_prim xs = Right xsv == decode (encode xsv)+  where xsv = VP.fromList xs++prop_unbox :: [Int] -> Bool+prop_unbox xs = Right xsv == decode (encode xsv)+  where xsv = VU.fromList xs++prop_storable :: [Int] -> Bool+prop_storable xs = Right xsv == decode (encode xsv)+  where xsv = VS.fromList xs++prop_storable_tuple :: [Int64] -> [Double] -> Bool+prop_storable_tuple xs ys = Right (xsv, ysv) == decode (encode (xsv, ysv))+  where (xsv, ysv) = (VS.fromList xs, VS.fromList ys)++prop_unsafe_storable :: [Int] -> Bool+prop_unsafe_storable xs = +    Right xsv == runGet unsafeGetVector (runPut $ unsafePutVector xsv)+  where xsv = VS.fromList xs++prop_unsafe_storable_tuple :: [Int64] -> [Double] -> Bool+prop_unsafe_storable_tuple xs ys = +    Right (xsv, ysv) == runGet getTuple (runPut $ putTuple (xsv, ysv))+  where (xsv, ysv) = (VS.fromList xs, VS.fromList ys)+        getTuple = getTwoOf unsafeGetVector unsafeGetVector+        putTuple = putTwoOf unsafePutVector unsafePutVector++main :: IO ()+main = void $ $quickCheckAll