{-|
Module      : Z.IO.Buffered
Description : Buffered IO interface
Copyright   : (c) Dong Han, 2017-2020
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

This module provides low level buffered IO interface, it's recommended to check higher level streaming interface
"Z.IO.BIO" first as it provides more features.

-}

module Z.IO.Buffered
  ( -- * Input & Output device
    Input(..), Output(..), IODev
    -- * Buffered Input
  , BufferedInput, bufInput
  , newBufferedInput
  , newBufferedInput'
  , readBuffer, readBufferText
  , unReadBuffer
  , clearInputBuffer
  , readParser
  , readParseChunk
  , readExactly
  , readToMagic
  , readLine
  , readAll, readAll'
    -- * Buffered Output
  , BufferedOutput, bufOutput
  , newBufferedOutput
  , newBufferedOutput'
  , writeBuffer, writeBuffer'
  , writeBuilder, writeBuilder'
  , flushBuffer
  , clearOutputBuffer
    -- * Buffered Input and Output
  , newBufferedIO
  , newBufferedIO'
    -- * common buffer size
  , V.defaultChunkSize
  , V.smallChunkSize
  , V.chunkOverhead
  ) where

import           Control.Monad
import           Data.IORef
import           Data.Primitive.PrimArray
import           Data.Word
import           Data.Bits                 (unsafeShiftR)
import           Foreign.Ptr
import qualified Z.Data.Builder.Base       as B
import qualified Z.Data.Parser             as P
import qualified Z.Data.Vector             as V
import qualified Z.Data.Text               as T
import qualified Z.Data.Text.UTF8Codec     as T
import qualified Z.Data.Vector.Base        as V
import           Z.Data.PrimRef
import           Z.Foreign
import           Z.IO.Exception

-- | Input device
--
-- 'readInput' should return 0 on EOF.
--
class Input i where
    readInput :: i -> Ptr Word8 -> Int -> IO Int

-- | Output device
--
-- 'writeOutput' should not return until all data are written (may not
-- necessarily flushed to hardware, that should be done in device specific way).
--
class Output o where
    writeOutput :: o -> Ptr Word8 -> Int -> IO ()

-- | Input and Output device
--
-- 'readInput' should return 0 on EOF.
--
-- 'writeOutput' should not return until all data are written (may not
-- necessarily flushed to hardware, that should be done in device specific way).
--
type IODev io = (Input io, Output io)

