module Bind.Marshal.StdLib.Dynamic.ByteString.Lazy.Ser ( encode
, encode_
, with_bytestring_handler
)
where
import Bind.Marshal.Prelude
import Bind.Marshal.Action
import Bind.Marshal.SerAction
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 Data.Maybe
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 LazyBSSer = LazyBSSer
{ out_bytestring :: L.ByteString
, ser_fp :: ForeignPtr Word8
}
defaultChunkSize = L.defaultChunkSize
instance BufferDelegate LazyBSSer where
gen_region !required_size !bd = do
let !buffer_size = max required_size defaultChunkSize
next_ser_fp <- mallocPlainForeignPtrBytes buffer_size
let !bd' = LazyBSSer (out_bytestring bd)
next_ser_fp
let !(Ptr start_addr) = unsafeForeignPtrToPtr next_ser_fp
returnM $! BDIter buffer_size
0
bd'
start_addr
start_addr :: IO (BDIter LazyBSSer)
finalize_region !bd_iter = case buffer_delegate bd_iter of
!bd -> do
returnM $! LazyBSSer (finalize_chunk bd $! bytes_final bd_iter)
undefined :: IO LazyBSSer
finalize_chunk :: LazyBSSer -> Size -> L.ByteString
finalize_chunk !bd 0 = out_bytestring bd
finalize_chunk !bd !bytes_final =
let strict_bs = S.fromForeignPtr (ser_fp bd) 0 bytes_final
in out_bytestring bd `L.append` L.chunk strict_bs L.Empty
with_bytestring_handler :: forall a . L.ByteString
-> ( LazyBSSer -> IO (a, LazyBSSer) )
-> IO (a, L.ByteString)
with_bytestring_handler bs_0 f = do
let bd = LazyBSSer bs_0 undefined
!(v, !bd') <- f bd
returnM $! (v, out_bytestring bd') :: IO (a, L.ByteString)
encode_ :: DynamicSerAction Sealed Sealed Sealed LazyBSSer () -> L.ByteString
encode_ !ser_action = unsafePerformIO ( do
!( (), !bd') <- ser_to_buffer_delegate ser_action (LazyBSSer L.empty undefined)
returnM $! out_bytestring bd' :: IO L.ByteString
)
encode :: DynamicSerAction Sealed Sealed Sealed LazyBSSer a -> (a, L.ByteString)
encode ser_action = unsafePerformIO (
with_bytestring_handler L.empty (ser_to_buffer_delegate ser_action)
)