module Data.ByteString.SuperBuffer
( SuperBuffer, withBuffer, appendBuffer, appendBufferT, size
)
where
import Control.Concurrent.MVar
import Control.Exception
import Data.Coerce
import Foreign
import Foreign.C
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BS
newtype SuperBuffer
= SuperBuffer (SuperBufferP, MVar ())
withBuffer :: Int64 -> (SuperBuffer -> IO ()) -> IO BS.ByteString
withBuffer sz action =
bracket (newBuffer sz) destroyBuffer $ \buf ->
do ok <- try (action buf)
case ok of
Left (exception :: SomeException) ->
do destroyBufferContents buf
throwIO exception
Right () ->
readBuffer buf
newBuffer :: Int64 -> IO SuperBuffer
newBuffer sz = SuperBuffer <$> ((,) <$> new_sbuf (fromIntegral sz) <*> newEmptyMVar)
appendBuffer :: SuperBuffer -> BS.ByteString -> IO ()
appendBuffer (SuperBuffer (ptr, _)) bs =
BS.unsafeUseAsCStringLen bs $ \(cstr, len) ->
append_sbuf ptr cstr (fromIntegral len)
appendBufferT :: SuperBuffer -> BS.ByteString -> IO ()
appendBufferT buf@(SuperBuffer (_, lock)) bs =
bracket_ (putMVar lock ()) (takeMVar lock) $
appendBuffer buf bs
destroyBuffer :: SuperBuffer -> IO ()
destroyBuffer (SuperBuffer (ptr, _)) = destroy_sbuf ptr
destroyBufferContents :: SuperBuffer -> IO ()
destroyBufferContents (SuperBuffer (ptr, _)) = destroyContents_sbuf ptr
readBuffer :: SuperBuffer -> IO BS.ByteString
readBuffer (SuperBuffer (ptr, _)) =
do (cstr, sz) <- readLocal
BS.unsafePackCStringFinalizer (coerce cstr) (fromIntegral sz) (free cstr)
where
readLocal =
alloca $ \sizePtr ->
do cstr <- read_sbuf ptr sizePtr
sz <- peek sizePtr
pure (cstr, sz)
size :: SuperBuffer -> IO Int
size (SuperBuffer (ptr, _)) =
fromIntegral <$> size_sbuf ptr
data SBuf
type SuperBufferP = Ptr SBuf
foreign import ccall unsafe "new_sbuf" new_sbuf :: CSize -> IO SuperBufferP
foreign import ccall unsafe "append_sbuf" append_sbuf :: SuperBufferP -> CString -> CSize -> IO ()
foreign import ccall unsafe "read_sbuf" read_sbuf :: SuperBufferP -> Ptr CSize -> IO CString
foreign import ccall unsafe "destroy_sbuf" destroy_sbuf :: SuperBufferP -> IO ()
foreign import ccall unsafe "destroyContents_sbuf" destroyContents_sbuf :: SuperBufferP -> IO ()
foreign import ccall unsafe "size_sbuf" size_sbuf :: SuperBufferP -> IO CSize