{-# LANGUAGE ScopedTypeVariables, CPP, BangPatterns, RankNTypes, TupleSections #-}
{-# LANGUAGE Unsafe #-}
{-# OPTIONS_HADDOCK not-home #-}
module Data.ByteString.Builder.Internal (
Buffer(..)
, BufferRange(..)
, newBuffer
, bufferSize
, byteStringFromBuffer
, ChunkIOStream(..)
, buildStepToCIOS
, ciosUnitToLazyByteString
, ciosToLazyByteString
, BuildSignal
, BuildStep
, finalBuildStep
, done
, bufferFull
, insertChunk
, fillWithBuildStep
, Builder
, builder
, runBuilder
, runBuilderWith
, empty
, append
, flush
, ensureFree
, byteStringCopy
, byteStringInsert
, byteStringThreshold
, lazyByteStringCopy
, lazyByteStringInsert
, lazyByteStringThreshold
, shortByteString
, maximalCopySize
, byteString
, lazyByteString
, toLazyByteStringWith
, AllocationStrategy
, safeStrategy
, untrimmedStrategy
, customStrategy
, L.smallChunkSize
, L.defaultChunkSize
, L.chunkOverhead
, Put
, put
, runPut
, putToLazyByteString
, putToLazyByteStringWith
, hPut
, putBuilder
, fromPut
) where
import Control.Arrow (second)
import Data.Semigroup (Semigroup(..))
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.ByteString as S
import qualified Data.ByteString.Internal.Type as S
import qualified Data.ByteString.Lazy.Internal as L
import qualified Data.ByteString.Short.Internal as Sh
import qualified GHC.IO.Buffer as IO (Buffer(..), newByteBuffer)
import GHC.IO.Handle.Internals (wantWritableHandle, flushWriteBuffer)
import GHC.IO.Handle.Types (Handle__, haByteBuffer, haBufferMode)
import System.IO (hFlush, BufferMode(..), Handle)
import Data.IORef
import Foreign
import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
import System.IO.Unsafe (unsafeDupablePerformIO)
data BufferRange = BufferRange {-# UNPACK #-} !(Ptr Word8)
{-# UNPACK #-} !(Ptr Word8)
data Buffer = Buffer {-# UNPACK #-} !(ForeignPtr Word8)
{-# UNPACK #-} !BufferRange
{-# INLINE bufferSize #-}
bufferSize :: Buffer -> Int
bufferSize :: Buffer -> Int
bufferSize (Buffer ForeignPtr Word8
fpbuf (BufferRange Ptr Word8
_ Ptr Word8
ope)) =
Ptr Word8
ope Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fpbuf
{-# INLINE newBuffer #-}
newBuffer :: Int -> IO Buffer
newBuffer :: Int -> IO Buffer
newBuffer Int
size = do
ForeignPtr Word8
fpbuf <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
S.mallocByteString Int
size
let pbuf :: Ptr Word8
pbuf = ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fpbuf
Buffer -> IO Buffer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffer -> IO Buffer) -> Buffer -> IO Buffer
forall a b. (a -> b) -> a -> b
$! ForeignPtr Word8 -> BufferRange -> Buffer
Buffer ForeignPtr Word8
fpbuf (Ptr Word8 -> Ptr Word8 -> BufferRange
BufferRange Ptr Word8
pbuf (Ptr Word8
pbuf Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
size))
{-# INLINE byteStringFromBuffer #-}
byteStringFromBuffer :: Buffer -> S.StrictByteString
byteStringFromBuffer :: Buffer -> StrictByteString
byteStringFromBuffer (Buffer ForeignPtr Word8
fpbuf (BufferRange Ptr Word8
op Ptr Word8
_)) =
ForeignPtr Word8 -> Int -> StrictByteString
S.BS ForeignPtr Word8
fpbuf (Ptr Word8
op Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fpbuf)
{-# INLINE trimmedChunkFromBuffer #-}
trimmedChunkFromBuffer :: AllocationStrategy -> Buffer
-> L.LazyByteString -> L.LazyByteString
trimmedChunkFromBuffer :: AllocationStrategy -> Buffer -> LazyByteString -> LazyByteString
trimmedChunkFromBuffer (AllocationStrategy Maybe (Buffer, Int) -> IO Buffer
_ Int
_ Int -> Int -> Bool
trim) Buffer
buf LazyByteString
k
| StrictByteString -> Bool
S.null StrictByteString
bs = LazyByteString
k
| Int -> Int -> Bool
trim (StrictByteString -> Int
S.length StrictByteString
bs) (Buffer -> Int
bufferSize Buffer
buf) = StrictByteString -> LazyByteString -> LazyByteString
L.Chunk (StrictByteString -> StrictByteString
S.copy StrictByteString
bs) LazyByteString
k
| Bool
otherwise = StrictByteString -> LazyByteString -> LazyByteString
L.Chunk StrictByteString
bs LazyByteString
k
where
bs :: StrictByteString
bs = Buffer -> StrictByteString
byteStringFromBuffer Buffer
buf
data ChunkIOStream a =
Finished Buffer a
| Yield1 S.StrictByteString (IO (ChunkIOStream a))
{-# INLINE yield1 #-}
yield1 :: S.StrictByteString -> IO (ChunkIOStream a) -> IO (ChunkIOStream a)
yield1 :: forall a.
StrictByteString -> IO (ChunkIOStream a) -> IO (ChunkIOStream a)
yield1 StrictByteString
bs IO (ChunkIOStream a)
cios | StrictByteString -> Bool
S.null StrictByteString
bs = IO (ChunkIOStream a)
cios
| Bool
otherwise = ChunkIOStream a -> IO (ChunkIOStream a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChunkIOStream a -> IO (ChunkIOStream a))
-> ChunkIOStream a -> IO (ChunkIOStream a)
forall a b. (a -> b) -> a -> b
$ StrictByteString -> IO (ChunkIOStream a) -> ChunkIOStream a
forall a.
StrictByteString -> IO (ChunkIOStream a) -> ChunkIOStream a
Yield1 StrictByteString
bs IO (ChunkIOStream a)
cios
{-# INLINE ciosUnitToLazyByteString #-}
ciosUnitToLazyByteString :: AllocationStrategy
-> L.LazyByteString -> ChunkIOStream () -> L.LazyByteString
ciosUnitToLazyByteString :: AllocationStrategy
-> LazyByteString -> ChunkIOStream () -> LazyByteString
ciosUnitToLazyByteString AllocationStrategy
strategy LazyByteString
k = ChunkIOStream () -> LazyByteString
forall {a}. ChunkIOStream a -> LazyByteString
go
where
go :: ChunkIOStream a -> LazyByteString
go (Finished Buffer
buf a
_) = AllocationStrategy -> Buffer -> LazyByteString -> LazyByteString
trimmedChunkFromBuffer AllocationStrategy
strategy Buffer
buf LazyByteString
k
go (Yield1 StrictByteString
bs IO (ChunkIOStream a)
io) = StrictByteString -> LazyByteString -> LazyByteString
L.Chunk StrictByteString
bs (LazyByteString -> LazyByteString)
-> LazyByteString -> LazyByteString
forall a b. (a -> b) -> a -> b
$ IO LazyByteString -> LazyByteString
forall a. IO a -> a
unsafeDupablePerformIO (ChunkIOStream a -> LazyByteString
go (ChunkIOStream a -> LazyByteString)
-> IO (ChunkIOStream a) -> IO LazyByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (ChunkIOStream a)
io)
{-# INLINE ciosToLazyByteString #-}
ciosToLazyByteString :: AllocationStrategy
-> (a -> (b, L.LazyByteString))
-> ChunkIOStream a
-> (b, L.LazyByteString)
ciosToLazyByteString :: forall a b.
AllocationStrategy
-> (a -> (b, LazyByteString))
-> ChunkIOStream a
-> (b, LazyByteString)
ciosToLazyByteString AllocationStrategy
strategy a -> (b, LazyByteString)
k =
ChunkIOStream a -> (b, LazyByteString)
go
where
go :: ChunkIOStream a -> (b, LazyByteString)
go (Finished Buffer
buf a
x) =
(LazyByteString -> LazyByteString)
-> (b, LazyByteString) -> (b, LazyByteString)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (AllocationStrategy -> Buffer -> LazyByteString -> LazyByteString
trimmedChunkFromBuffer AllocationStrategy
strategy Buffer
buf) ((b, LazyByteString) -> (b, LazyByteString))
-> (b, LazyByteString) -> (b, LazyByteString)
forall a b. (a -> b) -> a -> b
$ a -> (b, LazyByteString)
k a
x
go (Yield1 StrictByteString
bs IO (ChunkIOStream a)
io) = (LazyByteString -> LazyByteString)
-> (b, LazyByteString) -> (b, LazyByteString)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (StrictByteString -> LazyByteString -> LazyByteString
L.Chunk StrictByteString
bs) ((b, LazyByteString) -> (b, LazyByteString))
-> (b, LazyByteString) -> (b, LazyByteString)
forall a b. (a -> b) -> a -> b
$ IO (b, LazyByteString) -> (b, LazyByteString)
forall a. IO a -> a
unsafeDupablePerformIO (ChunkIOStream a -> (b, LazyByteString)
go (ChunkIOStream a -> (b, LazyByteString))
-> IO (ChunkIOStream a) -> IO (b, LazyByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (ChunkIOStream a)
io)
type BuildStep a = BufferRange -> IO (BuildSignal a)
data BuildSignal a =
Done {-# UNPACK #-} !(Ptr Word8) a
| BufferFull
{-# UNPACK #-} !Int
{-# UNPACK #-} !(Ptr Word8)
(BuildStep a)
| InsertChunk
{-# UNPACK #-} !(Ptr Word8)
S.StrictByteString
(BuildStep a)
{-# INLINE done #-}
done :: Ptr Word8
-> a
-> BuildSignal a
done :: forall a. Ptr Word8 -> a -> BuildSignal a
done = Ptr Word8 -> a -> BuildSignal a
forall a. Ptr Word8 -> a -> BuildSignal a
Done
{-# INLINE bufferFull #-}
bufferFull :: Int
-> Ptr Word8
-> BuildStep a
-> BuildSignal a
bufferFull :: forall a. Int -> Ptr Word8 -> BuildStep a -> BuildSignal a
bufferFull = Int -> Ptr Word8 -> BuildStep a -> BuildSignal a
forall a. Int -> Ptr Word8 -> BuildStep a -> BuildSignal a
BufferFull
{-# INLINE insertChunk #-}
insertChunk :: Ptr Word8
-> S.StrictByteString
-> BuildStep a
-> BuildSignal a
insertChunk :: forall a.
Ptr Word8 -> StrictByteString -> BuildStep a -> BuildSignal a
insertChunk = Ptr Word8 -> StrictByteString -> BuildStep a -> BuildSignal a
forall a.
Ptr Word8 -> StrictByteString -> BuildStep a -> BuildSignal a
InsertChunk
{-# INLINE fillWithBuildStep #-}
fillWithBuildStep
:: BuildStep a
-> (Ptr Word8 -> a -> IO b)
-> (Ptr Word8 -> Int -> BuildStep a -> IO b)
-> (Ptr Word8 -> S.StrictByteString -> BuildStep a -> IO b)
-> BufferRange
-> IO b
fillWithBuildStep :: forall a b.
BuildStep a
-> (Ptr Word8 -> a -> IO b)
-> (Ptr Word8 -> Int -> BuildStep a -> IO b)
-> (Ptr Word8 -> StrictByteString -> BuildStep a -> IO b)
-> BufferRange
-> IO b
fillWithBuildStep BuildStep a
step Ptr Word8 -> a -> IO b
fDone Ptr Word8 -> Int -> BuildStep a -> IO b
fFull Ptr Word8 -> StrictByteString -> BuildStep a -> IO b
fChunk !BufferRange
br = do
BuildSignal a
signal <- BuildStep a
step BufferRange
br
case BuildSignal a
signal of
Done Ptr Word8
op a
x -> Ptr Word8 -> a -> IO b
fDone Ptr Word8
op a
x
BufferFull Int
minSize Ptr Word8
op BuildStep a
nextStep -> Ptr Word8 -> Int -> BuildStep a -> IO b
fFull Ptr Word8
op Int
minSize BuildStep a
nextStep
InsertChunk Ptr Word8
op StrictByteString
bs BuildStep a
nextStep -> Ptr Word8 -> StrictByteString -> BuildStep a -> IO b
fChunk Ptr Word8
op StrictByteString
bs BuildStep a
nextStep
newtype Builder = Builder (forall r. BuildStep r -> BuildStep r)
{-# INLINE builder #-}
builder :: (forall r. BuildStep r -> BuildStep r)
-> Builder
builder :: (forall r. BuildStep r -> BuildStep r) -> Builder
builder = (forall r. BuildStep r -> BuildStep r) -> Builder
Builder
finalBuildStep :: BuildStep ()
finalBuildStep :: BuildStep ()
finalBuildStep (BufferRange Ptr Word8
op Ptr Word8
_) = BuildSignal () -> IO (BuildSignal ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSignal () -> IO (BuildSignal ()))
-> BuildSignal () -> IO (BuildSignal ())
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> () -> BuildSignal ()
forall a. Ptr Word8 -> a -> BuildSignal a
Done Ptr Word8
op ()
{-# INLINE runBuilder #-}
runBuilder :: Builder
-> BuildStep ()
runBuilder :: Builder -> BuildStep ()
runBuilder Builder
b = Builder -> BuildStep () -> BuildStep ()
forall a. Builder -> BuildStep a -> BuildStep a
runBuilderWith Builder
b BuildStep ()
finalBuildStep
{-# INLINE runBuilderWith #-}
runBuilderWith :: Builder
-> BuildStep a
-> BuildStep a
runBuilderWith :: forall a. Builder -> BuildStep a -> BuildStep a
runBuilderWith (Builder forall r. BuildStep r -> BuildStep r
b) = BuildStep a -> BuildStep a
forall r. BuildStep r -> BuildStep r
b
{-# INLINE[1] empty #-}
empty :: Builder
empty :: Builder
empty = (forall r. BuildStep r -> BuildStep r) -> Builder
Builder (\BuildStep r
k BufferRange
br -> BuildStep r
k BufferRange
br)
{-# INLINE[1] append #-}
append :: Builder -> Builder -> Builder
append :: Builder -> Builder -> Builder
append (Builder forall r. BuildStep r -> BuildStep r
b1) (Builder forall r. BuildStep r -> BuildStep r
b2) = (forall r. BuildStep r -> BuildStep r) -> Builder
Builder ((forall r. BuildStep r -> BuildStep r) -> Builder)
-> (forall r. BuildStep r -> BuildStep r) -> Builder
forall a b. (a -> b) -> a -> b
$ BuildStep r -> BuildStep r
forall r. BuildStep r -> BuildStep r
b1 (BuildStep r -> BuildStep r)
-> (BuildStep r -> BuildStep r) -> BuildStep r -> BuildStep r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildStep r -> BuildStep r
forall r. BuildStep r -> BuildStep r
b2
stimesBuilder :: Integral t => t -> Builder -> Builder
{-# INLINABLE stimesBuilder #-}
stimesBuilder :: forall t. Integral t => t -> Builder -> Builder
stimesBuilder t
n Builder
b
| t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
0 = t -> Builder
forall {t}. (Eq t, Num t) => t -> Builder
go t
n
| Bool
otherwise = Builder
stimesNegativeErr
where go :: t -> Builder
go t
0 = Builder
empty
go t
k = Builder
b Builder -> Builder -> Builder
`append` t -> Builder
go (t
k t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
stimesNegativeErr :: Builder
stimesNegativeErr :: Builder
stimesNegativeErr
= [Char] -> Builder
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"stimes @Builder: non-negative multiplier expected"
instance Semigroup Builder where
{-# INLINE (<>) #-}
<> :: Builder -> Builder -> Builder
(<>) = Builder -> Builder -> Builder
append
sconcat :: NonEmpty Builder -> Builder
sconcat (Builder
b:|[Builder]
bs) = Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Builder -> Builder -> Builder) -> Builder -> [Builder] -> Builder
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend Builder
forall a. Monoid a => a
mempty [Builder]
bs
{-# INLINE stimes #-}
stimes :: forall t. Integral t => t -> Builder -> Builder
stimes = b -> Builder -> Builder
forall t. Integral t => t -> Builder -> Builder
stimesBuilder
instance Monoid Builder where
{-# INLINE mempty #-}
mempty :: Builder
mempty = Builder
empty
{-# INLINE mappend #-}
mappend :: Builder -> Builder -> Builder
mappend = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>)
{-# INLINE mconcat #-}
mconcat :: [Builder] -> Builder
mconcat = (Builder -> Builder -> Builder) -> Builder -> [Builder] -> Builder
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend Builder
forall a. Monoid a => a
mempty
{-# INLINE flush #-}
flush :: Builder
flush :: Builder
flush = (forall r. BuildStep r -> BuildStep r) -> Builder
builder BuildStep r -> BuildStep r
forall r. BuildStep r -> BuildStep r
forall {m :: * -> *} {a}.
Monad m =>
BuildStep a -> BufferRange -> m (BuildSignal a)
step
where
step :: BuildStep a -> BufferRange -> m (BuildSignal a)
step BuildStep a
k (BufferRange Ptr Word8
op Ptr Word8
_) = BuildSignal a -> m (BuildSignal a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSignal a -> m (BuildSignal a))
-> BuildSignal a -> m (BuildSignal a)
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> StrictByteString -> BuildStep a -> BuildSignal a
forall a.
Ptr Word8 -> StrictByteString -> BuildStep a -> BuildSignal a
insertChunk Ptr Word8
op StrictByteString
S.empty BuildStep a
k
newtype Put a = Put { forall a. Put a -> forall r. (a -> BuildStep r) -> BuildStep r
unPut :: forall r. (a -> BuildStep r) -> BuildStep r }
{-# INLINE put #-}
put :: (forall r. (a -> BuildStep r) -> BuildStep r)
-> Put a
put :: forall a. (forall r. (a -> BuildStep r) -> BuildStep r) -> Put a
put = (forall r. (a -> BuildStep r) -> BuildStep r) -> Put a
forall a. (forall r. (a -> BuildStep r) -> BuildStep r) -> Put a
Put
{-# INLINE runPut #-}
runPut :: Put a
-> BuildStep a
runPut :: forall a. Put a -> BuildStep a
runPut (Put forall r. (a -> BuildStep r) -> BuildStep r
p) = (a -> BuildStep a) -> BuildStep a
forall r. (a -> BuildStep r) -> BuildStep r
p ((a -> BuildStep a) -> BuildStep a)
-> (a -> BuildStep a) -> BuildStep a
forall a b. (a -> b) -> a -> b
$ \a
x (BufferRange Ptr Word8
op Ptr Word8
_) -> BuildSignal a -> IO (BuildSignal a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSignal a -> IO (BuildSignal a))
-> BuildSignal a -> IO (BuildSignal a)
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> a -> BuildSignal a
forall a. Ptr Word8 -> a -> BuildSignal a
Done Ptr Word8
op a
x
instance Functor Put where
fmap :: forall a b. (a -> b) -> Put a -> Put b
fmap a -> b
f Put a
p = (forall r. (b -> BuildStep r) -> BuildStep r) -> Put b
forall a. (forall r. (a -> BuildStep r) -> BuildStep r) -> Put a
Put ((forall r. (b -> BuildStep r) -> BuildStep r) -> Put b)
-> (forall r. (b -> BuildStep r) -> BuildStep r) -> Put b
forall a b. (a -> b) -> a -> b
$ \b -> BuildStep r
k -> Put a -> forall r. (a -> BuildStep r) -> BuildStep r
forall a. Put a -> forall r. (a -> BuildStep r) -> BuildStep r
unPut Put a
p (b -> BuildStep r
k (b -> BuildStep r) -> (a -> b) -> a -> BuildStep r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
{-# INLINE fmap #-}
{-# INLINE[1] ap_l #-}
ap_l :: Put a -> Put b -> Put a
ap_l :: forall a b. Put a -> Put b -> Put a
ap_l (Put forall r. (a -> BuildStep r) -> BuildStep r
a) (Put forall r. (b -> BuildStep r) -> BuildStep r
b) = (forall r. (a -> BuildStep r) -> BuildStep r) -> Put a
forall a. (forall r. (a -> BuildStep r) -> BuildStep r) -> Put a
Put ((forall r. (a -> BuildStep r) -> BuildStep r) -> Put a)
-> (forall r. (a -> BuildStep r) -> BuildStep r) -> Put a
forall a b. (a -> b) -> a -> b
$ \a -> BuildStep r
k -> (a -> BuildStep r) -> BuildStep r
forall r. (a -> BuildStep r) -> BuildStep r
a (\a
a' -> (b -> BuildStep r) -> BuildStep r
forall r. (b -> BuildStep r) -> BuildStep r
b (\b
_ -> a -> BuildStep r
k a
a'))
{-# INLINE[1] ap_r #-}
ap_r :: Put a -> Put b -> Put b
ap_r :: forall a b. Put a -> Put b -> Put b
ap_r (Put forall r. (a -> BuildStep r) -> BuildStep r
a) (Put forall r. (b -> BuildStep r) -> BuildStep r
b) = (forall r. (b -> BuildStep r) -> BuildStep r) -> Put b
forall a. (forall r. (a -> BuildStep r) -> BuildStep r) -> Put a
Put ((forall r. (b -> BuildStep r) -> BuildStep r) -> Put b)
-> (forall r. (b -> BuildStep r) -> BuildStep r) -> Put b
forall a b. (a -> b) -> a -> b
$ \b -> BuildStep r
k -> (a -> BuildStep r) -> BuildStep r
forall r. (a -> BuildStep r) -> BuildStep r
a (\a
_ -> (b -> BuildStep r) -> BuildStep r
forall r. (b -> BuildStep r) -> BuildStep r
b b -> BuildStep r
k)
instance Applicative Put where
{-# INLINE pure #-}
pure :: forall a. a -> Put a
pure a
x = (forall r. (a -> BuildStep r) -> BuildStep r) -> Put a
forall a. (forall r. (a -> BuildStep r) -> BuildStep r) -> Put a
Put ((forall r. (a -> BuildStep r) -> BuildStep r) -> Put a)
-> (forall r. (a -> BuildStep r) -> BuildStep r) -> Put a
forall a b. (a -> b) -> a -> b
$ \a -> BuildStep r
k -> a -> BuildStep r
k a
x
{-# INLINE (<*>) #-}
Put forall r. ((a -> b) -> BuildStep r) -> BuildStep r
f <*> :: forall a b. Put (a -> b) -> Put a -> Put b
<*> Put forall r. (a -> BuildStep r) -> BuildStep r
a = (forall r. (b -> BuildStep r) -> BuildStep r) -> Put b
forall a. (forall r. (a -> BuildStep r) -> BuildStep r) -> Put a
Put ((forall r. (b -> BuildStep r) -> BuildStep r) -> Put b)
-> (forall r. (b -> BuildStep r) -> BuildStep r) -> Put b
forall a b. (a -> b) -> a -> b
$ \b -> BuildStep r
k -> ((a -> b) -> BuildStep r) -> BuildStep r
forall r. ((a -> b) -> BuildStep r) -> BuildStep r
f (\a -> b
f' -> (a -> BuildStep r) -> BuildStep r
forall r. (a -> BuildStep r) -> BuildStep r
a (b -> BuildStep r
k (b -> BuildStep r) -> (a -> b) -> a -> BuildStep r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f'))
{-# INLINE (<*) #-}
<* :: forall a b. Put a -> Put b -> Put a
(<*) = Put a -> Put b -> Put a
forall a b. Put a -> Put b -> Put a
ap_l
{-# INLINE (*>) #-}
*> :: forall a b. Put a -> Put b -> Put b
(*>) = Put a -> Put b -> Put b
forall a b. Put a -> Put b -> Put b
ap_r
instance Monad Put where
{-# INLINE return #-}
return :: forall a. a -> Put a
return = a -> Put a
forall a. a -> Put a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE (>>=) #-}
Put forall r. (a -> BuildStep r) -> BuildStep r
m >>= :: forall a b. Put a -> (a -> Put b) -> Put b
>>= a -> Put b
f = (forall r. (b -> BuildStep r) -> BuildStep r) -> Put b
forall a. (forall r. (a -> BuildStep r) -> BuildStep r) -> Put a
Put ((forall r. (b -> BuildStep r) -> BuildStep r) -> Put b)
-> (forall r. (b -> BuildStep r) -> BuildStep r) -> Put b
forall a b. (a -> b) -> a -> b
$ \b -> BuildStep r
k -> (a -> BuildStep r) -> BuildStep r
forall r. (a -> BuildStep r) -> BuildStep r
m (\a
m' -> Put b -> forall r. (b -> BuildStep r) -> BuildStep r
forall a. Put a -> forall r. (a -> BuildStep r) -> BuildStep r
unPut (a -> Put b
f a
m') b -> BuildStep r
k)
{-# INLINE (>>) #-}
>> :: forall a b. Put a -> Put b -> Put b
(>>) = Put a -> Put b -> Put b
forall a b. Put a -> Put b -> Put b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
{-# INLINE[1] putBuilder #-}
putBuilder :: Builder -> Put ()
putBuilder :: Builder -> Put ()
putBuilder (Builder forall r. BuildStep r -> BuildStep r
b) = (forall r. (() -> BuildStep r) -> BuildStep r) -> Put ()
forall a. (forall r. (a -> BuildStep r) -> BuildStep r) -> Put a
Put ((forall r. (() -> BuildStep r) -> BuildStep r) -> Put ())
-> (forall r. (() -> BuildStep r) -> BuildStep r) -> Put ()
forall a b. (a -> b) -> a -> b
$ \() -> BuildStep r
k -> BuildStep r -> BuildStep r
forall r. BuildStep r -> BuildStep r
b (() -> BuildStep r
k ())
{-# INLINE fromPut #-}
fromPut :: Put () -> Builder
fromPut :: Put () -> Builder
fromPut (Put forall r. (() -> BuildStep r) -> BuildStep r
p) = (forall r. BuildStep r -> BuildStep r) -> Builder
Builder ((forall r. BuildStep r -> BuildStep r) -> Builder)
-> (forall r. BuildStep r -> BuildStep r) -> Builder
forall a b. (a -> b) -> a -> b
$ \BuildStep r
k -> (() -> BuildStep r) -> BuildStep r
forall r. (() -> BuildStep r) -> BuildStep r
p (BuildStep r -> () -> BuildStep r
forall a b. a -> b -> a
const BuildStep r
k)
{-# RULES
"ap_l/putBuilder" forall b1 b2.
ap_l (putBuilder b1) (putBuilder b2)
= putBuilder (append b1 b2)
"ap_l/putBuilder/assoc_r" forall b1 b2 (p :: Put a).
ap_l (putBuilder b1) (ap_l (putBuilder b2) p)
= ap_l (putBuilder (append b1 b2)) p
"ap_l/putBuilder/assoc_l" forall (p :: Put a) b1 b2.
ap_l (ap_l p (putBuilder b1)) (putBuilder b2)
= ap_l p (putBuilder (append b1 b2))
#-}
{-# RULES
"ap_r/putBuilder" forall b1 b2.
ap_r (putBuilder b1) (putBuilder b2)
= putBuilder (append b1 b2)
"ap_r/putBuilder/assoc_r" forall b1 b2 (p :: Put a).
ap_r (putBuilder b1) (ap_r (putBuilder b2) p)
= ap_r (putBuilder (append b1 b2)) p
"ap_r/putBuilder/assoc_l" forall (p :: Put a) b1 b2.
ap_r (ap_r p (putBuilder b1)) (putBuilder b2)
= ap_r p (putBuilder (append b1 b2))
#-}
{-# RULES
"ap_l/ap_r/putBuilder/assoc_r" forall b1 b2 (p :: Put a).
ap_l (putBuilder b1) (ap_r (putBuilder b2) p)
= ap_l (putBuilder (append b1 b2)) p
"ap_r/ap_l/putBuilder/assoc_r" forall b1 b2 (p :: Put a).
ap_r (putBuilder b1) (ap_l (putBuilder b2) p)
= ap_l (putBuilder (append b1 b2)) p
"ap_l/ap_r/putBuilder/assoc_l" forall (p :: Put a) b1 b2.
ap_l (ap_r p (putBuilder b1)) (putBuilder b2)
= ap_r p (putBuilder (append b1 b2))
"ap_r/ap_l/putBuilder/assoc_l" forall (p :: Put a) b1 b2.
ap_r (ap_l p (putBuilder b1)) (putBuilder b2)
= ap_r p (putBuilder (append b1 b2))
#-}
hPut :: forall a. Handle -> Put a -> IO a
hPut :: forall a. Handle -> Put a -> IO a
hPut Handle
h Put a
p = do
Int -> BuildStep a -> IO a
fillHandle Int
1 (Put a -> BuildStep a
forall a. Put a -> BuildStep a
runPut Put a
p)
where
fillHandle :: Int -> BuildStep a -> IO a
fillHandle :: Int -> BuildStep a -> IO a
fillHandle !Int
minFree BuildStep a
step = do
IO a
next <- [Char] -> Handle -> (Handle__ -> IO (IO a)) -> IO (IO a)
forall a. [Char] -> Handle -> (Handle__ -> IO a) -> IO a
wantWritableHandle [Char]
"hPut" Handle
h Handle__ -> IO (IO a)
fillHandle_
IO a
next
where
fillHandle_ :: Handle__ -> IO (IO a)
fillHandle_ :: Handle__ -> IO (IO a)
fillHandle_ Handle__
h_ = do
Buffer Word8 -> IO ()
forall {e}. Buffer e -> IO ()
makeSpace (Buffer Word8 -> IO ()) -> IO (Buffer Word8) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
refBuf
Buffer Word8 -> IO (IO a)
fillBuffer (Buffer Word8 -> IO (IO a)) -> IO (Buffer Word8) -> IO (IO a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
refBuf
where
refBuf :: IORef (Buffer Word8)
refBuf = Handle__ -> IORef (Buffer Word8)
haByteBuffer Handle__
h_
freeSpace :: Buffer e -> Int
freeSpace Buffer e
buf = Buffer e -> Int
forall e. Buffer e -> Int
IO.bufSize Buffer e
buf Int -> Int -> Int
forall a. Num a => a -> a -> a
- Buffer e -> Int
forall e. Buffer e -> Int
IO.bufR Buffer e
buf
makeSpace :: Buffer e -> IO ()
makeSpace Buffer e
buf
| Buffer e -> Int
forall e. Buffer e -> Int
IO.bufSize Buffer e
buf Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minFree = do
Handle__ -> IO ()
flushWriteBuffer Handle__
h_
BufferState
s <- Buffer Word8 -> BufferState
forall e. Buffer e -> BufferState
IO.bufState (Buffer Word8 -> BufferState)
-> IO (Buffer Word8) -> IO BufferState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
refBuf
Int -> BufferState -> IO (Buffer Word8)
IO.newByteBuffer Int
minFree BufferState
s IO (Buffer Word8) -> (Buffer Word8 -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
refBuf
| Buffer e -> Int
forall e. Buffer e -> Int
freeSpace Buffer e
buf Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minFree = Handle__ -> IO ()
flushWriteBuffer Handle__
h_
| Bool
otherwise =
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
fillBuffer :: Buffer Word8 -> IO (IO a)
fillBuffer Buffer Word8
buf
| Buffer Word8 -> Int
forall e. Buffer e -> Int
freeSpace Buffer Word8
buf Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minFree =
[Char] -> IO (IO a)
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO (IO a)) -> [Char] -> IO (IO a)
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines
[ [Char]
"Data.ByteString.Builder.Internal.hPut: internal error."
, [Char]
" Not enough space after flush."
, [Char]
" required: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
minFree
, [Char]
" free: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Buffer Word8 -> Int
forall e. Buffer e -> Int
freeSpace Buffer Word8
buf)
]
| Bool
otherwise = do
let !br :: BufferRange
br = Ptr Word8 -> Ptr Word8 -> BufferRange
BufferRange Ptr Word8
forall {b}. Ptr b
op (Ptr Word8
pBuf Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Buffer Word8 -> Int
forall e. Buffer e -> Int
IO.bufSize Buffer Word8
buf)
IO a
res <- BuildStep a
-> (Ptr Word8 -> a -> IO (IO a))
-> (Ptr Word8 -> Int -> BuildStep a -> IO (IO a))
-> (Ptr Word8 -> StrictByteString -> BuildStep a -> IO (IO a))
-> BufferRange
-> IO (IO a)
forall a b.
BuildStep a
-> (Ptr Word8 -> a -> IO b)
-> (Ptr Word8 -> Int -> BuildStep a -> IO b)
-> (Ptr Word8 -> StrictByteString -> BuildStep a -> IO b)
-> BufferRange
-> IO b
fillWithBuildStep BuildStep a
step Ptr Word8 -> a -> IO (IO a)
forall {a} {a}. Ptr a -> a -> IO (IO a)
doneH Ptr Word8 -> Int -> BuildStep a -> IO (IO a)
forall {a}. Ptr a -> Int -> BuildStep a -> IO (IO a)
fullH Ptr Word8 -> StrictByteString -> BuildStep a -> IO (IO a)
forall {a}. Ptr a -> StrictByteString -> BuildStep a -> IO (IO a)
insertChunkH BufferRange
br
ForeignPtr Word8 -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Word8
fpBuf
IO a -> IO (IO a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IO a
res
where
fpBuf :: ForeignPtr Word8
fpBuf = Buffer Word8 -> ForeignPtr Word8
forall e. Buffer e -> RawBuffer e
IO.bufRaw Buffer Word8
buf
pBuf :: Ptr Word8
pBuf = ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fpBuf
op :: Ptr b
op = Ptr Word8
pBuf Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Buffer Word8 -> Int
forall e. Buffer e -> Int
IO.bufR Buffer Word8
buf
{-# INLINE updateBufR #-}
updateBufR :: Ptr a -> IO ()
updateBufR Ptr a
op' = do
let !off' :: Int
off' = Ptr a
op' Ptr a -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
pBuf
!buf' :: Buffer Word8
buf' = Buffer Word8
buf {IO.bufR = off'}
IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
refBuf Buffer Word8
buf'
doneH :: Ptr a -> a -> IO (IO a)
doneH Ptr a
op' a
x = do
Ptr a -> IO ()
forall {a}. Ptr a -> IO ()
updateBufR Ptr a
op'
case Handle__ -> BufferMode
haBufferMode Handle__
h_ of
BlockBuffering Maybe Int
_ -> IO a -> IO (IO a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO a -> IO (IO a)) -> IO a -> IO (IO a)
forall a b. (a -> b) -> a -> b
$ a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
BufferMode
_line_or_no_buffering -> IO a -> IO (IO a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO a -> IO (IO a)) -> IO a -> IO (IO a)
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hFlush Handle
h IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
fullH :: Ptr a -> Int -> BuildStep a -> IO (IO a)
fullH Ptr a
op' Int
minSize BuildStep a
nextStep = do
Ptr a -> IO ()
forall {a}. Ptr a -> IO ()
updateBufR Ptr a
op'
IO a -> IO (IO a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO a -> IO (IO a)) -> IO a -> IO (IO a)
forall a b. (a -> b) -> a -> b
$ Int -> BuildStep a -> IO a
fillHandle Int
minSize BuildStep a
nextStep
insertChunkH :: Ptr a -> StrictByteString -> BuildStep a -> IO (IO a)
insertChunkH Ptr a
op' StrictByteString
bs BuildStep a
nextStep = do
Ptr a -> IO ()
forall {a}. Ptr a -> IO ()
updateBufR Ptr a
op'
IO a -> IO (IO a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO a -> IO (IO a)) -> IO a -> IO (IO a)
forall a b. (a -> b) -> a -> b
$ do
Handle -> StrictByteString -> IO ()
S.hPut Handle
h StrictByteString
bs
Int -> BuildStep a -> IO a
fillHandle Int
1 BuildStep a
nextStep
{-# NOINLINE putToLazyByteString #-}
putToLazyByteString
:: Put a
-> (a, L.LazyByteString)
putToLazyByteString :: forall a. Put a -> (a, LazyByteString)
putToLazyByteString = AllocationStrategy
-> (a -> (a, LazyByteString)) -> Put a -> (a, LazyByteString)
forall a b.
AllocationStrategy
-> (a -> (b, LazyByteString)) -> Put a -> (b, LazyByteString)
putToLazyByteStringWith
(Int -> Int -> AllocationStrategy
safeStrategy Int
L.smallChunkSize Int
L.defaultChunkSize) (, LazyByteString
L.Empty)
{-# INLINE putToLazyByteStringWith #-}
putToLazyByteStringWith
:: AllocationStrategy
-> (a -> (b, L.LazyByteString))
-> Put a
-> (b, L.LazyByteString)
putToLazyByteStringWith :: forall a b.
AllocationStrategy
-> (a -> (b, LazyByteString)) -> Put a -> (b, LazyByteString)
putToLazyByteStringWith AllocationStrategy
strategy a -> (b, LazyByteString)
k Put a
p =
AllocationStrategy
-> (a -> (b, LazyByteString))
-> ChunkIOStream a
-> (b, LazyByteString)
forall a b.
AllocationStrategy
-> (a -> (b, LazyByteString))
-> ChunkIOStream a
-> (b, LazyByteString)
ciosToLazyByteString AllocationStrategy
strategy a -> (b, LazyByteString)
k (ChunkIOStream a -> (b, LazyByteString))
-> ChunkIOStream a -> (b, LazyByteString)
forall a b. (a -> b) -> a -> b
$ IO (ChunkIOStream a) -> ChunkIOStream a
forall a. IO a -> a
unsafeDupablePerformIO (IO (ChunkIOStream a) -> ChunkIOStream a)
-> IO (ChunkIOStream a) -> ChunkIOStream a
forall a b. (a -> b) -> a -> b
$
AllocationStrategy -> BuildStep a -> IO (ChunkIOStream a)
forall a. AllocationStrategy -> BuildStep a -> IO (ChunkIOStream a)
buildStepToCIOS AllocationStrategy
strategy (Put a -> BuildStep a
forall a. Put a -> BuildStep a
runPut Put a
p)
{-# INLINE ensureFree #-}
ensureFree :: Int -> Builder
ensureFree :: Int -> Builder
ensureFree Int
minFree =
(forall r. BuildStep r -> BuildStep r) -> Builder
builder BuildStep r -> BuildStep r
forall r. BuildStep r -> BuildStep r
step
where
step :: BuildStep a -> BuildStep a
step BuildStep a
k br :: BufferRange
br@(BufferRange Ptr Word8
op Ptr Word8
ope)
| Ptr Word8
ope Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
op Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minFree = BuildSignal a -> IO (BuildSignal a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSignal a -> IO (BuildSignal a))
-> BuildSignal a -> IO (BuildSignal a)
forall a b. (a -> b) -> a -> b
$ Int -> Ptr Word8 -> BuildStep a -> BuildSignal a
forall a. Int -> Ptr Word8 -> BuildStep a -> BuildSignal a
bufferFull Int
minFree Ptr Word8
op BuildStep a
k
| Bool
otherwise = BuildStep a
k BufferRange
br
wrappedBytesCopyStep :: BufferRange
-> BuildStep a -> BuildStep a
wrappedBytesCopyStep :: forall a. BufferRange -> BuildStep a -> BuildStep a
wrappedBytesCopyStep (BufferRange Ptr Word8
ip0 Ptr Word8
ipe) BuildStep a
k =
Ptr Word8 -> BuildStep a
go Ptr Word8
ip0
where
go :: Ptr Word8 -> BuildStep a
go !Ptr Word8
ip (BufferRange Ptr Word8
op Ptr Word8
ope)
| Int
inpRemaining Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
outRemaining = do
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
op Ptr Word8
ip Int
inpRemaining
let !br' :: BufferRange
br' = Ptr Word8 -> Ptr Word8 -> BufferRange
BufferRange (Ptr Word8
op Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
inpRemaining) Ptr Word8
ope
BuildStep a
k BufferRange
br'
| Bool
otherwise = do
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
op Ptr Word8
ip Int
outRemaining
let !ip' :: Ptr b
ip' = Ptr Word8
ip Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
outRemaining
BuildSignal a -> IO (BuildSignal a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSignal a -> IO (BuildSignal a))
-> BuildSignal a -> IO (BuildSignal a)
forall a b. (a -> b) -> a -> b
$ Int -> Ptr Word8 -> BuildStep a -> BuildSignal a
forall a. Int -> Ptr Word8 -> BuildStep a -> BuildSignal a
bufferFull Int
1 Ptr Word8
ope (Ptr Word8 -> BuildStep a
go Ptr Word8
forall {b}. Ptr b
ip')
where
outRemaining :: Int
outRemaining = Ptr Word8
ope Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
op
inpRemaining :: Int
inpRemaining = Ptr Word8
ipe Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
ip
{-# INLINE byteStringThreshold #-}
byteStringThreshold :: Int -> S.StrictByteString -> Builder
byteStringThreshold :: Int -> StrictByteString -> Builder
byteStringThreshold Int
maxCopySize =
\StrictByteString
bs -> (forall r. BuildStep r -> BuildStep r) -> Builder
builder ((forall r. BuildStep r -> BuildStep r) -> Builder)
-> (forall r. BuildStep r -> BuildStep r) -> Builder
forall a b. (a -> b) -> a -> b
$ StrictByteString -> BuildStep r -> BuildStep r
forall {a}. StrictByteString -> BuildStep a -> BuildStep a
step StrictByteString
bs
where
step :: StrictByteString -> BuildStep a -> BuildStep a
step bs :: StrictByteString
bs@(S.BS ForeignPtr Word8
_ Int
len) !BuildStep a
k br :: BufferRange
br@(BufferRange !Ptr Word8
op Ptr Word8
_)
| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxCopySize = StrictByteString -> BuildStep a -> BuildStep a
forall {a}. StrictByteString -> BuildStep a -> BuildStep a
byteStringCopyStep StrictByteString
bs BuildStep a
k BufferRange
br
| Bool
otherwise = BuildSignal a -> IO (BuildSignal a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSignal a -> IO (BuildSignal a))
-> BuildSignal a -> IO (BuildSignal a)
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> StrictByteString -> BuildStep a -> BuildSignal a
forall a.
Ptr Word8 -> StrictByteString -> BuildStep a -> BuildSignal a
insertChunk Ptr Word8
op StrictByteString
bs BuildStep a
k
{-# INLINE byteStringCopy #-}
byteStringCopy :: S.StrictByteString -> Builder
byteStringCopy :: StrictByteString -> Builder
byteStringCopy = \StrictByteString
bs -> (forall r. BuildStep r -> BuildStep r) -> Builder
builder ((forall r. BuildStep r -> BuildStep r) -> Builder)
-> (forall r. BuildStep r -> BuildStep r) -> Builder
forall a b. (a -> b) -> a -> b
$ StrictByteString -> BuildStep r -> BuildStep r
forall {a}. StrictByteString -> BuildStep a -> BuildStep a
byteStringCopyStep StrictByteString
bs
{-# INLINE byteStringCopyStep #-}
byteStringCopyStep :: S.StrictByteString -> BuildStep a -> BuildStep a
byteStringCopyStep :: forall {a}. StrictByteString -> BuildStep a -> BuildStep a
byteStringCopyStep (S.BS ForeignPtr Word8
ifp Int
isize) !BuildStep a
k0 br0 :: BufferRange
br0@(BufferRange Ptr Word8
op Ptr Word8
ope)
| Ptr Word8
forall {b}. Ptr b
op' Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Ptr Word8
ope = do Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
op Ptr Word8
ip Int
isize
ForeignPtr Word8 -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Word8
ifp
BuildStep a
k0 (Ptr Word8 -> Ptr Word8 -> BufferRange
BufferRange Ptr Word8
forall {b}. Ptr b
op' Ptr Word8
ope)
| Bool
otherwise = BufferRange -> BuildStep a -> BuildStep a
forall a. BufferRange -> BuildStep a -> BuildStep a
wrappedBytesCopyStep (Ptr Word8 -> Ptr Word8 -> BufferRange
BufferRange Ptr Word8
ip Ptr Word8
forall {b}. Ptr b
ipe) BuildStep a
k BufferRange
br0
where
op' :: Ptr b
op' = Ptr Word8
op Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
isize
ip :: Ptr Word8
ip = ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
ifp
ipe :: Ptr b
ipe = Ptr Word8
ip Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
isize
k :: BuildStep a
k BufferRange
br = do ForeignPtr Word8 -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Word8
ifp
BuildStep a
k0 BufferRange
br
{-# INLINE byteStringInsert #-}
byteStringInsert :: S.StrictByteString -> Builder
byteStringInsert :: StrictByteString -> Builder
byteStringInsert =
\StrictByteString
bs -> (forall r. BuildStep r -> BuildStep r) -> Builder
builder ((forall r. BuildStep r -> BuildStep r) -> Builder)
-> (forall r. BuildStep r -> BuildStep r) -> Builder
forall a b. (a -> b) -> a -> b
$ \BuildStep r
k (BufferRange Ptr Word8
op Ptr Word8
_) -> BuildSignal r -> IO (BuildSignal r)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSignal r -> IO (BuildSignal r))
-> BuildSignal r -> IO (BuildSignal r)
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> StrictByteString -> BuildStep r -> BuildSignal r
forall a.
Ptr Word8 -> StrictByteString -> BuildStep a -> BuildSignal a
insertChunk Ptr Word8
op StrictByteString
bs BuildStep r
k
{-# INLINE shortByteString #-}
shortByteString :: Sh.ShortByteString -> Builder
shortByteString :: ShortByteString -> Builder
shortByteString = \ShortByteString
sbs -> (forall r. BuildStep r -> BuildStep r) -> Builder
builder ((forall r. BuildStep r -> BuildStep r) -> Builder)
-> (forall r. BuildStep r -> BuildStep r) -> Builder
forall a b. (a -> b) -> a -> b
$ ShortByteString -> BuildStep r -> BuildStep r
forall a. ShortByteString -> BuildStep a -> BuildStep a
shortByteStringCopyStep ShortByteString
sbs
{-# INLINE shortByteStringCopyStep #-}
shortByteStringCopyStep :: Sh.ShortByteString
-> BuildStep a -> BuildStep a
shortByteStringCopyStep :: forall a. ShortByteString -> BuildStep a -> BuildStep a
shortByteStringCopyStep !ShortByteString
sbs BuildStep a
k =
Int -> Int -> BuildStep a
go Int
0 (ShortByteString -> Int
Sh.length ShortByteString
sbs)
where
go :: Int -> Int -> BuildStep a
go !Int
ip !Int
ipe (BufferRange Ptr Word8
op Ptr Word8
ope)
| Int
inpRemaining Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
outRemaining = do
ShortByteString -> Int -> Ptr Word8 -> Int -> IO ()
forall a. ShortByteString -> Int -> Ptr a -> Int -> IO ()
Sh.copyToPtr ShortByteString
sbs Int
ip Ptr Word8
op Int
inpRemaining
let !br' :: BufferRange
br' = Ptr Word8 -> Ptr Word8 -> BufferRange
BufferRange (Ptr Word8
op Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
inpRemaining) Ptr Word8
ope
BuildStep a
k BufferRange
br'
| Bool
otherwise = do
ShortByteString -> Int -> Ptr Word8 -> Int -> IO ()
forall a. ShortByteString -> Int -> Ptr a -> Int -> IO ()
Sh.copyToPtr ShortByteString
sbs Int
ip Ptr Word8
op Int
outRemaining
let !ip' :: Int
ip' = Int
ip Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
outRemaining
BuildSignal a -> IO (BuildSignal a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSignal a -> IO (BuildSignal a))
-> BuildSignal a -> IO (BuildSignal a)
forall a b. (a -> b) -> a -> b
$ Int -> Ptr Word8 -> BuildStep a -> BuildSignal a
forall a. Int -> Ptr Word8 -> BuildStep a -> BuildSignal a
bufferFull Int
1 Ptr Word8
ope (Int -> Int -> BuildStep a
go Int
ip' Int
ipe)
where
outRemaining :: Int
outRemaining = Ptr Word8
ope Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
op
inpRemaining :: Int
inpRemaining = Int
ipe Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ip
{-# INLINE lazyByteStringThreshold #-}
lazyByteStringThreshold :: Int -> L.LazyByteString -> Builder
lazyByteStringThreshold :: Int -> LazyByteString -> Builder
lazyByteStringThreshold Int
maxCopySize =
(StrictByteString -> Builder -> Builder)
-> Builder -> LazyByteString -> Builder
forall a. (StrictByteString -> a -> a) -> a -> LazyByteString -> a
L.foldrChunks (\StrictByteString
bs Builder
b -> Int -> StrictByteString -> Builder
byteStringThreshold Int
maxCopySize StrictByteString
bs Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b) Builder
forall a. Monoid a => a
mempty
{-# INLINE lazyByteStringCopy #-}
lazyByteStringCopy :: L.LazyByteString -> Builder
lazyByteStringCopy :: LazyByteString -> Builder
lazyByteStringCopy =
(StrictByteString -> Builder -> Builder)
-> Builder -> LazyByteString -> Builder
forall a. (StrictByteString -> a -> a) -> a -> LazyByteString -> a
L.foldrChunks (\StrictByteString
bs Builder
b -> StrictByteString -> Builder
byteStringCopy StrictByteString
bs Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b) Builder
forall a. Monoid a => a
mempty
{-# INLINE lazyByteStringInsert #-}
lazyByteStringInsert :: L.LazyByteString -> Builder
lazyByteStringInsert :: LazyByteString -> Builder
lazyByteStringInsert =
(StrictByteString -> Builder -> Builder)
-> Builder -> LazyByteString -> Builder
forall a. (StrictByteString -> a -> a) -> a -> LazyByteString -> a
L.foldrChunks (\StrictByteString
bs Builder
b -> StrictByteString -> Builder
byteStringInsert StrictByteString
bs Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b) Builder
forall a. Monoid a => a
mempty
{-# INLINE byteString #-}
byteString :: S.StrictByteString -> Builder
byteString :: StrictByteString -> Builder
byteString = Int -> StrictByteString -> Builder
byteStringThreshold Int
maximalCopySize
{-# INLINE lazyByteString #-}
lazyByteString :: L.LazyByteString -> Builder
lazyByteString :: LazyByteString -> Builder
lazyByteString = Int -> LazyByteString -> Builder
lazyByteStringThreshold Int
maximalCopySize
maximalCopySize :: Int
maximalCopySize :: Int
maximalCopySize = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
L.smallChunkSize
data AllocationStrategy = AllocationStrategy
(Maybe (Buffer, Int) -> IO Buffer)
{-# UNPACK #-} !Int
(Int -> Int -> Bool)
{-# INLINE customStrategy #-}
customStrategy
:: (Maybe (Buffer, Int) -> IO Buffer)
-> Int
-> (Int -> Int -> Bool)
-> AllocationStrategy
customStrategy :: (Maybe (Buffer, Int) -> IO Buffer)
-> Int -> (Int -> Int -> Bool) -> AllocationStrategy
customStrategy = (Maybe (Buffer, Int) -> IO Buffer)
-> Int -> (Int -> Int -> Bool) -> AllocationStrategy
AllocationStrategy
{-# INLINE sanitize #-}
sanitize :: Int -> Int
sanitize :: Int -> Int
sanitize = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int -> Int
forall a. Storable a => a -> Int
sizeOf (Int
forall a. HasCallStack => a
undefined :: Int))
{-# INLINE untrimmedStrategy #-}
untrimmedStrategy :: Int
-> Int
-> AllocationStrategy
untrimmedStrategy :: Int -> Int -> AllocationStrategy
untrimmedStrategy Int
firstSize Int
bufSize =
(Maybe (Buffer, Int) -> IO Buffer)
-> Int -> (Int -> Int -> Bool) -> AllocationStrategy
AllocationStrategy Maybe (Buffer, Int) -> IO Buffer
forall {a}. Maybe (a, Int) -> IO Buffer
nextBuffer (Int -> Int
sanitize Int
bufSize) (\Int
_ Int
_ -> Bool
False)
where
{-# INLINE nextBuffer #-}
nextBuffer :: Maybe (a, Int) -> IO Buffer
nextBuffer Maybe (a, Int)
Nothing = Int -> IO Buffer
newBuffer (Int -> IO Buffer) -> Int -> IO Buffer
forall a b. (a -> b) -> a -> b
$ Int -> Int
sanitize Int
firstSize
nextBuffer (Just (a
_, Int
minSize)) = Int -> IO Buffer
newBuffer Int
minSize
{-# INLINE safeStrategy #-}
safeStrategy :: Int
-> Int
-> AllocationStrategy
safeStrategy :: Int -> Int -> AllocationStrategy
safeStrategy Int
firstSize Int
bufSize =
(Maybe (Buffer, Int) -> IO Buffer)
-> Int -> (Int -> Int -> Bool) -> AllocationStrategy
AllocationStrategy Maybe (Buffer, Int) -> IO Buffer
forall {a}. Maybe (a, Int) -> IO Buffer
nextBuffer (Int -> Int
sanitize Int
bufSize) Int -> Int -> Bool
forall {a}. (Ord a, Num a) => a -> a -> Bool
trim
where
trim :: a -> a -> Bool
trim a
used a
size = a
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
used a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
size
{-# INLINE nextBuffer #-}
nextBuffer :: Maybe (a, Int) -> IO Buffer
nextBuffer Maybe (a, Int)
Nothing = Int -> IO Buffer
newBuffer (Int -> IO Buffer) -> Int -> IO Buffer
forall a b. (a -> b) -> a -> b
$ Int -> Int
sanitize Int
firstSize
nextBuffer (Just (a
_, Int
minSize)) = Int -> IO Buffer
newBuffer Int
minSize
{-# INLINE toLazyByteStringWith #-}
toLazyByteStringWith
:: AllocationStrategy
-> L.LazyByteString
-> Builder
-> L.LazyByteString
toLazyByteStringWith :: AllocationStrategy -> LazyByteString -> Builder -> LazyByteString
toLazyByteStringWith AllocationStrategy
strategy LazyByteString
k Builder
b =
AllocationStrategy
-> LazyByteString -> ChunkIOStream () -> LazyByteString
ciosUnitToLazyByteString AllocationStrategy
strategy LazyByteString
k (ChunkIOStream () -> LazyByteString)
-> ChunkIOStream () -> LazyByteString
forall a b. (a -> b) -> a -> b
$ IO (ChunkIOStream ()) -> ChunkIOStream ()
forall a. IO a -> a
unsafeDupablePerformIO (IO (ChunkIOStream ()) -> ChunkIOStream ())
-> IO (ChunkIOStream ()) -> ChunkIOStream ()
forall a b. (a -> b) -> a -> b
$
AllocationStrategy -> BuildStep () -> IO (ChunkIOStream ())
forall a. AllocationStrategy -> BuildStep a -> IO (ChunkIOStream a)
buildStepToCIOS AllocationStrategy
strategy (Builder -> BuildStep ()
runBuilder Builder
b)
{-# INLINE buildStepToCIOS #-}
buildStepToCIOS
:: forall a.
AllocationStrategy
-> BuildStep a
-> IO (ChunkIOStream a)
buildStepToCIOS :: forall a. AllocationStrategy -> BuildStep a -> IO (ChunkIOStream a)
buildStepToCIOS (AllocationStrategy Maybe (Buffer, Int) -> IO Buffer
nextBuffer Int
bufSize Int -> Int -> Bool
trim) =
\BuildStep a
step -> Maybe (Buffer, Int) -> IO Buffer
nextBuffer Maybe (Buffer, Int)
forall a. Maybe a
Nothing IO Buffer
-> (Buffer -> IO (ChunkIOStream a)) -> IO (ChunkIOStream a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BuildStep a -> Buffer -> IO (ChunkIOStream a)
fill BuildStep a
step
where
fill :: BuildStep a -> Buffer -> IO (ChunkIOStream a)
fill :: BuildStep a -> Buffer -> IO (ChunkIOStream a)
fill !BuildStep a
step buf :: Buffer
buf@(Buffer ForeignPtr Word8
fpbuf br :: BufferRange
br@(BufferRange Ptr Word8
_ Ptr Word8
pe)) = do
ChunkIOStream a
res <- BuildStep a
-> (Ptr Word8 -> a -> IO (ChunkIOStream a))
-> (Ptr Word8 -> Int -> BuildStep a -> IO (ChunkIOStream a))
-> (Ptr Word8
-> StrictByteString -> BuildStep a -> IO (ChunkIOStream a))
-> BufferRange
-> IO (ChunkIOStream a)
forall a b.
BuildStep a
-> (Ptr Word8 -> a -> IO b)
-> (Ptr Word8 -> Int -> BuildStep a -> IO b)
-> (Ptr Word8 -> StrictByteString -> BuildStep a -> IO b)
-> BufferRange
-> IO b
fillWithBuildStep BuildStep a
step Ptr Word8 -> a -> IO (ChunkIOStream a)
doneH Ptr Word8 -> Int -> BuildStep a -> IO (ChunkIOStream a)
fullH Ptr Word8
-> StrictByteString -> BuildStep a -> IO (ChunkIOStream a)
insertChunkH BufferRange
br
ForeignPtr Word8 -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Word8
fpbuf
ChunkIOStream a -> IO (ChunkIOStream a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ChunkIOStream a
res
where
pbuf :: Ptr Word8
pbuf :: Ptr Word8
pbuf = ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fpbuf
doneH :: Ptr Word8 -> a -> IO (ChunkIOStream a)
doneH :: Ptr Word8 -> a -> IO (ChunkIOStream a)
doneH Ptr Word8
op' a
x = ChunkIOStream a -> IO (ChunkIOStream a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChunkIOStream a -> IO (ChunkIOStream a))
-> ChunkIOStream a -> IO (ChunkIOStream a)
forall a b. (a -> b) -> a -> b
$
Buffer -> a -> ChunkIOStream a
forall a. Buffer -> a -> ChunkIOStream a
Finished (ForeignPtr Word8 -> BufferRange -> Buffer
Buffer ForeignPtr Word8
fpbuf (Ptr Word8 -> Ptr Word8 -> BufferRange
BufferRange Ptr Word8
op' Ptr Word8
pe)) a
x
fullH :: Ptr Word8 -> Int -> BuildStep a -> IO (ChunkIOStream a)
fullH :: Ptr Word8 -> Int -> BuildStep a -> IO (ChunkIOStream a)
fullH Ptr Word8
op' Int
minSize BuildStep a
nextStep =
Ptr Word8 -> (Bool -> IO (ChunkIOStream a)) -> IO (ChunkIOStream a)
wrapChunk Ptr Word8
op' ((Bool -> IO (ChunkIOStream a)) -> IO (ChunkIOStream a))
-> (Bool -> IO (ChunkIOStream a)) -> IO (ChunkIOStream a)
forall a b. (a -> b) -> a -> b
$ IO (ChunkIOStream a) -> Bool -> IO (ChunkIOStream a)
forall a b. a -> b -> a
const (IO (ChunkIOStream a) -> Bool -> IO (ChunkIOStream a))
-> IO (ChunkIOStream a) -> Bool -> IO (ChunkIOStream a)
forall a b. (a -> b) -> a -> b
$
Maybe (Buffer, Int) -> IO Buffer
nextBuffer ((Buffer, Int) -> Maybe (Buffer, Int)
forall a. a -> Maybe a
Just (Buffer
buf, Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
minSize Int
bufSize)) IO Buffer
-> (Buffer -> IO (ChunkIOStream a)) -> IO (ChunkIOStream a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BuildStep a -> Buffer -> IO (ChunkIOStream a)
fill BuildStep a
nextStep
insertChunkH :: Ptr Word8 -> S.StrictByteString -> BuildStep a -> IO (ChunkIOStream a)
insertChunkH :: Ptr Word8
-> StrictByteString -> BuildStep a -> IO (ChunkIOStream a)
insertChunkH Ptr Word8
op' StrictByteString
bs BuildStep a
nextStep =
Ptr Word8 -> (Bool -> IO (ChunkIOStream a)) -> IO (ChunkIOStream a)
wrapChunk Ptr Word8
op' ((Bool -> IO (ChunkIOStream a)) -> IO (ChunkIOStream a))
-> (Bool -> IO (ChunkIOStream a)) -> IO (ChunkIOStream a)
forall a b. (a -> b) -> a -> b
$ \Bool
isEmpty -> StrictByteString -> IO (ChunkIOStream a) -> IO (ChunkIOStream a)
forall a.
StrictByteString -> IO (ChunkIOStream a) -> IO (ChunkIOStream a)
yield1 StrictByteString
bs (IO (ChunkIOStream a) -> IO (ChunkIOStream a))
-> IO (ChunkIOStream a) -> IO (ChunkIOStream a)
forall a b. (a -> b) -> a -> b
$
if Bool
isEmpty
then BuildStep a -> Buffer -> IO (ChunkIOStream a)
fill BuildStep a
nextStep (ForeignPtr Word8 -> BufferRange -> Buffer
Buffer ForeignPtr Word8
fpbuf (Ptr Word8 -> Ptr Word8 -> BufferRange
BufferRange Ptr Word8
pbuf Ptr Word8
pe))
else do Buffer
buf' <- Maybe (Buffer, Int) -> IO Buffer
nextBuffer ((Buffer, Int) -> Maybe (Buffer, Int)
forall a. a -> Maybe a
Just (Buffer
buf, Int
bufSize))
BuildStep a -> Buffer -> IO (ChunkIOStream a)
fill BuildStep a
nextStep Buffer
buf'
{-# INLINE wrapChunk #-}
wrapChunk :: Ptr Word8 -> (Bool -> IO (ChunkIOStream a)) -> IO (ChunkIOStream a)
wrapChunk :: Ptr Word8 -> (Bool -> IO (ChunkIOStream a)) -> IO (ChunkIOStream a)
wrapChunk !Ptr Word8
op' Bool -> IO (ChunkIOStream a)
mkCIOS
| Int
chunkSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Bool -> IO (ChunkIOStream a)
mkCIOS Bool
True
| Int -> Int -> Bool
trim Int
chunkSize Int
size = do
StrictByteString
bs <- Int -> (ForeignPtr Word8 -> IO ()) -> IO StrictByteString
S.createFp Int
chunkSize ((ForeignPtr Word8 -> IO ()) -> IO StrictByteString)
-> (ForeignPtr Word8 -> IO ()) -> IO StrictByteString
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
fpbuf' ->
ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
S.memcpyFp ForeignPtr Word8
fpbuf' ForeignPtr Word8
fpbuf Int
chunkSize
ChunkIOStream a -> IO (ChunkIOStream a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChunkIOStream a -> IO (ChunkIOStream a))
-> ChunkIOStream a -> IO (ChunkIOStream a)
forall a b. (a -> b) -> a -> b
$ StrictByteString -> IO (ChunkIOStream a) -> ChunkIOStream a
forall a.
StrictByteString -> IO (ChunkIOStream a) -> ChunkIOStream a
Yield1 StrictByteString
bs (Bool -> IO (ChunkIOStream a)
mkCIOS Bool
True)
| Bool
otherwise =
ChunkIOStream a -> IO (ChunkIOStream a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChunkIOStream a -> IO (ChunkIOStream a))
-> ChunkIOStream a -> IO (ChunkIOStream a)
forall a b. (a -> b) -> a -> b
$ StrictByteString -> IO (ChunkIOStream a) -> ChunkIOStream a
forall a.
StrictByteString -> IO (ChunkIOStream a) -> ChunkIOStream a
Yield1 (ForeignPtr Word8 -> Int -> StrictByteString
S.BS ForeignPtr Word8
fpbuf Int
chunkSize) (Bool -> IO (ChunkIOStream a)
mkCIOS Bool
False)
where
chunkSize :: Int
chunkSize = Ptr Word8
op' Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
pbuf
size :: Int
size = Ptr Word8
pe Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
pbuf