{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE CPP #-}
module Mason.Builder.Internal (Builder
, BuilderFor(..)
, BState
, Buildable(..)
, GrowingBuffer(..)
, Buffer(..)
, pattern Builder
, unBuilder
, byteStringCopy
, shortByteString
, StrictByteStringBackend
, toStrictByteString
, Channel(..)
, LazyByteStringBackend
, toLazyByteString
, withPopper
, StreamingBackend(..)
, toStreamingBody
, stringUtf8
, lengthPrefixedWithin
, primBounded
, primFixed
, primMapListFixed
, primMapListBounded
, primMapByteStringFixed
, primMapLazyByteStringFixed
, PutEnv(..)
, BufferedIOBackend
, hPutBuilderLen
, encodeUtf8BuilderEscaped
, sendBuilder
, cstring
, cstringUtf8
, withPtr
, storable
, paddedBoundedPrim
, zeroPaddedBoundedPrim
, ensure
, allocateConstant
, withGrisu3
, withGrisu3Rounded
, roundDigit
) where
import Control.Concurrent
import Control.Exception (throw)
import Control.Monad
import qualified Data.ByteString as B
import qualified Data.ByteString.Short.Internal as SB
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Internal as BL
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Builder.Prim as P
import qualified Data.ByteString.Builder.Prim.Internal as B
import System.IO
import Foreign.C.Types
import Foreign.Ptr
import Foreign.ForeignPtr.Unsafe
import Foreign.ForeignPtr
import Foreign.Marshal.Array (allocaArray)
import Data.IORef
import Data.Word (Word8)
import Data.String
import Foreign.Storable as S
import System.IO.Unsafe
import qualified Data.Text.Array as A
import qualified Data.Text.Internal as T
import qualified Network.Socket as S
import GHC.Prim (plusAddr#, indexWord8OffAddr#, RealWorld, Addr#, State# )
import GHC.Ptr (Ptr(..))
import GHC.Word (Word8(..))
import GHC.Base (unpackCString#, unpackCStringUtf8#, unpackFoldrCString#, build, IO(..), unIO)
#if MIN_VERSION_text(2,0,0)
#else
import Data.Bits ((.&.), shiftR)
import Data.Text.Internal.Unsafe.Char (ord)
import qualified Data.Text.Internal.Encoding.Utf16 as U16
#endif
unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr :: forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr a
fo Ptr a -> IO b
f = do
b
r <- Ptr a -> IO b
f (forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
fo)
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
fo
forall (m :: * -> *) a. Monad m => a -> m a
return b
r
type Builder = forall s. Buildable s => BuilderFor s
newtype BuilderFor s = RawBuilder { forall s. BuilderFor s -> s -> BState -> BState
unRawBuilder :: s -> BState -> BState }
unBuilder :: BuilderFor s -> s -> Buffer -> IO Buffer
unBuilder :: forall s. BuilderFor s -> s -> Buffer -> IO Buffer
unBuilder (RawBuilder s -> BState -> BState
f) = \s
env (Buffer (Ptr Addr#
ptr) (Ptr Addr#
end)) -> forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
s -> case s -> BState -> BState
f s
env (# Addr#
ptr, Addr#
end, State# RealWorld
s #) of
(# Addr#
ptr', Addr#
end', State# RealWorld
s' #) -> (# State# RealWorld
s', Ptr Word8 -> Ptr Word8 -> Buffer
Buffer (forall a. Addr# -> Ptr a
Ptr Addr#
ptr') (forall a. Addr# -> Ptr a
Ptr Addr#
end') #))
{-# INLINE unBuilder #-}
pattern Builder :: (s -> Buffer -> IO Buffer) -> BuilderFor s
pattern $bBuilder :: forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
$mBuilder :: forall {r} {s}.
BuilderFor s
-> ((s -> Buffer -> IO Buffer) -> r) -> ((# #) -> r) -> r
Builder f <- (unBuilder -> f) where
Builder s -> Buffer -> IO Buffer
f = forall s. (s -> BState -> BState) -> BuilderFor s
RawBuilder forall a b. (a -> b) -> a -> b
$ \s
env (# Addr#
ptr, Addr#
end, State# RealWorld
s #) -> case forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (s -> Buffer -> IO Buffer
f s
env (Ptr Word8 -> Ptr Word8 -> Buffer
Buffer (forall a. Addr# -> Ptr a
Ptr Addr#
ptr) (forall a. Addr# -> Ptr a
Ptr Addr#
end))) State# RealWorld
s of
(# State# RealWorld
s', Buffer (Ptr Addr#
ptr') (Ptr Addr#
end') #) -> (# Addr#
ptr', Addr#
end', State# RealWorld
s' #)
{-# COMPLETE Builder #-}
type BState = (#Addr#, Addr#, State# RealWorld #)
class Buildable s where
byteString :: B.ByteString -> BuilderFor s
byteString = forall s. Buildable s => ByteString -> BuilderFor s
byteStringCopy
{-# INLINE byteString #-}
flush :: BuilderFor s
allocate :: Int -> BuilderFor s
data Buffer = Buffer
{ Buffer -> Ptr Word8
bEnd :: {-# UNPACK #-} !(Ptr Word8)
, Buffer -> Ptr Word8
bCur :: {-# UNPACK #-} !(Ptr Word8)
}
byteStringCopy :: Buildable s => B.ByteString -> BuilderFor s
byteStringCopy :: forall s. Buildable s => ByteString -> BuilderFor s
byteStringCopy = \(B.PS ForeignPtr Word8
fsrc Int
ofs Int
len) -> forall s.
Buildable s =>
Int -> (Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s
withPtr Int
len forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fsrc forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
B.memcpy Ptr Word8
ptr (Ptr Word8
src forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
ofs) Int
len
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
{-# INLINE byteStringCopy #-}
shortByteString :: SB.ShortByteString -> Builder
shortByteString :: ShortByteString -> Builder
shortByteString = \ShortByteString
src -> let len :: Int
len = ShortByteString -> Int
SB.length ShortByteString
src in forall s.
Buildable s =>
Int -> (Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s
withPtr Int
len forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
len forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. ShortByteString -> Int -> Ptr a -> Int -> IO ()
SB.copyToPtr ShortByteString
src Int
0 Ptr Word8
ptr Int
len
{-# INLINE shortByteString #-}
withPtr :: Buildable s
=> Int
-> (Ptr Word8 -> IO (Ptr Word8))
-> BuilderFor s
withPtr :: forall s.
Buildable s =>
Int -> (Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s
withPtr Int
n Ptr Word8 -> IO (Ptr Word8)
f = Int -> (Buffer -> IO Buffer) -> Builder
ensure Int
n forall a b. (a -> b) -> a -> b
$ \(Buffer Ptr Word8
e Ptr Word8
p) -> Ptr Word8 -> Ptr Word8 -> Buffer
Buffer Ptr Word8
e forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> IO (Ptr Word8)
f Ptr Word8
p
{-# INLINE withPtr #-}
storable :: Storable a => a -> Builder
storable :: forall a. Storable a => a -> Builder
storable a
a = forall s.
Buildable s =>
Int -> (Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s
withPtr (forall a. Storable a => a -> Int
sizeOf a
a) forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p (forall a. Storable a => a -> Int
sizeOf a
a) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p) a
a
{-# INLINE storable #-}
ensure :: Int -> (Buffer -> IO Buffer) -> Builder
ensure :: Int -> (Buffer -> IO Buffer) -> Builder
ensure Int
mlen Buffer -> IO Buffer
cont = forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
Builder forall a b. (a -> b) -> a -> b
$ \s
env buf :: Buffer
buf@(Buffer Ptr Word8
end Ptr Word8
ptr) ->
if Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
mlen forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end
then do
buf' :: Buffer
buf'@(Buffer Ptr Word8
end' Ptr Word8
ptr') <- forall s. BuilderFor s -> s -> Buffer -> IO Buffer
unBuilder Builder
flush s
env Buffer
buf
if Int
mlen forall a. Ord a => a -> a -> Bool
<= forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
end' Ptr Word8
ptr'
then Buffer -> IO Buffer
cont Buffer
buf'
else forall s. BuilderFor s -> s -> Buffer -> IO Buffer
unBuilder (forall s. Buildable s => Int -> BuilderFor s
allocate Int
mlen) s
env Buffer
buf' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Buffer -> IO Buffer
cont
else Buffer -> IO Buffer
cont Buffer
buf
{-# INLINE[1] ensure #-}
{-# RULES "<>/ensure" forall m n f g. ensure m f <> ensure n g = ensure (m + n) (f >=> g) #-}
lengthPrefixedWithin :: Int
-> B.BoundedPrim Int
-> BuilderFor () -> Builder
lengthPrefixedWithin :: Int -> BoundedPrim Int -> BuilderFor () -> Builder
lengthPrefixedWithin Int
maxLen BoundedPrim Int
bp BuilderFor ()
builder = Int -> (Buffer -> IO Buffer) -> Builder
ensure (forall a. BoundedPrim a -> Int
B.sizeBound BoundedPrim Int
bp forall a. Num a => a -> a -> a
+ Int
maxLen) forall a b. (a -> b) -> a -> b
$ \(Buffer Ptr Word8
end Ptr Word8
origin) -> do
let base :: Ptr Word8
base = Ptr Word8
origin forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. BoundedPrim a -> Int
B.sizeBound BoundedPrim Int
bp
Buffer Ptr Word8
_ Ptr Word8
base' <- forall s. BuilderFor s -> s -> Buffer -> IO Buffer
unBuilder BuilderFor ()
builder () (Ptr Word8 -> Ptr Word8 -> Buffer
Buffer Ptr Word8
end Ptr Word8
base)
let len :: Int
len = forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
base' Ptr Word8
base
Ptr Word8
newBase <- forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
B.runB BoundedPrim Int
bp Int
len Ptr Word8
origin
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
c_memmove Ptr Word8
newBase Ptr Word8
base Int
len
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Ptr Word8 -> Buffer
Buffer Ptr Word8
end (Ptr Word8
newBase forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len)
{-# INLINE lengthPrefixedWithin #-}
instance Buildable () where
byteString :: ByteString -> BuilderFor ()
byteString = forall s. Buildable s => ByteString -> BuilderFor s
byteStringCopy
{-# INLINE byteString #-}
flush :: BuilderFor ()
flush = forall a. Monoid a => a
mempty
{-# INLINE flush #-}
allocate :: Int -> BuilderFor ()
allocate Int
_ = forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
Builder forall a b. (a -> b) -> a -> b
$ \()
_ Buffer
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Mason.Builder.Internal.allocate: can't allocate"
{-# INLINE allocate #-}
instance Semigroup (BuilderFor s) where
RawBuilder s -> BState -> BState
f <> :: BuilderFor s -> BuilderFor s -> BuilderFor s
<> RawBuilder s -> BState -> BState
g = forall s. (s -> BState -> BState) -> BuilderFor s
RawBuilder forall a b. (a -> b) -> a -> b
$ \s
e BState
s -> s -> BState -> BState
g s
e (s -> BState -> BState
f s
e BState
s)
{-# INLINE[1] (<>) #-}
instance Monoid (BuilderFor a) where
mempty :: BuilderFor a
mempty = forall s. (s -> BState -> BState) -> BuilderFor s
RawBuilder (\a
_ BState
s -> BState
s)
{-# INLINE mempty #-}
stringUtf8 :: Buildable s => String -> BuilderFor s
stringUtf8 :: forall s. Buildable s => String -> BuilderFor s
stringUtf8 = forall s a. Buildable s => BoundedPrim a -> [a] -> BuilderFor s
primMapListBounded BoundedPrim Char
P.charUtf8
{-# INLINE [1] stringUtf8 #-}
{-# RULES
"stringUtf8/unpackCStringUtf8#" forall s.
stringUtf8 (unpackCStringUtf8# s) = cstringUtf8 (Ptr s)
"stringUtf8/unpackCString#" forall s.
stringUtf8 (unpackCString# s) = cstring (Ptr s)
"stringUtf8/unpackFoldrCString#" forall s.
stringUtf8 (build (unpackFoldrCString# s)) = cstring (Ptr s)
#-}
cstring :: Ptr Word8 -> Builder
cstring :: Ptr Word8 -> Builder
cstring (Ptr Addr#
addr0) = forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
Builder forall a b. (a -> b) -> a -> b
$ forall {s}. Buildable s => Addr# -> s -> Buffer -> IO Buffer
step Addr#
addr0
where
step :: Addr# -> s -> Buffer -> IO Buffer
step Addr#
addr s
env br :: Buffer
br@(Buffer Ptr Word8
end Ptr Word8
ptr)
| Word8# -> Word8
W8# Word8#
ch forall a. Eq a => a -> a -> Bool
== Word8
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Buffer
br
| Ptr Word8
ptr forall a. Eq a => a -> a -> Bool
== Ptr Word8
end = forall s. BuilderFor s -> s -> Buffer -> IO Buffer
unBuilder (Int -> (Buffer -> IO Buffer) -> Builder
ensure Int
3 forall a b. (a -> b) -> a -> b
$ Addr# -> s -> Buffer -> IO Buffer
step Addr#
addr s
env) s
env Buffer
br
| Bool
otherwise = do
forall a. Storable a => Ptr a -> a -> IO ()
S.poke Ptr Word8
ptr (Word8# -> Word8
W8# Word8#
ch)
let br' :: Buffer
br' = Ptr Word8 -> Ptr Word8 -> Buffer
Buffer Ptr Word8
end (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
Addr# -> s -> Buffer -> IO Buffer
step (Addr#
addr Addr# -> Int# -> Addr#
`plusAddr#` Int#
1#) s
env Buffer
br'
where
!ch :: Word8#
ch = Addr# -> Int# -> Word8#
indexWord8OffAddr# Addr#
addr Int#
0#
{-# INLINE cstring #-}
cstringUtf8 :: Ptr Word8 -> Builder
cstringUtf8 :: Ptr Word8 -> Builder
cstringUtf8 (Ptr Addr#
addr0) = forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
Builder forall a b. (a -> b) -> a -> b
$ forall {s}. Buildable s => Addr# -> s -> Buffer -> IO Buffer
step Addr#
addr0
where
step :: Addr# -> s -> Buffer -> IO Buffer
step Addr#
addr s
env br :: Buffer
br@(Buffer Ptr Word8
end Ptr Word8
ptr)
| Word8# -> Word8
W8# Word8#
ch forall a. Eq a => a -> a -> Bool
== Word8
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Buffer
br
| Ptr Word8
ptr forall a. Eq a => a -> a -> Bool
== Ptr Word8
end = forall s. BuilderFor s -> s -> Buffer -> IO Buffer
unBuilder (Int -> (Buffer -> IO Buffer) -> Builder
ensure Int
3 forall a b. (a -> b) -> a -> b
$ Addr# -> s -> Buffer -> IO Buffer
step Addr#
addr s
env) s
env Buffer
br
| Word8# -> Word8
W8# Word8#
ch forall a. Eq a => a -> a -> Bool
== Word8
0xc0
, Word8# -> Word8
W8# (Addr# -> Int# -> Word8#
indexWord8OffAddr# Addr#
addr Int#
1#) forall a. Eq a => a -> a -> Bool
== Word8
0x80 = do
forall a. Storable a => Ptr a -> a -> IO ()
S.poke Ptr Word8
ptr Word8
0
Addr# -> s -> Buffer -> IO Buffer
step (Addr#
addr Addr# -> Int# -> Addr#
`plusAddr#` Int#
2#) s
env (Ptr Word8 -> Ptr Word8 -> Buffer
Buffer Ptr Word8
end (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1))
| Bool
otherwise = do
forall a. Storable a => Ptr a -> a -> IO ()
S.poke Ptr Word8
ptr (Word8# -> Word8
W8# Word8#
ch)
Addr# -> s -> Buffer -> IO Buffer
step (Addr#
addr Addr# -> Int# -> Addr#
`plusAddr#` Int#
1#) s
env (Ptr Word8 -> Ptr Word8 -> Buffer
Buffer Ptr Word8
end (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1))
where
!ch :: Word8#
ch = Addr# -> Int# -> Word8#
indexWord8OffAddr# Addr#
addr Int#
0#
{-# INLINE cstringUtf8 #-}
instance Buildable s => IsString (BuilderFor s) where
fromString :: String -> BuilderFor s
fromString = forall s. Buildable s => String -> BuilderFor s
stringUtf8
{-# INLINE fromString #-}
primBounded :: Buildable s => B.BoundedPrim a -> a -> BuilderFor s
primBounded :: forall s a. Buildable s => BoundedPrim a -> a -> BuilderFor s
primBounded BoundedPrim a
bp = forall s.
Buildable s =>
Int -> (Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s
withPtr (forall a. BoundedPrim a -> Int
B.sizeBound BoundedPrim a
bp) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
B.runB BoundedPrim a
bp
{-# INLINE primBounded #-}
primFixed :: Buildable s => B.FixedPrim a -> a -> BuilderFor s
primFixed :: forall s a. Buildable s => FixedPrim a -> a -> BuilderFor s
primFixed FixedPrim a
fp a
a = forall s.
Buildable s =>
Int -> (Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s
withPtr (forall a. FixedPrim a -> Int
B.size FixedPrim a
fp) forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. FixedPrim a -> Int
B.size FixedPrim a
fp) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. FixedPrim a -> a -> Ptr Word8 -> IO ()
B.runF FixedPrim a
fp a
a Ptr Word8
ptr
{-# INLINE primFixed #-}
primMapListFixed :: (Foldable t, Buildable s) => B.FixedPrim a -> t a -> BuilderFor s
primMapListFixed :: forall (t :: * -> *) s a.
(Foldable t, Buildable s) =>
FixedPrim a -> t a -> BuilderFor s
primMapListFixed FixedPrim a
fp = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall s a. Buildable s => FixedPrim a -> a -> BuilderFor s
primFixed FixedPrim a
fp)
{-# INLINE primMapListFixed #-}
primMapListBounded :: Buildable s => B.BoundedPrim a -> [a] -> BuilderFor s
primMapListBounded :: forall s a. Buildable s => BoundedPrim a -> [a] -> BuilderFor s
primMapListBounded BoundedPrim a
bp = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall s a. Buildable s => BoundedPrim a -> a -> BuilderFor s
primBounded BoundedPrim a
bp)
{-# INLINE primMapListBounded #-}
primMapByteStringFixed :: Buildable s => B.FixedPrim Word8 -> B.ByteString -> BuilderFor s
primMapByteStringFixed :: forall s.
Buildable s =>
FixedPrim Word8 -> ByteString -> BuilderFor s
primMapByteStringFixed FixedPrim Word8
fp = forall a. (Word8 -> a -> a) -> a -> ByteString -> a
B.foldr (forall a. Monoid a => a -> a -> a
mappend forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. Buildable s => FixedPrim a -> a -> BuilderFor s
primFixed FixedPrim Word8
fp) forall a. Monoid a => a
mempty
{-# INLINE primMapByteStringFixed #-}
primMapLazyByteStringFixed :: Buildable s => B.FixedPrim Word8 -> BL.ByteString -> BuilderFor s
primMapLazyByteStringFixed :: forall s.
Buildable s =>
FixedPrim Word8 -> ByteString -> BuilderFor s
primMapLazyByteStringFixed FixedPrim Word8
fp = forall a. (Word8 -> a -> a) -> a -> ByteString -> a
BL.foldr (forall a. Monoid a => a -> a -> a
mappend forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. Buildable s => FixedPrim a -> a -> BuilderFor s
primFixed FixedPrim Word8
fp) forall a. Monoid a => a
mempty
{-# INLINE primMapLazyByteStringFixed #-}
paddedBoundedPrim
:: Word8
-> Int
-> B.BoundedPrim a
-> a
-> Builder
paddedBoundedPrim :: forall a. Word8 -> Int -> BoundedPrim a -> a -> Builder
paddedBoundedPrim Word8
ch Int
size BoundedPrim a
bp a
a = Int -> (Buffer -> IO Buffer) -> Builder
ensure (forall a. BoundedPrim a -> Int
B.sizeBound BoundedPrim a
bp) forall a b. (a -> b) -> a -> b
$ \(Buffer Ptr Word8
end Ptr Word8
ptr) -> do
Ptr Word8
ptr' <- forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
B.runB BoundedPrim a
bp a
a Ptr Word8
ptr
let len :: Int
len = Ptr Word8
ptr' forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
ptr
let pad :: Int
pad = Int
size forall a. Num a => a -> a -> a
- Int
len
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
pad forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ do
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
c_memmove (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
pad) Ptr Word8
ptr Int
len
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
B.memset Ptr Word8
ptr Word8
ch (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pad)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Ptr Word8 -> Buffer
Buffer Ptr Word8
end forall a b. (a -> b) -> a -> b
$ Ptr Word8
ptr' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Ord a => a -> a -> a
max Int
pad Int
0
zeroPaddedBoundedPrim :: Int -> B.BoundedPrim a -> a -> Builder
zeroPaddedBoundedPrim :: forall a. Int -> BoundedPrim a -> a -> Builder
zeroPaddedBoundedPrim = forall a. Word8 -> Int -> BoundedPrim a -> a -> Builder
paddedBoundedPrim Word8
48
newtype GrowingBuffer = GrowingBuffer (IORef (ForeignPtr Word8))
instance Buildable GrowingBuffer where
byteString :: ByteString -> BuilderFor GrowingBuffer
byteString = forall s. Buildable s => ByteString -> BuilderFor s
byteStringCopy
{-# INLINE byteString #-}
flush :: BuilderFor GrowingBuffer
flush = forall a. Monoid a => a
mempty
{-# INLINE flush #-}
allocate :: Int -> BuilderFor GrowingBuffer
allocate Int
len = forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
Builder forall a b. (a -> b) -> a -> b
$ \(GrowingBuffer IORef (ForeignPtr Word8)
bufferRef) (Buffer Ptr Word8
_ Ptr Word8
dst) -> do
ForeignPtr Word8
fptr0 <- forall a. IORef a -> IO a
readIORef IORef (ForeignPtr Word8)
bufferRef
let ptr0 :: Ptr Word8
ptr0 = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fptr0
let !pos :: Int
pos = Ptr Word8
dst forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
ptr0
let !size' :: Int
size' = Int
pos forall a. Num a => a -> a -> a
+ forall a. Ord a => a -> a -> a
max Int
len Int
pos
ForeignPtr Word8
fptr <- forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
size'
let !dst' :: Ptr Word8
dst' = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fptr
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
B.memcpy Ptr Word8
dst' Ptr Word8
ptr0 Int
pos
forall a. IORef a -> a -> IO ()
writeIORef IORef (ForeignPtr Word8)
bufferRef ForeignPtr Word8
fptr
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Ptr Word8 -> Buffer
Buffer (Ptr Word8
dst' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
size') (Ptr Word8
dst' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
pos)
{-# INLINE allocate #-}
type StrictByteStringBackend = GrowingBuffer
toStrictByteString :: BuilderFor StrictByteStringBackend -> B.ByteString
toStrictByteString :: BuilderFor GrowingBuffer -> ByteString
toStrictByteString BuilderFor GrowingBuffer
b = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
ForeignPtr Word8
fptr0 <- forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
initialSize
IORef (ForeignPtr Word8)
bufferRef <- forall a. a -> IO (IORef a)
newIORef ForeignPtr Word8
fptr0
let ptr0 :: Ptr Word8
ptr0 = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fptr0
Buffer Ptr Word8
_ Ptr Word8
pos <- forall s. BuilderFor s -> s -> Buffer -> IO Buffer
unBuilder BuilderFor GrowingBuffer
b (IORef (ForeignPtr Word8) -> GrowingBuffer
GrowingBuffer IORef (ForeignPtr Word8)
bufferRef)
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Ptr Word8 -> Buffer
Buffer (Ptr Word8
ptr0 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
initialSize) Ptr Word8
ptr0
ForeignPtr Word8
fptr <- forall a. IORef a -> IO a
readIORef IORef (ForeignPtr Word8)
bufferRef
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS ForeignPtr Word8
fptr Int
0 (Ptr Word8
pos forall a b. Ptr a -> Ptr b -> Int
`minusPtr` forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fptr)
where
initialSize :: Int
initialSize = Int
128
{-# INLINE toStrictByteString #-}
data Channel = Channel
{ Channel -> MVar ByteString
chResp :: !(MVar B.ByteString)
, Channel -> IORef (ForeignPtr Word8)
chBuffer :: !(IORef (ForeignPtr Word8))
}
instance Buildable Channel where
byteString :: ByteString -> BuilderFor Channel
byteString ByteString
bs
| ByteString -> Int
B.length ByteString
bs forall a. Ord a => a -> a -> Bool
< Int
4096 = forall s. Buildable s => ByteString -> BuilderFor s
byteStringCopy ByteString
bs
| Bool
otherwise = Builder
flush forall a. Semigroup a => a -> a -> a
<> forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
Builder (\(Channel MVar ByteString
v IORef (ForeignPtr Word8)
_) Buffer
b -> Buffer
b forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. MVar a -> a -> IO ()
putMVar MVar ByteString
v ByteString
bs)
{-# INLINE byteString #-}
flush :: BuilderFor Channel
flush = forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
Builder forall a b. (a -> b) -> a -> b
$ \(Channel MVar ByteString
v IORef (ForeignPtr Word8)
ref) (Buffer Ptr Word8
end Ptr Word8
ptr) -> do
Ptr Word8
ptr0 <- forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef (ForeignPtr Word8)
ref
let len :: Int
len = forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
ptr Ptr Word8
ptr0
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ do
ForeignPtr Word8
bs <- forall a. Int -> IO (ForeignPtr a)
B.mallocByteString Int
len
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
bs forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
B.memcpy Ptr Word8
dst Ptr Word8
ptr0 Int
len
forall a. MVar a -> a -> IO ()
putMVar MVar ByteString
v forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS ForeignPtr Word8
bs Int
0 Int
len
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Ptr Word8 -> Ptr Word8 -> Buffer
Buffer Ptr Word8
end Ptr Word8
ptr0
{-# INLINE flush #-}
allocate :: Int -> BuilderFor Channel
allocate = forall s. (s -> IORef (ForeignPtr Word8)) -> Int -> BuilderFor s
allocateConstant Channel -> IORef (ForeignPtr Word8)
chBuffer
{-# INLINE allocate #-}
type LazyByteStringBackend = Channel
toLazyByteString :: BuilderFor LazyByteStringBackend -> BL.ByteString
toLazyByteString :: BuilderFor Channel -> ByteString
toLazyByteString BuilderFor Channel
body = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. BuilderFor Channel -> (IO ByteString -> IO a) -> IO a
withPopper BuilderFor Channel
body forall a b. (a -> b) -> a -> b
$ \IO ByteString
pop -> do
let go :: () -> IO ByteString
go ()
_ = do
ByteString
bs <- IO ByteString
pop
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! if ByteString -> Bool
B.null ByteString
bs
then ByteString
BL.empty
else ByteString -> ByteString -> ByteString
BL.Chunk ByteString
bs forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ () -> IO ByteString
go ()
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ () -> IO ByteString
go ()
{-# INLINE toLazyByteString #-}
withPopper :: BuilderFor LazyByteStringBackend -> (IO B.ByteString -> IO a) -> IO a
withPopper :: forall a. BuilderFor Channel -> (IO ByteString -> IO a) -> IO a
withPopper BuilderFor Channel
body IO ByteString -> IO a
cont = do
MVar ByteString
resp <- forall a. IO (MVar a)
newEmptyMVar
let initialSize :: Int
initialSize = Int
4080
ForeignPtr Word8
fptr <- forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
initialSize
IORef (ForeignPtr Word8)
ref <- forall a. a -> IO (IORef a)
newIORef ForeignPtr Word8
fptr
let ptr :: Ptr Word8
ptr = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fptr
let final :: Either SomeException Buffer -> IO ()
final (Left SomeException
e) = forall a. MVar a -> a -> IO ()
putMVar MVar ByteString
resp (forall a e. Exception e => e -> a
throw SomeException
e)
final (Right Buffer
_) = forall a. MVar a -> a -> IO ()
putMVar MVar ByteString
resp ByteString
B.empty
ThreadId
_ <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forkFinally Either SomeException Buffer -> IO ()
final forall a b. (a -> b) -> a -> b
$ forall s. BuilderFor s -> s -> Buffer -> IO Buffer
unBuilder (BuilderFor Channel
body forall a. Semigroup a => a -> a -> a
<> Builder
flush) (MVar ByteString -> IORef (ForeignPtr Word8) -> Channel
Channel MVar ByteString
resp IORef (ForeignPtr Word8)
ref)
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Ptr Word8 -> Buffer
Buffer (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
initialSize) Ptr Word8
ptr
IO ByteString -> IO a
cont forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
takeMVar MVar ByteString
resp
{-# INLINE withPopper #-}
data PutEnv = PutEnv
{ BufferedIOBackend -> Int
peThreshold :: !Int
, BufferedIOBackend -> Ptr Word8 -> Ptr Word8 -> IO ()
pePut :: !(Ptr Word8 -> Ptr Word8 -> IO ())
, BufferedIOBackend -> IORef (ForeignPtr Word8)
peBuffer :: !(IORef (ForeignPtr Word8))
, BufferedIOBackend -> IORef Int
peTotal :: !(IORef Int)
}
allocateConstant :: (s -> IORef (ForeignPtr Word8)) -> Int -> BuilderFor s
allocateConstant :: forall s. (s -> IORef (ForeignPtr Word8)) -> Int -> BuilderFor s
allocateConstant s -> IORef (ForeignPtr Word8)
f Int
len = forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
Builder forall a b. (a -> b) -> a -> b
$ \s
env (Buffer Ptr Word8
_ Ptr Word8
_) -> do
ForeignPtr Word8
fptr <- forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
len
forall a. IORef a -> a -> IO ()
writeIORef (s -> IORef (ForeignPtr Word8)
f s
env) ForeignPtr Word8
fptr
let ptr1 :: Ptr Word8
ptr1 = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fptr
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Ptr Word8 -> Ptr Word8 -> Buffer
Buffer (Ptr Word8
ptr1 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len) Ptr Word8
ptr1
{-# INLINE allocateConstant #-}
instance Buildable PutEnv where
byteString :: ByteString -> BuilderFor BufferedIOBackend
byteString bs :: ByteString
bs@(B.PS ForeignPtr Word8
fptr Int
ofs Int
len) = forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
Builder forall a b. (a -> b) -> a -> b
$ \env :: BufferedIOBackend
env@PutEnv{Int
IORef Int
IORef (ForeignPtr Word8)
Ptr Word8 -> Ptr Word8 -> IO ()
peTotal :: IORef Int
peBuffer :: IORef (ForeignPtr Word8)
pePut :: Ptr Word8 -> Ptr Word8 -> IO ()
peThreshold :: Int
peTotal :: BufferedIOBackend -> IORef Int
peBuffer :: BufferedIOBackend -> IORef (ForeignPtr Word8)
pePut :: BufferedIOBackend -> Ptr Word8 -> Ptr Word8 -> IO ()
peThreshold :: BufferedIOBackend -> Int
..} Buffer
buf -> if Int
len forall a. Ord a => a -> a -> Bool
> Int
peThreshold
then do
Buffer
buf' <- forall s. BuilderFor s -> s -> Buffer -> IO Buffer
unBuilder Builder
flush BufferedIOBackend
env Buffer
buf
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fptr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
let ptr0 :: Ptr Word8
ptr0 = Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
ofs
Ptr Word8 -> Ptr Word8 -> IO ()
pePut Ptr Word8
ptr0 (Ptr Word8
ptr0 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Buffer
buf'
else forall s. BuilderFor s -> s -> Buffer -> IO Buffer
unBuilder (forall s. Buildable s => ByteString -> BuilderFor s
byteStringCopy ByteString
bs) BufferedIOBackend
env Buffer
buf
{-# INLINE byteString #-}
flush :: BuilderFor BufferedIOBackend
flush = forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
Builder forall a b. (a -> b) -> a -> b
$ \PutEnv{Int
IORef Int
IORef (ForeignPtr Word8)
Ptr Word8 -> Ptr Word8 -> IO ()
peTotal :: IORef Int
peBuffer :: IORef (ForeignPtr Word8)
pePut :: Ptr Word8 -> Ptr Word8 -> IO ()
peThreshold :: Int
peTotal :: BufferedIOBackend -> IORef Int
peBuffer :: BufferedIOBackend -> IORef (ForeignPtr Word8)
pePut :: BufferedIOBackend -> Ptr Word8 -> Ptr Word8 -> IO ()
peThreshold :: BufferedIOBackend -> Int
..} (Buffer Ptr Word8
end Ptr Word8
ptr) -> do
Ptr Word8
ptr0 <- forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef (ForeignPtr Word8)
peBuffer
let len :: Int
len = forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
ptr Ptr Word8
ptr0
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Int
peTotal (forall a. Num a => a -> a -> a
+Int
len)
Ptr Word8 -> Ptr Word8 -> IO ()
pePut Ptr Word8
ptr0 Ptr Word8
ptr
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Ptr Word8 -> Ptr Word8 -> Buffer
Buffer Ptr Word8
end Ptr Word8
ptr0
{-# INLINE flush #-}
allocate :: Int -> BuilderFor BufferedIOBackend
allocate = forall s. (s -> IORef (ForeignPtr Word8)) -> Int -> BuilderFor s
allocateConstant BufferedIOBackend -> IORef (ForeignPtr Word8)
peBuffer
{-# INLINE allocate #-}
type BufferedIOBackend = PutEnv
hPutBuilderLen :: Handle -> BuilderFor BufferedIOBackend -> IO Int
hPutBuilderLen :: Handle -> BuilderFor BufferedIOBackend -> IO Int
hPutBuilderLen Handle
h BuilderFor BufferedIOBackend
b = do
let initialSize :: Int
initialSize = Int
4096
ForeignPtr Word8
fptr <- forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
initialSize
IORef (ForeignPtr Word8)
ref <- forall a. a -> IO (IORef a)
newIORef ForeignPtr Word8
fptr
let ptr :: Ptr Word8
ptr = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fptr
IORef Int
counter <- forall a. a -> IO (IORef a)
newIORef Int
0
Buffer
_ <- forall s. BuilderFor s -> s -> Buffer -> IO Buffer
unBuilder (BuilderFor BufferedIOBackend
b forall a. Semigroup a => a -> a -> a
<> Builder
flush)
(Int
-> (Ptr Word8 -> Ptr Word8 -> IO ())
-> IORef (ForeignPtr Word8)
-> IORef Int
-> BufferedIOBackend
PutEnv Int
initialSize (\Ptr Word8
ptr0 Ptr Word8
ptr1 -> forall a. Handle -> Ptr a -> Int -> IO ()
hPutBuf Handle
h Ptr Word8
ptr (forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
ptr1 Ptr Word8
ptr0)) IORef (ForeignPtr Word8)
ref IORef Int
counter)
(Ptr Word8 -> Ptr Word8 -> Buffer
Buffer (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
initialSize) Ptr Word8
ptr)
forall a. IORef a -> IO a
readIORef IORef Int
counter
{-# INLINE hPutBuilderLen #-}
sendBufRange :: S.Socket -> Ptr Word8 -> Ptr Word8 -> IO ()
sendBufRange :: Socket -> Ptr Word8 -> Ptr Word8 -> IO ()
sendBufRange Socket
sock Ptr Word8
ptr0 Ptr Word8
ptr1 = Ptr Word8 -> IO ()
go Ptr Word8
ptr0 where
go :: Ptr Word8 -> IO ()
go Ptr Word8
p
| Ptr Word8
p forall a. Ord a => a -> a -> Bool
>= Ptr Word8
ptr1 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
Int
sent <- Socket -> Ptr Word8 -> Int -> IO Int
S.sendBuf Socket
sock Ptr Word8
p (forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
ptr1 Ptr Word8
p)
forall r. Socket -> (CInt -> IO r) -> IO r
S.withFdSocket Socket
sock forall a b. (a -> b) -> a -> b
$ Fd -> IO ()
threadWaitWrite forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
sent forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> IO ()
go forall a b. (a -> b) -> a -> b
$ Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
sent
sendBuilder :: S.Socket -> BuilderFor BufferedIOBackend -> IO Int
sendBuilder :: Socket -> BuilderFor BufferedIOBackend -> IO Int
sendBuilder Socket
sock BuilderFor BufferedIOBackend
b = do
let initialSize :: Int
initialSize = Int
4096
ForeignPtr Word8
fptr <- forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
initialSize
IORef (ForeignPtr Word8)
ref <- forall a. a -> IO (IORef a)
newIORef ForeignPtr Word8
fptr
let ptr :: Ptr Word8
ptr = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fptr
IORef Int
counter <- forall a. a -> IO (IORef a)
newIORef Int
0
Buffer
_ <- forall s. BuilderFor s -> s -> Buffer -> IO Buffer
unBuilder (BuilderFor BufferedIOBackend
b forall a. Semigroup a => a -> a -> a
<> Builder
flush)
(Int
-> (Ptr Word8 -> Ptr Word8 -> IO ())
-> IORef (ForeignPtr Word8)
-> IORef Int
-> BufferedIOBackend
PutEnv Int
initialSize (Socket -> Ptr Word8 -> Ptr Word8 -> IO ()
sendBufRange Socket
sock) IORef (ForeignPtr Word8)
ref IORef Int
counter)
(Ptr Word8 -> Ptr Word8 -> Buffer
Buffer (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
initialSize) Ptr Word8
ptr)
forall a. IORef a -> IO a
readIORef IORef Int
counter
{-# INLINE sendBuilder #-}
{-# INLINE encodeUtf8BuilderEscaped #-}
encodeUtf8BuilderEscaped :: Buildable s => B.BoundedPrim Word8 -> T.Text -> BuilderFor s
#if MIN_VERSION_text(2,0,0)
encodeUtf8BuilderEscaped be = step where
bound = max 4 $ B.sizeBound be
step (T.Text arr off len) = Builder $ loop off where
iend = off + len
loop !i0 env !br@(Buffer ope op0)
| i0 >= iend = return br
| outRemaining > 0 = goPartial (i0 + min outRemaining inpRemaining)
| otherwise = unBuilder (ensure bound (loop i0 env)) env br
where
outRemaining = (ope `minusPtr` op0) `quot` bound
inpRemaining = iend - i0
goPartial !iendTmp = go i0 op0
where
go !i !op
| i < iendTmp = do
let w = A.unsafeIndex arr i
if w < 0x80
then B.runB be w op >>= go (i + 1)
else poke op w >> go (i + 1) (op `plusPtr` 1)
| otherwise = loop i env (Buffer ope op)
#else
encodeUtf8BuilderEscaped :: forall s. Buildable s => BoundedPrim Word8 -> Text -> BuilderFor s
encodeUtf8BuilderEscaped BoundedPrim Word8
be = Text -> BuilderFor s
step where
bound :: Int
bound = forall a. Ord a => a -> a -> a
max Int
4 forall a b. (a -> b) -> a -> b
$ forall a. BoundedPrim a -> Int
B.sizeBound BoundedPrim Word8
be
step :: Text -> BuilderFor s
step (T.Text Array
arr Int
off Int
len) = forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
Builder forall a b. (a -> b) -> a -> b
$ Int -> s -> Buffer -> IO Buffer
loop Int
off where
iend :: Int
iend = Int
off forall a. Num a => a -> a -> a
+ Int
len
loop :: Int -> s -> Buffer -> IO Buffer
loop !Int
i0 s
env !br :: Buffer
br@(Buffer Ptr Word8
ope Ptr Word8
op0)
| Int
i0 forall a. Ord a => a -> a -> Bool
>= Int
iend = forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
br
| Int
outRemaining forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> IO Buffer
goPartial (Int
i0 forall a. Num a => a -> a -> a
+ forall a. Ord a => a -> a -> a
min Int
outRemaining Int
inpRemaining)
| Bool
otherwise = forall s. BuilderFor s -> s -> Buffer -> IO Buffer
unBuilder (Int -> (Buffer -> IO Buffer) -> Builder
ensure Int
bound (Int -> s -> Buffer -> IO Buffer
loop Int
i0 s
env)) s
env Buffer
br
where
outRemaining :: Int
outRemaining = (Ptr Word8
ope forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
op0) forall a. Integral a => a -> a -> a
`div` Int
bound
inpRemaining :: Int
inpRemaining = Int
iend forall a. Num a => a -> a -> a
- Int
i0
goPartial :: Int -> IO Buffer
goPartial !Int
iendTmp = Int -> Ptr Word8 -> IO Buffer
go Int
i0 Ptr Word8
op0
where
go :: Int -> Ptr Word8 -> IO Buffer
go !Int
i !Ptr Word8
op
| Int
i forall a. Ord a => a -> a -> Bool
< Int
iendTmp = case Array -> Int -> Word16
A.unsafeIndex Array
arr Int
i of
Word16
w | Word16
w forall a. Ord a => a -> a -> Bool
<= Word16
0x7F -> do
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
B.runB BoundedPrim Word8
be (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w) Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Ptr Word8 -> IO Buffer
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
| Word16
w forall a. Ord a => a -> a -> Bool
<= Word16
0x7FF -> do
forall a. Integral a => Int -> a -> IO ()
poke8 Int
0 forall a b. (a -> b) -> a -> b
$ (Word16
w forall a. Bits a => a -> Int -> a
`shiftR` Int
6) forall a. Num a => a -> a -> a
+ Word16
0xC0
forall a. Integral a => Int -> a -> IO ()
poke8 Int
1 forall a b. (a -> b) -> a -> b
$ (Word16
w forall a. Bits a => a -> a -> a
.&. Word16
0x3f) forall a. Num a => a -> a -> a
+ Word16
0x80
Int -> Ptr Word8 -> IO Buffer
go (Int
i forall a. Num a => a -> a -> a
+ Int
1) (Ptr Word8
op forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2)
| Word16
0xD800 forall a. Ord a => a -> a -> Bool
<= Word16
w Bool -> Bool -> Bool
&& Word16
w forall a. Ord a => a -> a -> Bool
<= Word16
0xDBFF -> do
let c :: Int
c = Char -> Int
ord forall a b. (a -> b) -> a -> b
$ Word16 -> Word16 -> Char
U16.chr2 Word16
w (Array -> Int -> Word16
A.unsafeIndex Array
arr (Int
iforall a. Num a => a -> a -> a
+Int
1))
forall a. Integral a => Int -> a -> IO ()
poke8 Int
0 forall a b. (a -> b) -> a -> b
$ (Int
c forall a. Bits a => a -> Int -> a
`shiftR` Int
18) forall a. Num a => a -> a -> a
+ Int
0xF0
forall a. Integral a => Int -> a -> IO ()
poke8 Int
1 forall a b. (a -> b) -> a -> b
$ ((Int
c forall a. Bits a => a -> Int -> a
`shiftR` Int
12) forall a. Bits a => a -> a -> a
.&. Int
0x3F) forall a. Num a => a -> a -> a
+ Int
0x80
forall a. Integral a => Int -> a -> IO ()
poke8 Int
2 forall a b. (a -> b) -> a -> b
$ ((Int
c forall a. Bits a => a -> Int -> a
`shiftR` Int
6) forall a. Bits a => a -> a -> a
.&. Int
0x3F) forall a. Num a => a -> a -> a
+ Int
0x80
forall a. Integral a => Int -> a -> IO ()
poke8 Int
3 forall a b. (a -> b) -> a -> b
$ (Int
c forall a. Bits a => a -> a -> a
.&. Int
0x3F) forall a. Num a => a -> a -> a
+ Int
0x80
Int -> Ptr Word8 -> IO Buffer
go (Int
i forall a. Num a => a -> a -> a
+ Int
2) (Ptr Word8
op forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4)
| Bool
otherwise -> do
forall a. Integral a => Int -> a -> IO ()
poke8 Int
0 forall a b. (a -> b) -> a -> b
$ (Word16
w forall a. Bits a => a -> Int -> a
`shiftR` Int
12) forall a. Num a => a -> a -> a
+ Word16
0xE0
forall a. Integral a => Int -> a -> IO ()
poke8 Int
1 forall a b. (a -> b) -> a -> b
$ ((Word16
w forall a. Bits a => a -> Int -> a
`shiftR` Int
6) forall a. Bits a => a -> a -> a
.&. Word16
0x3F) forall a. Num a => a -> a -> a
+ Word16
0x80
forall a. Integral a => Int -> a -> IO ()
poke8 Int
2 forall a b. (a -> b) -> a -> b
$ (Word16
w forall a. Bits a => a -> a -> a
.&. Word16
0x3F) forall a. Num a => a -> a -> a
+ Word16
0x80
Int -> Ptr Word8 -> IO Buffer
go (Int
i forall a. Num a => a -> a -> a
+ Int
1) (Ptr Word8
op forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3)
| Bool
otherwise = Int -> s -> Buffer -> IO Buffer
loop Int
i s
env (Ptr Word8 -> Ptr Word8 -> Buffer
Buffer Ptr Word8
ope Ptr Word8
op)
where
poke8 :: Integral a => Int -> a -> IO ()
poke8 :: forall a. Integral a => Int -> a -> IO ()
poke8 Int
j a
v = forall a. Storable a => Ptr a -> a -> IO ()
S.poke (Ptr Word8
op forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
j) (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v :: Word8)
#endif
foreign import ccall unsafe "memmove"
c_memmove :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
{-# INLINE withGrisu3 #-}
withGrisu3 :: Double -> IO r -> (Ptr Word8 -> Int -> Int -> IO r) -> IO r
withGrisu3 :: forall r.
Double -> IO r -> (Ptr Word8 -> Int -> Int -> IO r) -> IO r
withGrisu3 Double
d IO r
contFail Ptr Word8 -> Int -> Int -> IO r
cont = forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
2 forall a b. (a -> b) -> a -> b
$ \Ptr CInt
plen -> forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
19 forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
let pexp :: Ptr CInt
pexp = forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr CInt
plen (forall a. Storable a => a -> Int
S.sizeOf (forall a. HasCallStack => a
undefined :: CInt))
CInt
success <- CDouble -> Ptr Word8 -> Ptr CInt -> Ptr CInt -> IO CInt
c_grisu3 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
d) (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Ptr CInt
plen Ptr CInt
pexp
if CInt
success forall a. Eq a => a -> a -> Bool
== CInt
0
then IO r
contFail
else do
Int
len <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
S.peek Ptr CInt
plen
Int
e <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
S.peek Ptr CInt
pexp
Ptr Word8 -> Int -> Int -> IO r
cont Ptr Word8
ptr Int
len (Int
len forall a. Num a => a -> a -> a
+ Int
e)
{-# INLINE withGrisu3Rounded #-}
withGrisu3Rounded :: Int -> Double -> (Ptr Word8 -> Int -> Int -> IO r) -> IO r
withGrisu3Rounded :: forall r.
Int -> Double -> (Ptr Word8 -> Int -> Int -> IO r) -> IO r
withGrisu3Rounded Int
prec Double
val Ptr Word8 -> Int -> Int -> IO r
cont = forall r.
Double -> IO r -> (Ptr Word8 -> Int -> Int -> IO r) -> IO r
withGrisu3 Double
val (forall a. HasCallStack => String -> a
error String
"withGrisu3Rounded: failed") forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr Int
len Int
e -> do
let len' :: Int
len' = forall a. Ord a => a -> a -> a
min Int
prec Int
len
Bool
bump <- Int -> Int -> Ptr Word8 -> IO Bool
roundDigit Int
prec Int
len Ptr Word8
ptr
if Bool
bump then Ptr Word8 -> Int -> Int -> IO r
cont Ptr Word8
ptr Int
len' (Int
e forall a. Num a => a -> a -> a
+ Int
1) else Ptr Word8 -> Int -> Int -> IO r
cont (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Int
len' Int
e
roundDigit
:: Int
-> Int
-> Ptr Word8
-> IO Bool
roundDigit :: Int -> Int -> Ptr Word8 -> IO Bool
roundDigit Int
prec Int
len Ptr Word8
_ | Int
prec forall a. Ord a => a -> a -> Bool
>= Int
len = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
roundDigit Int
prec Int
_ Ptr Word8
ptr = do
Word8
rd <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
ptr (Int
prec forall a. Num a => a -> a -> a
+ Int
1)
let carry :: Int -> IO Bool
carry Int
0 = do
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
49
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
carry Int
i = do
Word8
d <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
ptr Int
i
if Word8
d forall a. Eq a => a -> a -> Bool
== Word8
57
then forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
ptr Int
i Word8
48 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> IO Bool
carry (Int
i forall a. Num a => a -> a -> a
- Int
1)
else do
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
ptr Int
i (Word8
d forall a. Num a => a -> a -> a
+ Word8
1)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
if Word8
rd forall a. Ord a => a -> a -> Bool
>= Word8
53
then Int -> IO Bool
carry Int
prec
else forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
foreign import ccall unsafe "static grisu3"
c_grisu3 :: CDouble -> Ptr Word8 -> Ptr CInt -> Ptr CInt -> IO CInt
data StreamingBackend = StreamingBackend
{ StreamingBackend -> ByteString -> IO ()
sePush :: !(B.ByteString -> IO ())
, StreamingBackend -> IORef (ForeignPtr Word8)
seBuffer :: !(IORef (ForeignPtr Word8))
}
instance Buildable StreamingBackend where
byteString :: ByteString -> BuilderFor StreamingBackend
byteString ByteString
bs
| ByteString -> Int
B.length ByteString
bs forall a. Ord a => a -> a -> Bool
< Int
4096 = forall s. Buildable s => ByteString -> BuilderFor s
byteStringCopy ByteString
bs
| Bool
otherwise = Builder
flush forall a. Semigroup a => a -> a -> a
<> forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
Builder (\StreamingBackend
env Buffer
b -> Buffer
b forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StreamingBackend -> ByteString -> IO ()
sePush StreamingBackend
env ByteString
bs)
{-# INLINE byteString #-}
flush :: BuilderFor StreamingBackend
flush = forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
Builder forall a b. (a -> b) -> a -> b
$ \(StreamingBackend ByteString -> IO ()
push IORef (ForeignPtr Word8)
ref) (Buffer Ptr Word8
end Ptr Word8
ptr) -> do
Ptr Word8
ptr0 <- forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef (ForeignPtr Word8)
ref
let len :: Int
len = forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
ptr Ptr Word8
ptr0
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
push forall a b. (a -> b) -> a -> b
$! Int -> (Ptr Word8 -> IO ()) -> ByteString
B.unsafeCreate Int
len forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
B.memcpy Ptr Word8
dst Ptr Word8
ptr0 Int
len
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Ptr Word8 -> Ptr Word8 -> Buffer
Buffer Ptr Word8
end Ptr Word8
ptr0
{-# INLINE flush #-}
allocate :: Int -> BuilderFor StreamingBackend
allocate = forall s. (s -> IORef (ForeignPtr Word8)) -> Int -> BuilderFor s
allocateConstant StreamingBackend -> IORef (ForeignPtr Word8)
seBuffer
{-# INLINE allocate #-}
toStreamingBody :: BuilderFor StreamingBackend -> (BB.Builder -> IO ()) -> IO () -> IO ()
toStreamingBody :: BuilderFor StreamingBackend -> (Builder -> IO ()) -> IO () -> IO ()
toStreamingBody BuilderFor StreamingBackend
body = \Builder -> IO ()
write IO ()
_ -> do
let initialSize :: Int
initialSize = Int
4080
ForeignPtr Word8
fptr <- forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
initialSize
IORef (ForeignPtr Word8)
ref <- forall a. a -> IO (IORef a)
newIORef ForeignPtr Word8
fptr
let ptr :: Ptr Word8
ptr = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fptr
Buffer Ptr Word8
_ Ptr Word8
ptr2 <- forall s. BuilderFor s -> s -> Buffer -> IO Buffer
unBuilder BuilderFor StreamingBackend
body
((ByteString -> IO ())
-> IORef (ForeignPtr Word8) -> StreamingBackend
StreamingBackend (Builder -> IO ()
write forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
BB.byteString) IORef (ForeignPtr Word8)
ref)
(Ptr Word8 -> Ptr Word8 -> Buffer
Buffer (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
initialSize) Ptr Word8
ptr)
ForeignPtr Word8
fptr' <- forall a. IORef a -> IO a
readIORef IORef (ForeignPtr Word8)
ref
let ptr1 :: Ptr Word8
ptr1 = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fptr'
Builder -> IO ()
write forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
BB.byteString forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS ForeignPtr Word8
fptr' Int
0 (forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
ptr2 Ptr Word8
ptr1)