{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Vector.Binary (
genericGetVector
, genericGetVectorWith
, genericPutVector
, genericPutVectorWith
) where
import Data.Binary
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 System.IO.Unsafe
import Foreign.Storable (Storable)
instance Binary a => Binary (Vector a) where
put :: Vector a -> Put
put = forall (v :: * -> *) a. (Vector v a, Binary a) => v a -> Put
genericPutVector
get :: Get (Vector a)
get = forall (v :: * -> *) a. (Vector v a, Binary a) => Get (v a)
genericGetVector
{-# INLINE get #-}
instance (U.Unbox a, Binary a) => Binary (U.Vector a) where
put :: Vector a -> Put
put = forall (v :: * -> *) a. (Vector v a, Binary a) => v a -> Put
genericPutVector
get :: Get (Vector a)
get = forall (v :: * -> *) a. (Vector v a, Binary a) => Get (v a)
genericGetVector
{-# INLINE get #-}
instance (P.Prim a, Binary a) => Binary (P.Vector a) where
put :: Vector a -> Put
put = forall (v :: * -> *) a. (Vector v a, Binary a) => v a -> Put
genericPutVector
get :: Get (Vector a)
get = forall (v :: * -> *) a. (Vector v a, Binary a) => Get (v a)
genericGetVector
{-# INLINE get #-}
instance (Storable a, Binary a) => Binary (S.Vector a) where
put :: Vector a -> Put
put = forall (v :: * -> *) a. (Vector v a, Binary a) => v a -> Put
genericPutVector
get :: Get (Vector a)
get = forall (v :: * -> *) a. (Vector v a, Binary a) => Get (v a)
genericGetVector
{-# INLINE get #-}
genericGetVectorWith :: G.Vector v a
=> Get Int
-> Get a
-> Get (v a)
{-# INLINE genericGetVectorWith #-}
genericGetVectorWith :: forall (v :: * -> *) a. Vector v a => Get Int -> Get a -> Get (v a)
genericGetVectorWith Get Int
getN Get a
getA = do
Int
n <- Get Int
getN
Mutable v RealWorld a
v <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
GM.unsafeNew Int
n
let go :: Int -> Get ()
go Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
go Int
i = do a
x <- Get a
getA
() <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
GM.unsafeWrite Mutable v RealWorld a
v (Int
nforall a. Num a => a -> a -> a
-Int
i) a
x
Int -> Get ()
go (Int
iforall a. Num a => a -> a -> a
-Int
1)
() <- Int -> Get ()
go Int
n
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
G.unsafeFreeze Mutable v RealWorld a
v
genericPutVectorWith :: G.Vector v a
=> (Int -> Put)
-> (a -> Put)
-> v a -> Put
{-# INLINE genericPutVectorWith #-}
genericPutVectorWith :: forall (v :: * -> *) a.
Vector v a =>
(Int -> Put) -> (a -> Put) -> v a -> Put
genericPutVectorWith Int -> Put
putN a -> Put
putA v a
v = do
Int -> Put
putN (forall (v :: * -> *) a. Vector v a => v a -> Int
G.length v a
v)
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a) =>
(a -> m b) -> v a -> m ()
G.mapM_ a -> Put
putA v a
v
genericGetVector :: (G.Vector v a, Binary a) => Get (v a)
{-# INLINE genericGetVector #-}
genericGetVector :: forall (v :: * -> *) a. (Vector v a, Binary a) => Get (v a)
genericGetVector = forall (v :: * -> *) a. Vector v a => Get Int -> Get a -> Get (v a)
genericGetVectorWith forall t. Binary t => Get t
get forall t. Binary t => Get t
get
genericPutVector :: (G.Vector v a, Binary a) => v a -> Put
{-# INLINE genericPutVector #-}
genericPutVector :: forall (v :: * -> *) a. (Vector v a, Binary a) => v a -> Put
genericPutVector = forall (v :: * -> *) a.
Vector v a =>
(Int -> Put) -> (a -> Put) -> v a -> Put
genericPutVectorWith forall t. Binary t => t -> Put
put forall t. Binary t => t -> Put
put