-- | Input device with buffer, NOT THREAD SAFE!
--
-- * A 'BufferedInput' should not be used in multiple threads, there's no locking mechanism to protect
--   buffering state.
--
-- * A 'Input' device should only be used with a single 'BufferedInput', If multiple 'BufferedInput' s
--   are opened on a same 'Input' device, the behaviour is undefined.
--
data BufferedInput = BufferedInput
    { BufferedInput -> Ptr Word8 -> Int -> IO Int
bufInput    :: Ptr Word8 -> Int -> IO Int
    , BufferedInput -> IORef Bytes
bufPushBack :: {-# UNPACK #-} !(IORef V.Bytes)
    , BufferedInput -> IORef (MutablePrimArray RealWorld Word8)
inputBuffer :: {-# UNPACK #-} !(IORef (MutablePrimArray RealWorld Word8))
    }

-- | Output device with buffer, NOT THREAD SAFE!
--
-- * A 'BufferedOutput' should not be used in multiple threads, there's no locking mechanism to protect
--   buffering state.
--
-- * A 'Output' device should only be used with a single 'BufferedOutput', If multiple 'BufferedOutput' s
--   are opened on a same 'BufferedOutput' device, the output will be interleaved.
--
data BufferedOutput = BufferedOutput
    { BufferedOutput -> Ptr Word8 -> Int -> IO ()
bufOutput     :: Ptr Word8 -> Int -> IO ()
    , BufferedOutput -> Counter
bufIndex      :: {-# UNPACK #-} !Counter
    , BufferedOutput -> MutablePrimArray RealWorld Word8
outputBuffer  :: {-# UNPACK #-} !(MutablePrimArray RealWorld Word8)
    }

-- | Open a new buffered input with 'V.defaultChunkSize' as buffer size.
newBufferedInput :: Input i => i -> IO BufferedInput
{-# INLINABLE newBufferedInput #-}
newBufferedInput :: forall i. Input i => i -> IO BufferedInput
newBufferedInput = forall i. Input i => Int -> i -> IO BufferedInput
newBufferedInput' Int
V.defaultChunkSize

-- | Open a new buffered output with 'V.defaultChunkSize' as buffer size.
newBufferedOutput :: Output o => o -> IO BufferedOutput
{-# INLINABLE newBufferedOutput #-}
newBufferedOutput :: forall o. Output o => o -> IO BufferedOutput
newBufferedOutput = forall o. Output o => Int -> o -> IO BufferedOutput
newBufferedOutput' Int
V.defaultChunkSize

-- | Open a new buffered output with given buffer size, e.g. 'V.defaultChunkSize'.
--
-- Size smaller than 'V.smallChunkSize' will be taken as 'V.smallChunkSize'.
newBufferedOutput' :: Output o
                   => Int    -- ^ Output buffer size
                   -> o
                   -> IO BufferedOutput
{-# INLINABLE newBufferedInput' #-}
newBufferedOutput' :: forall o. Output o => Int -> o -> IO BufferedOutput
newBufferedOutput' Int
bufSiz o
o = do
    Counter
index <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
a -> m (PrimRef (PrimState m) a)
newPrimRef Int
0
    MutablePrimArray RealWorld Word8
buf <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray (forall a. Ord a => a -> a -> a
max Int
bufSiz Int
V.smallChunkSize)
    forall (m :: * -> *) a. Monad m => a -> m a
return ((Ptr Word8 -> Int -> IO ())
-> Counter -> MutablePrimArray RealWorld Word8 -> BufferedOutput
BufferedOutput (forall o. Output o => o -> Ptr Word8 -> Int -> IO ()
writeOutput o
o) Counter
index MutablePrimArray RealWorld Word8
buf)

-- | Open a new buffered input with given buffer size, e.g. 'V.defaultChunkSize'.
newBufferedInput' :: Input i
                  => Int     -- ^ Input buffer size
                  -> i
                  -> IO BufferedInput
{-# INLINABLE newBufferedOutput' #-}
newBufferedInput' :: forall i. Input i => Int -> i -> IO BufferedInput
newBufferedInput' Int
bufSiz i
i = do
    IORef Bytes
pb <- forall a. a -> IO (IORef a)
newIORef forall (v :: * -> *) a. Vec v a => v a
V.empty
    MutablePrimArray RealWorld Word8
buf <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray (forall a. Ord a => a -> a -> a
max Int
bufSiz Int
V.smallChunkSize)
    IORef (MutablePrimArray RealWorld Word8)
inputBuffer <- forall a. a -> IO (IORef a)
newIORef MutablePrimArray RealWorld Word8
buf
    forall (m :: * -> *) a. Monad m => a -> m a
return ((Ptr Word8 -> Int -> IO Int)
-> IORef Bytes
-> IORef (MutablePrimArray RealWorld Word8)
-> BufferedInput
BufferedInput (forall i. Input i => i -> Ptr Word8 -> Int -> IO Int
readInput i
i) IORef Bytes
pb IORef (MutablePrimArray RealWorld Word8)
inputBuffer)

-- | Open a new buffered input and output with 'V.defaultChunkSize' as buffer size.
newBufferedIO :: IODev dev => dev -> IO (BufferedInput, BufferedOutput)
{-# INLINABLE newBufferedIO #-}
newBufferedIO :: forall dev. IODev dev => dev -> IO (BufferedInput, BufferedOutput)
newBufferedIO dev
dev = forall dev.
IODev dev =>
dev -> Int -> Int -> IO (BufferedInput, BufferedOutput)
newBufferedIO' dev
dev Int
V.defaultChunkSize Int
V.defaultChunkSize

-- | Open a new buffered input and output with given buffer size, e.g. 'V.defaultChunkSize'.
newBufferedIO' :: IODev dev => dev -> Int -> Int -> IO (BufferedInput, BufferedOutput)
{-# INLINABLE newBufferedIO' #-}
newBufferedIO' :: forall dev.
IODev dev =>
dev -> Int -> Int -> IO (BufferedInput, BufferedOutput)
newBufferedIO' dev
dev Int
inSize Int
outSize = do
    BufferedInput
i <- forall i. Input i => Int -> i -> IO BufferedInput
newBufferedInput' Int
inSize dev
dev
    BufferedOutput
o <- forall o. Output o => Int -> o -> IO BufferedOutput
newBufferedOutput' Int
outSize dev
dev
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (BufferedInput
i, BufferedOutput
o)

-- | Request bytes chunk from 'BufferedInput'.
--
-- The buffering logic is quite simple:
--
-- If we have pushed back bytes, directly return it, otherwise we read using buffer size.
-- If we read N bytes, and N is larger than half of the buffer size, then we freeze buffer and return,
-- otherwise we copy buffer into result and reuse buffer afterward.
--
readBuffer :: HasCallStack => BufferedInput -> IO V.Bytes
{-# INLINABLE readBuffer #-}
readBuffer :: HasCallStack => BufferedInput -> IO Bytes
readBuffer BufferedInput{IORef Bytes
IORef (MutablePrimArray RealWorld Word8)
Ptr Word8 -> Int -> IO Int
inputBuffer :: IORef (MutablePrimArray RealWorld Word8)
bufPushBack :: IORef Bytes
bufInput :: Ptr Word8 -> Int -> IO Int
inputBuffer :: BufferedInput -> IORef (MutablePrimArray RealWorld Word8)
bufPushBack :: BufferedInput -> IORef Bytes
bufInput :: BufferedInput -> Ptr Word8 -> Int -> IO Int
..} = do
    Bytes
pb <- forall a. IORef a -> IO a
readIORef IORef Bytes
bufPushBack
    if forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
pb
    then do
        MutablePrimArray RealWorld Word8
rbuf <- forall a. IORef a -> IO a
readIORef IORef (MutablePrimArray RealWorld Word8)
inputBuffer
        Int
bufSiz <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray RealWorld Word8
rbuf
        Int
l <- Ptr Word8 -> Int -> IO Int
bufInput (forall s a. MutablePrimArray s a -> Ptr a
mutablePrimArrayContents MutablePrimArray RealWorld Word8
rbuf) Int
bufSiz
        if Int
l forall a. Ord a => a -> a -> Bool
< Int
bufSiz forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1                -- read less than half size
        then do
            MutablePrimArray RealWorld Word8
mba <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
l              -- copy result into new array
            forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArray MutablePrimArray RealWorld Word8
mba Int
0 MutablePrimArray RealWorld Word8
rbuf Int
0 Int
l
            PrimArray Word8
ba <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
mba
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
V.fromArr PrimArray Word8
ba Int
0 Int
l
        else do                                -- freeze buf into result
            MutablePrimArray RealWorld Word8
buf' <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray Int
bufSiz
            forall a. IORef a -> a -> IO ()
writeIORef IORef (MutablePrimArray RealWorld Word8)
inputBuffer MutablePrimArray RealWorld Word8
buf'
            forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> m ()
shrinkMutablePrimArray MutablePrimArray RealWorld Word8
rbuf Int
l
            PrimArray Word8
ba <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
rbuf
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
V.fromArr PrimArray Word8
ba Int
0 Int
l
    else do
        forall a. IORef a -> a -> IO ()
writeIORef IORef Bytes
bufPushBack forall (v :: * -> *) a. Vec v a => v a
V.empty
        forall (m :: * -> *) a. Monad m => a -> m a
return Bytes
pb

-- | Request UTF8 'T.Text' chunk from 'BufferedInput'.
--
-- The buffer size must be larger than 4 bytes to guarantee decoding progress(which is guaranteed by 'newBufferedInput').
-- If there're trailing bytes before EOF, an 'OtherError' with name 'EINCOMPLETE' will be thrown, if there're
-- invalid UTF8 bytes, an 'OtherError' with name 'EINVALIDUTF8' will be thrown.`
readBufferText :: HasCallStack => BufferedInput -> IO T.Text
{-# INLINABLE readBufferText #-}
readBufferText :: HasCallStack => BufferedInput -> IO Text
readBufferText BufferedInput{IORef Bytes
IORef (MutablePrimArray RealWorld Word8)
Ptr Word8 -> Int -> IO Int
inputBuffer :: IORef (MutablePrimArray RealWorld Word8)
bufPushBack :: IORef Bytes
bufInput :: Ptr Word8 -> Int -> IO Int
inputBuffer :: BufferedInput -> IORef (MutablePrimArray RealWorld Word8)
bufPushBack :: BufferedInput -> IORef Bytes
bufInput :: BufferedInput -> Ptr Word8 -> Int -> IO Int
..} = do
    Bytes
pb <- forall a. IORef a -> IO a
readIORef IORef Bytes
bufPushBack
    MutablePrimArray RealWorld Word8
rbuf <- forall a. IORef a -> IO a
readIORef IORef (MutablePrimArray RealWorld Word8)
inputBuffer
    Int
bufSiz <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray RealWorld Word8
rbuf
    if forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
pb
    then do
        Int
l <- Ptr Word8 -> Int -> IO Int
bufInput (forall s a. MutablePrimArray s a -> Ptr a
mutablePrimArrayContents MutablePrimArray RealWorld Word8
rbuf) Int
bufSiz
        Int -> IO Text
handleBuf Int
l
    else do
        -- clear push back first
        forall a. IORef a -> a -> IO ()
writeIORef IORef Bytes
bufPushBack forall (v :: * -> *) a. Vec v a => v a
V.empty
        let (IArray PrimVector Word8
arr, Int
s, Int
delta) = forall (v :: * -> *) a. Vec v a => v a -> (IArray v a, Int, Int)
V.toArr Bytes
pb
        if PrimArray Word8 -> Int -> Int
T.decodeCharLen IArray PrimVector Word8
arr Int
s forall a. Ord a => a -> a -> Bool
<= Int
delta
        -- trailing bytes still contain text
        then Bytes -> IO Text
splitLastChar Bytes
pb
        -- trailing bytes contain partial codepoint
        else do
            -- copy trailing bytes to buffer and read
            forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld Word8
rbuf Int
0 IArray PrimVector Word8
arr Int
s Int
delta
            Int
l <- Ptr Word8 -> Int -> IO Int
bufInput (forall s a. MutablePrimArray s a -> Ptr a
mutablePrimArrayContents MutablePrimArray RealWorld Word8
rbuf forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
delta) (Int
bufSiz forall a. Num a => a -> a -> a
- Int
delta)
            -- if EOF is reached, no further progress is possible
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
l forall a. Eq a => a -> a -> Bool
== Int
0) (forall a. HasCallStack => Text -> Text -> IO a
throwOtherError Text
"EINCOMPLETE" Text
"input is incomplete")
            Int -> IO Text
handleBuf (Int
l forall a. Num a => a -> a -> a
+ Int
delta)
  where
    handleBuf :: Int -> IO Text
handleBuf Int
l = do
        MutablePrimArray RealWorld Word8
rbuf <- forall a. IORef a -> IO a
readIORef IORef (MutablePrimArray RealWorld Word8)
inputBuffer
        Int
bufSiz <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray RealWorld Word8
rbuf
        if Int
l forall a. Ord a => a -> a -> Bool
< Int
bufSiz forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1                -- read less than half size
        then do
            MutablePrimArray RealWorld Word8
mba <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
l              -- copy result into new array
            forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArray MutablePrimArray RealWorld Word8
mba Int
0 MutablePrimArray RealWorld Word8
rbuf Int
0 Int
l
            PrimArray Word8
ba <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
mba
            Bytes -> IO Text
splitLastChar (forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
ba Int
0 Int
l)
        else do                                -- freeze buf into result
            MutablePrimArray RealWorld Word8
buf' <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray Int
bufSiz
            forall a. IORef a -> a -> IO ()
writeIORef IORef (MutablePrimArray RealWorld Word8)
inputBuffer MutablePrimArray RealWorld Word8
buf'
            forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> m ()
shrinkMutablePrimArray MutablePrimArray RealWorld Word8
rbuf Int
l
            PrimArray Word8
ba <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
rbuf
            Bytes -> IO Text
splitLastChar (forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
ba Int
0 Int
l)

    splitLastChar :: Bytes -> IO Text
splitLastChar bs :: Bytes
bs@(forall (v :: * -> *) a. Vec v a => v a -> (IArray v a, Int, Int)
V.toArr -> (IArray PrimVector Word8
arr, Int
s, Int
l))
        | Int
l forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return Text
T.empty
        | Bool
otherwise = do
            let (Int
i, Maybe Word8
_) = forall (v :: * -> *) a.
Vec v a =>
(a -> Bool) -> v a -> (Int, Maybe a)
V.findR (\ Word8
w -> Word8
w forall a. Ord a => a -> a -> Bool
>= Word8
0b11000000 Bool -> Bool -> Bool
|| Word8
w forall a. Ord a => a -> a -> Bool
<= Word8
0b01111111) Bytes
bs
            if (Int
i forall a. Eq a => a -> a -> Bool
== -Int
1)
            then forall a. HasCallStack => Text -> Text -> IO a
throwOtherError Text
"EINVALIDUTF8" Text
"invalid UTF8 bytes"
            else do
                if PrimArray Word8 -> Int -> Int
T.decodeCharLen IArray PrimVector Word8
arr (Int
s forall a. Num a => a -> a -> a
+ Int
i) forall a. Ord a => a -> a -> Bool
> Int
l forall a. Num a => a -> a -> a
- Int
i
                then do
                    forall a. IORef a -> a -> IO ()
writeIORef IORef Bytes
bufPushBack (forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
V.fromArr IArray PrimVector Word8
arr (Int
sforall a. Num a => a -> a -> a
+Int
i) (Int
lforall a. Num a => a -> a -> a
-Int
i))
                    forall (m :: * -> *) a. Monad m => a -> m a
return (HasCallStack => Bytes -> Text
T.validate (forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
V.fromArr IArray PrimVector Word8
arr Int
s Int
i))
                else forall (m :: * -> *) a. Monad m => a -> m a
return (HasCallStack => Bytes -> Text
T.validate Bytes
bs)

-- | Clear already buffered input.
clearInputBuffer :: BufferedInput -> IO ()
{-# INLINABLE clearInputBuffer #-}
clearInputBuffer :: BufferedInput -> IO ()
clearInputBuffer BufferedInput{IORef Bytes
IORef (MutablePrimArray RealWorld Word8)
Ptr Word8 -> Int -> IO Int
inputBuffer :: IORef (MutablePrimArray RealWorld Word8)
bufPushBack :: IORef Bytes
bufInput :: Ptr Word8 -> Int -> IO Int
inputBuffer :: BufferedInput -> IORef (MutablePrimArray RealWorld Word8)
bufPushBack :: BufferedInput -> IORef Bytes
bufInput :: BufferedInput -> Ptr Word8 -> Int -> IO Int
..} = forall a. IORef a -> a -> IO ()
writeIORef IORef Bytes
bufPushBack forall (v :: * -> *) a. Vec v a => v a
V.empty

-- | Read exactly N bytes.
--
-- If EOF reached before N bytes read, an 'OtherError' with name 'EINCOMPLETE' will be thrown.
readExactly :: HasCallStack => Int -> BufferedInput -> IO V.Bytes
{-# INLINABLE readExactly #-}
readExactly :: HasCallStack => Int -> BufferedInput -> IO Bytes
readExactly Int
n0 BufferedInput
h = do
    Bytes
chunk <- HasCallStack => BufferedInput -> IO Bytes
readBuffer BufferedInput
h
    let l :: Int
l = forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
chunk
    if Int
n0 forall a. Ord a => a -> a -> Bool
< Int
l
    then do
        let (!Bytes
chunk', !Bytes
rest) = forall (v :: * -> *) a. Vec v a => Int -> v a -> (v a, v a)
V.splitAt Int
n0 Bytes
chunk
        HasCallStack => Bytes -> BufferedInput -> IO ()
unReadBuffer Bytes
rest BufferedInput
h
        forall (m :: * -> *) a. Monad m => a -> m a
return Bytes
chunk'
    else if Int
n0 forall a. Eq a => a -> a -> Bool
== Int
l
        then forall (m :: * -> *) a. Monad m => a -> m a
return Bytes
chunk
        else forall (v :: * -> *) a. Vec v a => [v a] -> v a
V.concatR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> [Bytes] -> IO [Bytes]
go (Int
n0 forall a. Num a => a -> a -> a
- Int
l) [Bytes
chunk])
  where
    go :: Int -> [Bytes] -> IO [Bytes]
go !Int
n [Bytes]
acc = do
        Bytes
chunk <- HasCallStack => BufferedInput -> IO Bytes
readBuffer BufferedInput
h
        let l :: Int
l = forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
chunk
        if Int
l forall a. Ord a => a -> a -> Bool
> Int
n
        then do
            let (!Bytes
chunk', !Bytes
rest) = forall (v :: * -> *) a. Vec v a => Int -> v a -> (v a, v a)
V.splitAt Int
n Bytes
chunk
            HasCallStack => Bytes -> BufferedInput -> IO ()
unReadBuffer Bytes
rest BufferedInput
h
            forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes
chunk'forall a. a -> [a] -> [a]
:[Bytes]
acc)
        else if Int
l forall a. Eq a => a -> a -> Bool
== Int
n
            then forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes
chunkforall a. a -> [a] -> [a]
:[Bytes]
acc)
            else if Int
l forall a. Eq a => a -> a -> Bool
== Int
0
                then forall a. HasCallStack => Text -> Text -> IO a
throwOtherError Text
"EINCOMPLETE" Text
"input is incomplete"
                else Int -> [Bytes] -> IO [Bytes]
go (Int
n forall a. Num a => a -> a -> a
- Int
l) (Bytes
chunkforall a. a -> [a] -> [a]
:[Bytes]
acc)

-- | Read all chunks from a 'BufferedInput' until EOF.
--
-- This function will loop read until meet EOF('Input' device return 'V.empty'),
-- Useful for reading small file into memory.
readAll :: HasCallStack => BufferedInput -> IO [V.Bytes]
{-# INLINABLE readAll #-}
readAll :: HasCallStack => BufferedInput -> IO [Bytes]
readAll BufferedInput
h = [Bytes] -> IO [Bytes]
loop []
  where
    loop :: [Bytes] -> IO [Bytes]
loop [Bytes]
acc = do
        Bytes
chunk <- HasCallStack => BufferedInput -> IO Bytes
readBuffer BufferedInput
h
        if forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
chunk
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. [a] -> [a]
reverse [Bytes]
acc
        else [Bytes] -> IO [Bytes]
loop (Bytes
chunkforall a. a -> [a] -> [a]
:[Bytes]
acc)

-- | Read all chunks from a 'BufferedInput', and concat chunks together.
--
-- This function will loop read until meet EOF('Input' device return 'V.empty'),
-- Useful for reading small file into memory.
readAll' :: HasCallStack => BufferedInput -> IO V.Bytes
{-# INLINABLE readAll' #-}
readAll' :: HasCallStack => BufferedInput -> IO Bytes
readAll' BufferedInput
h = [Bytes] -> IO Bytes
loop []
  where
    loop :: [Bytes] -> IO Bytes
loop [Bytes]
acc = do
        Bytes
chunk <- HasCallStack => BufferedInput -> IO Bytes
readBuffer BufferedInput
h
        if forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
chunk
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (v :: * -> *) a. Vec v a => [v a] -> v a
V.concatR [Bytes]
acc
        else [Bytes] -> IO Bytes
loop (Bytes
chunkforall a. a -> [a] -> [a]
:[Bytes]
acc)

-- | Push bytes back into buffer(if not empty).
--
unReadBuffer :: HasCallStack => V.Bytes -> BufferedInput -> IO ()
{-# INLINABLE unReadBuffer #-}
unReadBuffer :: HasCallStack => Bytes -> BufferedInput -> IO ()
unReadBuffer Bytes
pb' BufferedInput{IORef Bytes
IORef (MutablePrimArray RealWorld Word8)
Ptr Word8 -> Int -> IO Int
inputBuffer :: IORef (MutablePrimArray RealWorld Word8)
bufPushBack :: IORef Bytes
bufInput :: Ptr Word8 -> Int -> IO Int
inputBuffer :: BufferedInput -> IORef (MutablePrimArray RealWorld Word8)
bufPushBack :: BufferedInput -> IORef Bytes
bufInput :: BufferedInput -> Ptr Word8 -> Int -> IO Int
..} = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
pb') forall a b. (a -> b) -> a -> b
$ do
    forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Bytes
bufPushBack (\ Bytes
pb -> Bytes
pb' forall (v :: * -> *) a. Vec v a => v a -> v a -> v a
`V.append` Bytes
pb)

-- | Read buffer and parse with 'P.parseChunk' style function.
--
-- This function will continuously draw data from input before parsing finish. Unconsumed
-- bytes will be returned to buffer.
--
-- Throw 'OtherError' with name @EPARSE@ if parsing failed.
readParseChunk :: (T.Print e, HasCallStack) => (V.Bytes -> P.Result e a) -> BufferedInput -> IO a
{-# INLINABLE readParseChunk #-}
readParseChunk :: forall e a.
(Print e, HasCallStack) =>
(Bytes -> Result e a) -> BufferedInput -> IO a
readParseChunk Bytes -> Result e a
pc BufferedInput
i = (Bytes -> Result e a) -> IO a
loop Bytes -> Result e a
pc
  where
    loop :: (Bytes -> Result e a) -> IO a
loop Bytes -> Result e a
f = do
        Bytes
bs <- HasCallStack => BufferedInput -> IO Bytes
readBuffer BufferedInput
i
        case Bytes -> Result e a
f Bytes
bs of
            P.Success a
v Bytes
rest -> HasCallStack => Bytes -> BufferedInput -> IO ()
unReadBuffer Bytes
rest BufferedInput
i forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return a
v
            P.Failure e
e Bytes
rest -> HasCallStack => Bytes -> BufferedInput -> IO ()
unReadBuffer Bytes
rest BufferedInput
i forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. HasCallStack => Text -> Text -> IO a
throwOtherError Text
"EPARSE" (forall a. Print a => a -> Text
T.toText e
e)
            P.Partial Bytes -> Result e a
f'     -> (Bytes -> Result e a) -> IO a
loop Bytes -> Result e a
f'

-- | Read buffer and parse with 'P.Parser'.
--
-- This function will continuously draw data from input before parsing finish. Unconsumed
-- bytes will be returned to buffer.
--
-- Throw 'OtherError' with name @EPARSE@ if parsing failed.
readParser :: HasCallStack => P.Parser a -> BufferedInput -> IO a
{-# INLINABLE readParser #-}
readParser :: forall a. HasCallStack => Parser a -> BufferedInput -> IO a
readParser = forall e a.
(Print e, HasCallStack) =>
(Bytes -> Result e a) -> BufferedInput -> IO a
readParseChunk forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Bytes -> Result ParseError a
P.parseChunk

{-| Read until reach a magic bytes, return bytes(including the magic bytes).

Empty bytes indicate EOF. if EOF is reached before meet a magic byte, partial bytes are returned.

@
 \/----- readToMagic ----- \\ \/----- readToMagic -----\\ ...
+------------------+-------+-----------------+-------+
|       ...        | magic |       ...       | magic | ...
+------------------+-------+-----------------+-------+
@
-}
readToMagic :: HasCallStack => Word8 -> BufferedInput -> IO V.Bytes
{-# INLINABLE readToMagic #-}
readToMagic :: HasCallStack => Word8 -> BufferedInput -> IO Bytes
readToMagic Word8
magic0 BufferedInput
h0 = forall (v :: * -> *) a. Vec v a => [v a] -> v a
V.concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferedInput -> Word8 -> IO [Bytes]
go BufferedInput
h0 Word8
magic0
  where
    go :: BufferedInput -> Word8 -> IO [Bytes]
go BufferedInput
h Word8
magic = do
        Bytes
chunk <- HasCallStack => BufferedInput -> IO Bytes
readBuffer BufferedInput
h
        if forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
chunk
        then forall (m :: * -> *) a. Monad m => a -> m a
return []
        else case forall (v :: * -> *) a. (Vec v a, Eq a) => a -> v a -> Maybe Int
V.elemIndex Word8
magic Bytes
chunk of
            Just Int
i -> do
                let (Bytes
chunk', Bytes
rest) = forall (v :: * -> *) a. Vec v a => Int -> v a -> (v a, v a)
V.splitAt (Int
iforall a. Num a => a -> a -> a
+Int
1) Bytes
chunk
                HasCallStack => Bytes -> BufferedInput -> IO ()
unReadBuffer Bytes
rest BufferedInput
h
                forall (m :: * -> *) a. Monad m => a -> m a
return [Bytes
chunk']
            Maybe Int
Nothing -> do
                [Bytes]
chunks <- BufferedInput -> Word8 -> IO [Bytes]
go BufferedInput
h Word8
magic
                forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes
chunk forall a. a -> [a] -> [a]
: [Bytes]
chunks)

{-| Read to a linefeed ('\n' or '\r\n'), return 'Bytes' before it.

Return bytes don't include linefeed, empty bytes indicate empty line, 'Nothing' indicate EOF.
If EOF is reached before meet a line feed, partial line is returned.

@
 \/--- readLine ---\\ discarded \/--- readLine ---\\ discarded \/ ...
+------------------+---------+------------------+---------+
|      ...         | \\r\\n\/\\n |       ...        | \\r\\n\/\\n | ...
+------------------+---------+------------------+---------+
@
-}
readLine :: HasCallStack => BufferedInput -> IO (Maybe V.Bytes)
{-# INLINABLE readLine #-}
readLine :: HasCallStack => BufferedInput -> IO (Maybe Bytes)
readLine BufferedInput
i = do
    bs :: Bytes
bs@(V.PrimVector PrimArray Word8
arr Int
s Int
l) <- HasCallStack => Word8 -> BufferedInput -> IO Bytes
readToMagic Word8
10 BufferedInput
i
    if Int
l forall a. Eq a => a -> a -> Bool
== Int
0
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Bytes
bs forall (v :: * -> *) a. Vec v a => v a -> Int -> Maybe a
`V.indexMaybe` (Int
lforall a. Num a => a -> a -> a
-Int
2) of
        Just Word8
r | Word8
r forall a. Eq a => a -> a -> Bool
== Word8
13   -> forall a. a -> Maybe a
Just (forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
s (Int
lforall a. Num a => a -> a -> a
-Int
2))
               | Bool
otherwise -> forall a. a -> Maybe a
Just (forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
s (Int
lforall a. Num a => a -> a -> a
-Int
1))
        Maybe Word8
_ | forall (v :: * -> *) a. (Vec v a, HasCallStack) => v a -> a
V.head Bytes
bs forall a. Eq a => a -> a -> Bool
== Word8
10 -> forall a. a -> Maybe a
Just (forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
s (Int
lforall a. Num a => a -> a -> a
-Int
1))
          | Bool
otherwise -> forall a. a -> Maybe a
Just (forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
s Int
l)

--------------------------------------------------------------------------------

-- | Write 'V.Bytes' into buffered handle.
--
-- * If buffer is empty and bytes are larger than half of buffer, directly write bytes,
--   otherwise copy bytes to buffer.
--
-- * If buffer is not empty, then copy bytes to buffer if it can hold, otherwise
--   write buffer first, then try again.
--
writeBuffer :: HasCallStack => BufferedOutput -> V.Bytes -> IO ()
{-# INLINABLE writeBuffer #-}
writeBuffer :: HasCallStack => BufferedOutput -> Bytes -> IO ()
writeBuffer o :: BufferedOutput
o@BufferedOutput{Counter
MutablePrimArray RealWorld Word8
Ptr Word8 -> Int -> IO ()
outputBuffer :: MutablePrimArray RealWorld Word8
bufIndex :: Counter
bufOutput :: Ptr Word8 -> Int -> IO ()
outputBuffer :: BufferedOutput -> MutablePrimArray RealWorld Word8
bufIndex :: BufferedOutput -> Counter
bufOutput :: BufferedOutput -> Ptr Word8 -> Int -> IO ()
..} v :: Bytes
v@(V.PrimVector PrimArray Word8
ba Int
s Int
l) = do
    Int
i <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
PrimRef (PrimState m) a -> m a
readPrimRef Counter
bufIndex
    Int
bufSiz <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray RealWorld Word8
outputBuffer
    if Int
i forall a. Eq a => a -> a -> Bool
/= Int
0
    then if Int
i forall a. Num a => a -> a -> a
+ Int
l forall a. Ord a => a -> a -> Bool
<= Int
bufSiz
        then do
            -- current buffer can hold it
            forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld Word8
outputBuffer Int
i PrimArray Word8
ba Int
s Int
l   -- copy to buffer
            forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
PrimRef (PrimState m) a -> a -> m ()
writePrimRef Counter
bufIndex (Int
iforall a. Num a => a -> a -> a
+Int
l)              -- update index
        else do
            -- flush the buffer first
            forall a b. MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
withMutablePrimArrayContents MutablePrimArray RealWorld Word8
outputBuffer forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
ptr -> Ptr Word8 -> Int -> IO ()
bufOutput Ptr Word8
ptr Int
i
            forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
PrimRef (PrimState m) a -> a -> m ()
writePrimRef Counter
bufIndex Int
0
            -- try write to buffer again
            HasCallStack => BufferedOutput -> Bytes -> IO ()
writeBuffer BufferedOutput
o Bytes
v
    else
        if Int
l forall a. Ord a => a -> a -> Bool
> Int
bufSiz forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1
        then forall a b.
Prim a =>
PrimVector a -> (Ptr a -> Int -> IO b) -> IO b
withPrimVectorSafe Bytes
v Ptr Word8 -> Int -> IO ()
bufOutput
        else do
            forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld Word8
outputBuffer Int
i PrimArray Word8
ba Int
s Int
l   -- copy to buffer
            forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
PrimRef (PrimState m) a -> a -> m ()
writePrimRef Counter
bufIndex Int
l             -- update index

-- | Write 'V.Bytes' into buffered handle then flush the buffer into output device (if buffer is not empty).
--
-- Equivalent to add a 'flushBuffer' after write.
writeBuffer' :: HasCallStack => BufferedOutput -> V.Bytes -> IO ()
{-# INLINABLE writeBuffer' #-}
writeBuffer' :: HasCallStack => BufferedOutput -> Bytes -> IO ()
writeBuffer' BufferedOutput
bo Bytes
o = HasCallStack => BufferedOutput -> Bytes -> IO ()
writeBuffer BufferedOutput
bo Bytes
o forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasCallStack => BufferedOutput -> IO ()
flushBuffer BufferedOutput
bo

-- | Directly write 'B.Builder' into buffered handle.
--
-- Run 'B.Builder' with buffer if it can hold, write to device when buffer is full.
--
writeBuilder :: HasCallStack => BufferedOutput -> B.Builder a -> IO ()
{-# INLINABLE writeBuilder #-}
writeBuilder :: forall a. HasCallStack => BufferedOutput -> Builder a -> IO ()
writeBuilder BufferedOutput{Counter
MutablePrimArray RealWorld Word8
Ptr Word8 -> Int -> IO ()
outputBuffer :: MutablePrimArray RealWorld Word8
bufIndex :: Counter
bufOutput :: Ptr Word8 -> Int -> IO ()
outputBuffer :: BufferedOutput -> MutablePrimArray RealWorld Word8
bufIndex :: BufferedOutput -> Counter
bufOutput :: BufferedOutput -> Ptr Word8 -> Int -> IO ()
..} (B.Builder (a -> BuildStep) -> BuildStep
b) = do
    Int
i <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
PrimRef (PrimState m) a -> m a
readPrimRef Counter
bufIndex
    Int
originBufSiz <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray RealWorld Word8
outputBuffer
    Int -> BuildResult -> IO ()
loop Int
originBufSiz forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (a -> BuildStep) -> BuildStep
b (\ a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffer -> BuildResult
B.Done) (MutablePrimArray RealWorld Word8 -> Int -> Buffer
B.Buffer MutablePrimArray RealWorld Word8
outputBuffer Int
i)
  where
    loop :: Int -> BuildResult -> IO ()
loop Int
originBufSiz BuildResult
r = case BuildResult
r of
        B.Done buffer :: Buffer
buffer@(B.Buffer MutablePrimArray RealWorld Word8
buf' Int
i') -> do
            if forall s a. MutablePrimArray s a -> MutablePrimArray s a -> Bool
sameMutablePrimArray MutablePrimArray RealWorld Word8
buf' MutablePrimArray RealWorld Word8
outputBuffer
            then forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
PrimRef (PrimState m) a -> a -> m ()
writePrimRef Counter
bufIndex Int
i'
            else if Int
i' forall a. Ord a => a -> a -> Bool
>= Int
originBufSiz
                then do
                    Bytes -> IO ()
action forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall {m :: * -> *}.
(PrimState m ~ RealWorld, PrimMonad m) =>
Buffer -> m Bytes
freezeBuffer Buffer
buffer
                    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
PrimRef (PrimState m) a -> a -> m ()
writePrimRef Counter
bufIndex Int
0
                else do
                    forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArray MutablePrimArray RealWorld Word8
outputBuffer Int
0 MutablePrimArray RealWorld Word8
buf' Int
0 Int
i'
                    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
PrimRef (PrimState m) a -> a -> m ()
writePrimRef Counter
bufIndex Int
i'
        B.BufferFull buffer :: Buffer
buffer@(B.Buffer MutablePrimArray RealWorld Word8
_ Int
i') Int
wantSiz BuildStep
k -> do
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i' forall a. Eq a => a -> a -> Bool
/= Int
0) (Bytes -> IO ()
action forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall {m :: * -> *}.
(PrimState m ~ RealWorld, PrimMonad m) =>
Buffer -> m Bytes
freezeBuffer Buffer
buffer)
            if Int
wantSiz forall a. Ord a => a -> a -> Bool
<= Int
originBufSiz
            then Int -> BuildResult -> IO ()
loop Int
originBufSiz forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BuildStep
k (MutablePrimArray RealWorld Word8 -> Int -> Buffer
B.Buffer MutablePrimArray RealWorld Word8
outputBuffer Int
0)
            else do
                MutablePrimArray RealWorld Word8
tempBuf <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray Int
wantSiz
                Int -> BuildResult -> IO ()
loop Int
originBufSiz forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BuildStep
k (MutablePrimArray RealWorld Word8 -> Int -> Buffer
B.Buffer MutablePrimArray RealWorld Word8
tempBuf Int
0)
        B.InsertBytes buffer :: Buffer
buffer@(B.Buffer MutablePrimArray RealWorld Word8
_ Int
i')  bs :: Bytes
bs@(V.PrimVector PrimArray Word8
arr Int
s Int
l) BuildStep
k -> do
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i' forall a. Eq a => a -> a -> Bool
/= Int
0) (Bytes -> IO ()
action forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall {m :: * -> *}.
(PrimState m ~ RealWorld, PrimMonad m) =>
Buffer -> m Bytes
freezeBuffer Buffer
buffer)
            if forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
bs forall a. Ord a => a -> a -> Bool
< Int
originBufSiz
            then do
                forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld Word8
outputBuffer Int
0 PrimArray Word8
arr Int
s Int
l
                Int -> BuildResult -> IO ()
loop Int
originBufSiz forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BuildStep
k (MutablePrimArray RealWorld Word8 -> Int -> Buffer
B.Buffer MutablePrimArray RealWorld Word8
outputBuffer Int
l)
            else do
                Bytes -> IO ()
action Bytes
bs
                Int -> BuildResult -> IO ()
loop Int
originBufSiz forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BuildStep
k (MutablePrimArray RealWorld Word8 -> Int -> Buffer
B.Buffer MutablePrimArray RealWorld Word8
outputBuffer Int
0)

    action :: Bytes -> IO ()
action Bytes
bytes = forall a b.
Prim a =>
PrimVector a -> (Ptr a -> Int -> IO b) -> IO b
withPrimVectorSafe Bytes
bytes Ptr Word8 -> Int -> IO ()
bufOutput

    freezeBuffer :: Buffer -> m Bytes
freezeBuffer (B.Buffer MutablePrimArray RealWorld Word8
buf Int
offset) = do
        -- we can't shrink buffer here, it will be reused
        -- when (offset < siz) (A.shrinkMutablePrimArray buf offset)
        !PrimArray Word8
arr <- forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
buf
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
0 Int
offset)

-- | Directly write 'B.Builder' into buffered handle then flush the buffer into output device (if buffer is not empty).
--
-- Equivalent to add a 'flushBuffer' after write.
writeBuilder' :: HasCallStack => BufferedOutput -> B.Builder () -> IO ()
{-# INLINABLE writeBuilder' #-}
writeBuilder' :: HasCallStack => BufferedOutput -> Builder () -> IO ()
writeBuilder' BufferedOutput
bo Builder ()
o = forall a. HasCallStack => BufferedOutput -> Builder a -> IO ()
writeBuilder BufferedOutput
bo Builder ()
o forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasCallStack => BufferedOutput -> IO ()
flushBuffer BufferedOutput
bo

-- | Flush the buffer into output device(if buffer is not empty).
--
flushBuffer :: HasCallStack => BufferedOutput -> IO ()
{-# INLINABLE flushBuffer #-}
flushBuffer :: HasCallStack => BufferedOutput -> IO ()
flushBuffer BufferedOutput{Counter
MutablePrimArray RealWorld Word8
Ptr Word8 -> Int -> IO ()
outputBuffer :: MutablePrimArray RealWorld Word8
bufIndex :: Counter
bufOutput :: Ptr Word8 -> Int -> IO ()
outputBuffer :: BufferedOutput -> MutablePrimArray RealWorld Word8
bufIndex :: BufferedOutput -> Counter
bufOutput :: BufferedOutput -> Ptr Word8 -> Int -> IO ()
..} = do
    Int
i <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
PrimRef (PrimState m) a -> m a
readPrimRef Counter
bufIndex
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Eq a => a -> a -> Bool
/= Int
0) forall a b. (a -> b) -> a -> b
$ do
        forall a b. MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
withMutablePrimArrayContents MutablePrimArray RealWorld Word8
outputBuffer forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
ptr -> Ptr Word8 -> Int -> IO ()
bufOutput Ptr Word8
ptr Int
i
        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
PrimRef (PrimState m) a -> a -> m ()
writePrimRef Counter
bufIndex Int
0

-- | Clear already buffered output.
clearOutputBuffer :: BufferedOutput -> IO ()
{-# INLINABLE clearOutputBuffer #-}
clearOutputBuffer :: BufferedOutput -> IO ()
clearOutputBuffer BufferedOutput{Counter
MutablePrimArray RealWorld Word8
Ptr Word8 -> Int -> IO ()
outputBuffer :: MutablePrimArray RealWorld Word8
bufIndex :: Counter
bufOutput :: Ptr Word8 -> Int -> IO ()
outputBuffer :: BufferedOutput -> MutablePrimArray RealWorld Word8
bufIndex :: BufferedOutput -> Counter
bufOutput :: BufferedOutput -> Ptr Word8 -> Int -> IO ()
..} = forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
PrimRef (PrimState m) a -> a -> m ()
writePrimRef Counter
bufIndex Int
0