{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Vector.Serial
( genericDeserializeVector
, genericDeserializeVectorWith
, genericSerializeVector
, genericSerializeVectorWith
) where
import Data.Bytes.Serial as Bytes
import Data.Bytes.Get as Bytes
import Data.Bytes.Put as Bytes
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Generic.Mutable as GM
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Storable as S
import qualified Data.Vector.Primitive as P
import Data.Vector (Vector)
import Foreign.Storable (Storable)
import System.IO.Unsafe
instance Bytes.Serial a => Bytes.Serial (Vector a) where
serialize = genericSerializeVector
deserialize = genericDeserializeVector
{-# INLINE deserialize #-}
instance (U.Unbox a, Bytes.Serial a) => Bytes.Serial (U.Vector a) where
serialize = genericSerializeVector
deserialize = genericDeserializeVector
{-# INLINE deserialize #-}
instance (P.Prim a, Bytes.Serial a) => Bytes.Serial (P.Vector a) where
serialize = genericSerializeVector
deserialize = genericDeserializeVector
{-# INLINE deserialize #-}
instance (Storable a, Bytes.Serial a) => Bytes.Serial (S.Vector a) where
serialize = genericSerializeVector
deserialize = genericDeserializeVector
{-# INLINE deserialize #-}
genericDeserializeVectorWith
:: (G.Vector v a, Bytes.Serial a, Bytes.MonadGet m)
=> m Int
-> m a
-> m (v a)
{-# INLINE genericDeserializeVectorWith #-}
genericDeserializeVectorWith deserializeN deserializeA = do
n <- deserializeN
v <- return $ unsafePerformIO $ GM.unsafeNew n
let go 0 = return ()
go i = do x <- deserializeA
() <- return $ unsafePerformIO $ GM.unsafeWrite v (n-i) x
go (i-1)
() <- go n
return $ unsafePerformIO $ G.unsafeFreeze v
genericSerializeVectorWith
:: (G.Vector v a, Bytes.Serial a, Bytes.MonadPut m)
=> (Int -> m ())
-> (a -> m ())
-> v a
-> m ()
{-# INLINE genericSerializeVectorWith #-}
genericSerializeVectorWith serializeN serializeA v = do
serializeN (G.length v)
G.mapM_ serializeA v
genericDeserializeVector
:: (G.Vector v a, Bytes.Serial a, Bytes.MonadGet m)
=> m (v a)
{-# INLINE genericDeserializeVector #-}
genericDeserializeVector = genericDeserializeVectorWith deserialize deserialize
genericSerializeVector
:: (G.Vector v a, Bytes.Serial a, Bytes.MonadPut m)
=> v a
-> m ()
{-# INLINE genericSerializeVector #-}
genericSerializeVector = genericSerializeVectorWith serialize serialize