module Network.Socket.BufferPool.Buffer (
newBufferPool
, withBufferPool
, mallocBS
, copy
) where
import qualified Data.ByteString as BS
import Data.ByteString.Internal (ByteString(..), memcpy)
import Data.ByteString.Unsafe (unsafeTake, unsafeDrop)
import Data.IORef (newIORef, readIORef, writeIORef)
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc (mallocBytes, finalizerFree)
import Foreign.Ptr (castPtr, plusPtr)
import Network.Socket.BufferPool.Types
newBufferPool :: Int -> Int -> IO BufferPool
newBufferPool :: Int -> Int -> IO BufferPool
newBufferPool Int
l Int
h = Int -> Int -> IORef ByteString -> BufferPool
BufferPool Int
l Int
h forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef ByteString
BS.empty
withBufferPool :: BufferPool -> (Buffer -> BufSize -> IO Int) -> IO ByteString
withBufferPool :: BufferPool -> (Buffer -> Int -> IO Int) -> IO ByteString
withBufferPool (BufferPool Int
l Int
h IORef ByteString
ref) Buffer -> Int -> IO Int
f = do
ByteString
buf0 <- forall a. IORef a -> IO a
readIORef IORef ByteString
ref
ByteString
buf <- if ByteString -> Int
BS.length ByteString
buf0 forall a. Ord a => a -> a -> Bool
>= Int
l then forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
buf0
else Int -> IO ByteString
mallocBS Int
h
Int
consumed <- ByteString -> (Buffer -> Int -> IO Int) -> IO Int
withForeignBuffer ByteString
buf Buffer -> Int -> IO Int
f
forall a. IORef a -> a -> IO ()
writeIORef IORef ByteString
ref forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
unsafeDrop Int
consumed ByteString
buf
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
unsafeTake Int
consumed ByteString
buf
withForeignBuffer :: ByteString -> (Buffer -> BufSize -> IO Int) -> IO Int
withForeignBuffer :: ByteString -> (Buffer -> Int -> IO Int) -> IO Int
withForeignBuffer (PS ForeignPtr Word8
ps Int
s Int
l) Buffer -> Int -> IO Int
f = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
ps forall a b. (a -> b) -> a -> b
$ \Buffer
p -> Buffer -> Int -> IO Int
f (forall a b. Ptr a -> Ptr b
castPtr Buffer
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) Int
l
{-# INLINE withForeignBuffer #-}
mallocBS :: Int -> IO ByteString
mallocBS :: Int -> IO ByteString
mallocBS Int
size = do
Buffer
ptr <- forall a. Int -> IO (Ptr a)
mallocBytes Int
size
ForeignPtr Word8
fptr <- forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr forall a. FinalizerPtr a
finalizerFree Buffer
ptr
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fptr Int
0 Int
size
{-# INLINE mallocBS #-}
copy :: Buffer -> ByteString -> IO Buffer
copy :: Buffer -> ByteString -> IO Buffer
copy Buffer
ptr (PS ForeignPtr Word8
fp Int
o Int
l) = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Buffer
p -> do
Buffer -> Buffer -> Int -> IO ()
memcpy Buffer
ptr (Buffer
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
o) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Buffer
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
l
{-# INLINE copy #-}