{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.ByteArray.Types
( ByteArrayAccess(..)
, ByteArray(..)
) where
import Foreign.Ptr
import Data.Monoid
#ifdef WITH_BYTESTRING_SUPPORT
import qualified Data.ByteString as Bytestring (length)
import qualified Data.ByteString.Internal as Bytestring
import Foreign.ForeignPtr (withForeignPtr)
#endif
import Data.Memory.PtrMethods (memCopy)
import Data.Proxy (Proxy(..))
import Data.Word (Word8)
import qualified Basement.Types.OffsetSize as Base
import qualified Basement.UArray as Base
import qualified Basement.String as Base (String, toBytes, Encoding(UTF8))
import qualified Basement.UArray.Mutable as BaseMutable (withMutablePtrHint)
import qualified Basement.Block as Block
import qualified Basement.Block.Mutable as Block
import Basement.Nat
import qualified Basement.Sized.Block as BlockN
import Prelude hiding (length)
class ByteArrayAccess ba where
length :: ba -> Int
withByteArray :: ba -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: ba -> Ptr p -> IO ()
copyByteArrayToPtr ba
a Ptr p
dst = forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray ba
a forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memCopy (forall a b. Ptr a -> Ptr b
castPtr Ptr p
dst) Ptr Word8
src (forall ba. ByteArrayAccess ba => ba -> Int
length ba
a)
class (Eq ba, Ord ba, Monoid ba, ByteArrayAccess ba) => ByteArray ba where
allocRet :: Int
-> (Ptr p -> IO a)
-> IO (a, ba)
#ifdef WITH_BYTESTRING_SUPPORT
instance ByteArrayAccess Bytestring.ByteString where
length :: ByteString -> Int
length = ByteString -> Int
Bytestring.length
withByteArray :: forall p a. ByteString -> (Ptr p -> IO a) -> IO a
withByteArray (Bytestring.PS ForeignPtr Word8
fptr Int
off Int
_) Ptr p -> IO a
f = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> Ptr p -> IO a
f forall a b. (a -> b) -> a -> b
$! (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off)
instance ByteArray Bytestring.ByteString where
allocRet :: forall p a. Int -> (Ptr p -> IO a) -> IO (a, ByteString)
allocRet Int
sz Ptr p -> IO a
f = do
ForeignPtr Word8
fptr <- forall a. Int -> IO (ForeignPtr a)
Bytestring.mallocByteString Int
sz
a
r <- forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr (Ptr p -> IO a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
r, ForeignPtr Word8 -> Int -> Int -> ByteString
Bytestring.PS ForeignPtr Word8
fptr Int
0 Int
sz)
#endif
#ifdef WITH_BASEMENT_SUPPORT
baseBlockRecastW8 :: Base.PrimType ty => Block.Block ty -> Block.Block Word8
baseBlockRecastW8 :: forall ty. PrimType ty => Block ty -> Block Word8
baseBlockRecastW8 = forall b a. PrimType b => Block a -> Block b
Block.unsafeCast
instance Base.PrimType ty => ByteArrayAccess (Block.Block ty) where
length :: Block ty -> Int
length Block ty
a = let Base.CountOf Int
i = forall ty. PrimType ty => Block ty -> CountOf ty
Block.length (forall ty. PrimType ty => Block ty -> Block Word8
baseBlockRecastW8 Block ty
a) in Int
i
withByteArray :: forall p a. Block ty -> (Ptr p -> IO a) -> IO a
withByteArray Block ty
a Ptr p -> IO a
f = forall (prim :: * -> *) ty a.
PrimMonad prim =>
Block ty -> (Ptr ty -> prim a) -> prim a
Block.withPtr (forall ty. PrimType ty => Block ty -> Block Word8
baseBlockRecastW8 Block ty
a) (Ptr p -> IO a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr)
copyByteArrayToPtr :: forall p. Block ty -> Ptr p -> IO ()
copyByteArrayToPtr Block ty
ba Ptr p
dst = do
MutableBlock Word8 RealWorld
mb <- forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
Block ty -> prim (MutableBlock ty (PrimState prim))
Block.unsafeThaw (forall ty. PrimType ty => Block ty -> Block Word8
baseBlockRecastW8 Block ty
ba)
forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MutableBlock ty (PrimState prim)
-> Offset ty -> Ptr ty -> CountOf ty -> prim ()
Block.copyToPtr MutableBlock Word8 RealWorld
mb Offset Word8
0 (forall a b. Ptr a -> Ptr b
castPtr Ptr p
dst) (forall ty. PrimType ty => Block ty -> CountOf ty
Block.length forall a b. (a -> b) -> a -> b
$ forall ty. PrimType ty => Block ty -> Block Word8
baseBlockRecastW8 Block ty
ba)
instance (KnownNat n, Base.PrimType ty, Base.Countable ty n) => ByteArrayAccess (BlockN.BlockN n ty) where
length :: BlockN n ty -> Int
length BlockN n ty
a = let Base.CountOf Int
i = forall (n :: Nat) ty. PrimType ty => BlockN n ty -> CountOf Word8
BlockN.lengthBytes BlockN n ty
a in Int
i
withByteArray :: forall p a. BlockN n ty -> (Ptr p -> IO a) -> IO a
withByteArray BlockN n ty
a Ptr p -> IO a
f = forall (prim :: * -> *) (n :: Nat) ty a.
(PrimMonad prim, KnownNat n) =>
BlockN n ty -> (Ptr ty -> prim a) -> prim a
BlockN.withPtr BlockN n ty
a (Ptr p -> IO a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr)
copyByteArrayToPtr :: forall p. BlockN n ty -> Ptr p -> IO ()
copyByteArrayToPtr BlockN n ty
bna = forall ba p. ByteArrayAccess ba => ba -> Ptr p -> IO ()
copyByteArrayToPtr (forall (n :: Nat) ty. BlockN n ty -> Block ty
BlockN.toBlock BlockN n ty
bna)
baseUarrayRecastW8 :: Base.PrimType ty => Base.UArray ty -> Base.UArray Word8
baseUarrayRecastW8 :: forall ty. PrimType ty => UArray ty -> UArray Word8
baseUarrayRecastW8 = forall a b. (PrimType a, PrimType b) => UArray a -> UArray b
Base.recast
instance Base.PrimType ty => ByteArrayAccess (Base.UArray ty) where
length :: UArray ty -> Int
length UArray ty
a = let Base.CountOf Int
i = forall ty. UArray ty -> CountOf ty
Base.length (forall ty. PrimType ty => UArray ty -> UArray Word8
baseUarrayRecastW8 UArray ty
a) in Int
i
withByteArray :: forall p a. UArray ty -> (Ptr p -> IO a) -> IO a
withByteArray UArray ty
a Ptr p -> IO a
f = forall ty (prim :: * -> *) a.
(PrimMonad prim, PrimType ty) =>
UArray ty -> (Ptr ty -> prim a) -> prim a
Base.withPtr (forall ty. PrimType ty => UArray ty -> UArray Word8
baseUarrayRecastW8 UArray ty
a) (Ptr p -> IO a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr)
copyByteArrayToPtr :: forall p. UArray ty -> Ptr p -> IO ()
copyByteArrayToPtr UArray ty
ba Ptr p
dst = forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
UArray ty -> Ptr ty -> prim ()
Base.copyToPtr UArray ty
ba (forall a b. Ptr a -> Ptr b
castPtr Ptr p
dst)
instance ByteArrayAccess Base.String where
length :: String -> Int
length String
str = let Base.CountOf Int
i = forall ty. UArray ty -> CountOf ty
Base.length UArray Word8
bytes in Int
i
where
bytes :: UArray Word8
bytes = Encoding -> String -> UArray Word8
Base.toBytes Encoding
Base.UTF8 String
str
withByteArray :: forall p a. String -> (Ptr p -> IO a) -> IO a
withByteArray String
s Ptr p -> IO a
f = forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray (Encoding -> String -> UArray Word8
Base.toBytes Encoding
Base.UTF8 String
s) Ptr p -> IO a
f
instance (Ord ty, Base.PrimType ty) => ByteArray (Block.Block ty) where
allocRet :: forall p a. Int -> (Ptr p -> IO a) -> IO (a, Block ty)
allocRet Int
sz Ptr p -> IO a
f = do
MutableBlock ty RealWorld
mba <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
Block.new forall a b. (a -> b) -> a -> b
$ forall ty. PrimType ty => Int -> Proxy ty -> CountOf ty
sizeRecastBytes Int
sz forall {k} (t :: k). Proxy t
Proxy
a
a <- forall ty (prim :: * -> *) a.
PrimMonad prim =>
Bool
-> Bool
-> MutableBlock ty (PrimState prim)
-> (Ptr ty -> prim a)
-> prim a
Block.withMutablePtrHint Bool
True Bool
False MutableBlock ty RealWorld
mba (Ptr p -> IO a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr)
Block ty
ba <- forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
Block.unsafeFreeze MutableBlock ty RealWorld
mba
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Block ty
ba)
instance (Ord ty, Base.PrimType ty) => ByteArray (Base.UArray ty) where
allocRet :: forall p a. Int -> (Ptr p -> IO a) -> IO (a, UArray ty)
allocRet Int
sz Ptr p -> IO a
f = do
MUArray ty RealWorld
mba <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MUArray ty (PrimState prim))
Base.new forall a b. (a -> b) -> a -> b
$ forall ty. PrimType ty => Int -> Proxy ty -> CountOf ty
sizeRecastBytes Int
sz forall {k} (t :: k). Proxy t
Proxy
a
a <- forall ty (prim :: * -> *) a.
(PrimMonad prim, PrimType ty) =>
Bool
-> Bool
-> MUArray ty (PrimState prim)
-> (Ptr ty -> prim a)
-> prim a
BaseMutable.withMutablePtrHint Bool
True Bool
False MUArray ty RealWorld
mba (Ptr p -> IO a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr)
UArray ty
ba <- forall (prim :: * -> *) ty.
PrimMonad prim =>
MUArray ty (PrimState prim) -> prim (UArray ty)
Base.unsafeFreeze MUArray ty RealWorld
mba
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, UArray ty
ba)
sizeRecastBytes :: Base.PrimType ty => Int -> Proxy ty -> Base.CountOf ty
sizeRecastBytes :: forall ty. PrimType ty => Int -> Proxy ty -> CountOf ty
sizeRecastBytes Int
w Proxy ty
p = forall ty. Int -> CountOf ty
Base.CountOf forall a b. (a -> b) -> a -> b
$
let (Int
q,Int
r) = Int
w forall a. Integral a => a -> a -> (a, a)
`Prelude.quotRem` Int
szTy
in Int
q forall a. Num a => a -> a -> a
+ (if Int
r forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Int
1)
where !(Base.CountOf Int
szTy) = forall ty. PrimType ty => Proxy ty -> CountOf Word8
Base.primSizeInBytes Proxy ty
p
{-# INLINE [1] sizeRecastBytes #-}
#endif