module Data.ByteString.SuperBuffer
( SuperBuffer, withBuffer, appendBuffer, appendBufferT
)
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 size action =
bracket (newBuffer size) 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 size = SuperBuffer <$> ((,) <$> new_sbuf (fromIntegral size) <*> 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, size) <- readLocal
BS.unsafePackCStringFinalizer (coerce cstr) (fromIntegral size) (free cstr)
where
readLocal =
alloca $ \sizePtr ->
do cstr <- read_sbuf ptr sizePtr
size <- peek sizePtr
pure (cstr, size)
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 ()