module Bind.Marshal.StdLib.Dynamic.ByteString.Lazy.Des ( decode
, decode_
, with_bytestring_provider
)
where
import Bind.Marshal.Prelude
import Bind.Marshal.Action
import Bind.Marshal.DesAction
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Internal as L
import qualified Data.ByteString as S
import qualified Data.ByteString.Internal as S
import Data.IORef
import System.IO.Unsafe ( unsafePerformIO )
import Foreign.Marshal.Array
import Foreign.Marshal.Alloc
import Foreign.Ptr
import GHC.Exts
import GHC.ForeignPtr ( ForeignPtr(..)
, mallocPlainForeignPtrBytes
, unsafeForeignPtrToPtr
, touchForeignPtr
)
import GHC.Prim
import System.IO
data LazyBSDes = LazyBSDes
{ bs :: !L.ByteString
, buffer :: !(Ptr Word8)
, buffer_size :: !Size
}
defaultChunkSize = L.defaultChunkSize
with_bytestring_provider :: forall a . L.ByteString
-> ( LazyBSDes -> IO (a, LazyBSDes) )
-> IO (a, L.ByteString)
with_bytestring_provider in_bs f = do
buffer <- mallocBytes defaultChunkSize
let bd = LazyBSDes in_bs buffer defaultChunkSize
(a, bd') <- f bd
returnM ( a, bs bd' ) :: IO ( a, L.ByteString )
instance BufferDelegate LazyBSDes where
gen_region !required_size !bd =
case required_size > buffer_size bd of
True -> do
buffer'@(Ptr start_addr) <- reallocBytes (buffer bd) required_size
let bytes = L.unpack $! L.take (fromIntegral required_size) $! bs bd
pokeArray buffer' bytes
returnM $! BDIter required_size
0
( bd { buffer = buffer', buffer_size = required_size } )
start_addr
start_addr
:: IO (BDIter LazyBSDes)
False -> do
let !(Ptr start_addr) = buffer bd
bytes = L.unpack $! L.take (fromIntegral $! buffer_size bd) $! bs bd
pokeArray (buffer bd) bytes
returnM $! BDIter (buffer_size bd)
0
bd
start_addr
start_addr
:: IO (BDIter LazyBSDes)
finalize_region bd_iter = case minusAddr# (curr_addr bd_iter) (start_addr bd_iter) of
consumed_byte_count ->
let !bd = buffer_delegate bd_iter
!bs' = L.drop (fromIntegral $! I# consumed_byte_count) (bs bd)
in returnM $! bd { bs = bs' } :: IO LazyBSDes
decode :: forall a . DynamicDesAction Sealed Sealed Sealed LazyBSDes a
-> L.ByteString
-> (a, L.ByteString)
decode des_action b = unsafePerformIO ( do
with_bytestring_provider b (des_from_buffer_delegate des_action)
)
decode_ :: forall a . DynamicDesAction Sealed Sealed Sealed LazyBSDes a -> L.ByteString -> a
decode_ des_action b = unsafePerformIO ( do
( a, _ ) <- with_bytestring_provider b (des_from_buffer_delegate des_action)
returnM a :: IO a
)