{-|
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(..)
    -- * Buffered Input
  , BufferedInput, bufInput
  , newBufferedInput
  , newBufferedInput'
  , readBuffer, readBufferText
  , unReadBuffer
  , readParser
  , readExactly
  , readToMagic
  , readLine
  , readAll, readAll'
    -- * Buffered Output
  , BufferedOutput, bufOutput
  , newBufferedOutput
  , newBufferedOutput'
  , writeBuffer
  , writeBuilder
  , flushBuffer
    -- * 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           Z.Data.Array
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.PrimIORef
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 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
newBufferedInput :: i -> IO BufferedInput
newBufferedInput = Int -> i -> IO BufferedInput
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
newBufferedOutput :: o -> IO BufferedOutput
newBufferedOutput = Int -> o -> IO BufferedOutput
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'.
newBufferedOutput' :: Output o
                   => Int    -- ^ Output buffer size
                   -> o
                   -> IO BufferedOutput
newBufferedOutput' :: Int -> o -> IO BufferedOutput
newBufferedOutput' Int
bufSiz o
o = do
    Counter
index <- Int -> IO Counter
forall a. Prim a => a -> IO (PrimIORef a)
newPrimIORef Int
0
    MutablePrimArray RealWorld Word8
buf <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
bufSiz Int
0)
    BufferedOutput -> IO BufferedOutput
forall (m :: * -> *) a. Monad m => a -> m a
return ((Ptr Word8 -> Int -> IO ())
-> Counter -> MutablePrimArray RealWorld Word8 -> BufferedOutput
BufferedOutput (o -> Ptr Word8 -> Int -> IO ()
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
newBufferedInput' :: Int -> i -> IO BufferedInput
newBufferedInput' Int
bufSiz i
i = do
    IORef Bytes
pb <- Bytes -> IO (IORef Bytes)
forall a. a -> IO (IORef a)
newIORef Bytes
forall (v :: * -> *) a. Vec v a => v a
V.empty
    MutablePrimArray RealWorld Word8
buf <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
bufSiz Int
0)
    IORef (MutablePrimArray RealWorld Word8)
inputBuffer <- MutablePrimArray RealWorld Word8
-> IO (IORef (MutablePrimArray RealWorld Word8))
forall a. a -> IO (IORef a)
newIORef MutablePrimArray RealWorld Word8
buf
    BufferedInput -> IO BufferedInput
forall (m :: * -> *) a. Monad m => a -> m a
return ((Ptr Word8 -> Int -> IO Int)
-> IORef Bytes
-> IORef (MutablePrimArray RealWorld Word8)
-> BufferedInput
BufferedInput (i -> Ptr Word8 -> Int -> IO Int
forall i. Input i => i -> Ptr Word8 -> Int -> IO Int
readInput i
i) IORef Bytes
pb IORef (MutablePrimArray RealWorld Word8)
inputBuffer)


-- | 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
readBuffer :: 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 <- IORef Bytes -> IO Bytes
forall a. IORef a -> IO a
readIORef IORef Bytes
bufPushBack
    if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
pb
    then do
        MutablePrimArray RealWorld Word8
rbuf <- IORef (MutablePrimArray RealWorld Word8)
-> IO (MutablePrimArray RealWorld Word8)
forall a. IORef a -> IO a
readIORef IORef (MutablePrimArray RealWorld Word8)
inputBuffer
        Int
bufSiz <- MutablePrimArray (PrimState IO) Word8 -> IO Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
rbuf
        Int
l <- Ptr Word8 -> Int -> IO Int
bufInput (MutablePrimArray RealWorld Word8 -> Ptr Word8
forall s a. MutablePrimArray s a -> Ptr a
mutablePrimArrayContents MutablePrimArray RealWorld Word8
rbuf) Int
bufSiz
        if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
bufSiz Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1                -- read less than half size
        then do
            MutablePrimArray RealWorld Word8
mba <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
l              -- copy result into new array
            MutablePrimArray (PrimState IO) Word8
-> Int
-> MutablePrimArray (PrimState IO) Word8
-> Int
-> Int
-> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mba Int
0 MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
rbuf Int
0 Int
l
            PrimArray Word8
ba <- MutablePrimArray (PrimState IO) Word8 -> IO (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mba
            Bytes -> IO Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes -> IO Bytes) -> Bytes -> IO Bytes
forall a b. (a -> b) -> a -> b
$! IArray PrimVector Word8 -> Int -> Int -> Bytes
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
V.fromArr IArray PrimVector Word8
PrimArray Word8
ba Int
0 Int
l
        else do                                -- freeze buf into result
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
bufSiz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                MutablePrimArray RealWorld Word8
buf' <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray Int
bufSiz
                IORef (MutablePrimArray RealWorld Word8)
-> MutablePrimArray RealWorld Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (MutablePrimArray RealWorld Word8)
inputBuffer MutablePrimArray RealWorld Word8
buf'
            MutablePrimArray (PrimState IO) Word8 -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> m ()
shrinkMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
rbuf Int
l
            PrimArray Word8
ba <- MutablePrimArray (PrimState IO) Word8 -> IO (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
rbuf
            Bytes -> IO Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes -> IO Bytes) -> Bytes -> IO Bytes
forall a b. (a -> b) -> a -> b
$! IArray PrimVector Word8 -> Int -> Int -> Bytes
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
V.fromArr IArray PrimVector Word8
PrimArray Word8
ba Int
0 Int
l
    else do
        IORef Bytes -> Bytes -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bytes
bufPushBack Bytes
forall (v :: * -> *) a. Vec v a => v a
V.empty
        Bytes -> IO Bytes
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. 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
readBufferText :: 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 <- IORef Bytes -> IO Bytes
forall a. IORef a -> IO a
readIORef IORef Bytes
bufPushBack
    MutablePrimArray RealWorld Word8
rbuf <- IORef (MutablePrimArray RealWorld Word8)
-> IO (MutablePrimArray RealWorld Word8)
forall a. IORef a -> IO a
readIORef IORef (MutablePrimArray RealWorld Word8)
inputBuffer
    Int
bufSiz <- MutablePrimArray (PrimState IO) Word8 -> IO Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
rbuf
    if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
pb
    then do
        Int
l <- Ptr Word8 -> Int -> IO Int
bufInput (MutablePrimArray RealWorld Word8 -> Ptr Word8
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
        IORef Bytes -> Bytes -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bytes
bufPushBack Bytes
forall (v :: * -> *) a. Vec v a => v a
V.empty
        let (PrimArray Word8
arr, Int
s, Int
delta) = Bytes -> (IArray PrimVector Word8, Int, Int)
forall (v :: * -> *) a. Vec v a => v a -> (IArray v a, Int, Int)
V.toArr Bytes
pb
        if PrimArray Word8 -> Int -> Int
T.decodeCharLen PrimArray Word8
arr Int
s Int -> Int -> Bool
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
            MutablePrimArray (PrimState IO) Word8
-> Int -> PrimArray Word8 -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
rbuf Int
0 PrimArray Word8
arr Int
s Int
delta
            Int
l <- Ptr Word8 -> Int -> IO Int
bufInput (MutablePrimArray RealWorld Word8 -> Ptr Word8
forall s a. MutablePrimArray s a -> Ptr a
mutablePrimArrayContents MutablePrimArray RealWorld Word8
rbuf Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
delta) (Int
bufSiz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
delta)
            -- if EOF is reached, no further progress is possible
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Text -> Text -> IO ()
forall a. HasCallStack => Text -> Text -> IO a
throwOtherError Text
"EINCOMPLETE" Text
"input is incomplete")
            Int -> IO Text
handleBuf (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta)
  where
    handleBuf :: Int -> IO Text
handleBuf Int
l = do
        MutablePrimArray RealWorld Word8
rbuf <- IORef (MutablePrimArray RealWorld Word8)
-> IO (MutablePrimArray RealWorld Word8)
forall a. IORef a -> IO a
readIORef IORef (MutablePrimArray RealWorld Word8)
inputBuffer
        Int
bufSiz <- MutablePrimArray (PrimState IO) Word8 -> IO Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
rbuf
        if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
bufSiz Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1                -- read less than half size
        then do
            MutablePrimArray RealWorld Word8
mba <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
l              -- copy result into new array
            MutablePrimArray (PrimState IO) Word8
-> Int
-> MutablePrimArray (PrimState IO) Word8
-> Int
-> Int
-> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mba Int
0 MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
rbuf Int
0 Int
l
            PrimArray Word8
ba <- MutablePrimArray (PrimState IO) Word8 -> IO (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mba
            Bytes -> IO Text
splitLastChar (PrimArray Word8 -> Int -> Int -> Bytes
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
ba Int
0 Int
l)
        else do                                -- freeze buf into result
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
bufSiz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                MutablePrimArray RealWorld Word8
buf' <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray Int
bufSiz
                IORef (MutablePrimArray RealWorld Word8)
-> MutablePrimArray RealWorld Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (MutablePrimArray RealWorld Word8)
inputBuffer MutablePrimArray RealWorld Word8
buf'
            MutablePrimArray (PrimState IO) Word8 -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> m ()
shrinkMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
rbuf Int
l
            PrimArray Word8
ba <- MutablePrimArray (PrimState IO) Word8 -> IO (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
rbuf
            Bytes -> IO Text
splitLastChar (PrimArray Word8 -> Int -> Int -> Bytes
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@(Bytes -> (IArray PrimVector Word8, Int, Int)
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
T.empty
        | Bool
otherwise = do
            let (Int
i, Maybe Word8
_) = (Word8 -> Bool) -> Bytes -> (Int, Maybe Word8)
forall (v :: * -> *) a.
Vec v a =>
(a -> Bool) -> v a -> (Int, Maybe a)
V.findR (\ Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0b11000000 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0b01111111) Bytes
bs
            if (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1)
            then Text -> Text -> IO Text
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
PrimArray Word8
arr (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i
                then do
                    IORef Bytes -> Bytes -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bytes
bufPushBack (IArray PrimVector Word8 -> Int -> Int -> Bytes
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
V.fromArr IArray PrimVector Word8
arr (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i))
                    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (HasCallStack => Bytes -> Text
Bytes -> Text
T.validate (IArray PrimVector Word8 -> Int -> Int -> Bytes
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
V.fromArr IArray PrimVector Word8
arr Int
s Int
i))
                else Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (HasCallStack => Bytes -> Text
Bytes -> Text
T.validate Bytes
bs)

-- | 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
readExactly :: Int -> BufferedInput -> IO Bytes
readExactly Int
n0 BufferedInput
h0 = [Bytes] -> Bytes
forall (v :: * -> *) a. Vec v a => [v a] -> v a
V.concat ([Bytes] -> Bytes) -> IO [Bytes] -> IO Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (BufferedInput -> Int -> IO [Bytes]
go BufferedInput
h0 Int
n0)
  where
    go :: BufferedInput -> Int -> IO [Bytes]
go BufferedInput
h Int
n = do
        Bytes
chunk <- HasCallStack => BufferedInput -> IO Bytes
BufferedInput -> IO Bytes
readBuffer BufferedInput
h
        let l :: Int
l = Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
chunk
        if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n
        then do
            let (Bytes
chunk', Bytes
rest) = Int -> Bytes -> (Bytes, Bytes)
forall (v :: * -> *) a. Vec v a => Int -> v a -> (v a, v a)
V.splitAt Int
n Bytes
chunk
            HasCallStack => Bytes -> BufferedInput -> IO ()
Bytes -> BufferedInput -> IO ()
unReadBuffer Bytes
rest BufferedInput
h
            [Bytes] -> IO [Bytes]
forall (m :: * -> *) a. Monad m => a -> m a
return [Bytes
chunk']
        else if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n
            then [Bytes] -> IO [Bytes]
forall (m :: * -> *) a. Monad m => a -> m a
return [Bytes
chunk]
            else if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                then Text -> Text -> IO [Bytes]
forall a. HasCallStack => Text -> Text -> IO a
throwOtherError Text
"EINCOMPLETE" Text
"input is incomplete"
                else do
                    [Bytes]
chunks <- BufferedInput -> Int -> IO [Bytes]
go BufferedInput
h (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l)
                    [Bytes] -> IO [Bytes]
forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes
chunk Bytes -> [Bytes] -> [Bytes]
forall a. a -> [a] -> [a]
: [Bytes]
chunks)

-- | 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]
readAll :: 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
BufferedInput -> IO Bytes
readBuffer BufferedInput
h
        if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
chunk
        then [Bytes] -> IO [Bytes]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Bytes] -> IO [Bytes]) -> [Bytes] -> IO [Bytes]
forall a b. (a -> b) -> a -> b
$! [Bytes] -> [Bytes]
forall a. [a] -> [a]
reverse (Bytes
chunkBytes -> [Bytes] -> [Bytes]
forall a. a -> [a] -> [a]
:[Bytes]
acc)
        else [Bytes] -> IO [Bytes]
loop (Bytes
chunkBytes -> [Bytes] -> [Bytes]
forall 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
readAll' :: BufferedInput -> IO Bytes
readAll' BufferedInput
i = [Bytes] -> Bytes
forall (v :: * -> *) a. Vec v a => [v a] -> v a
V.concat ([Bytes] -> Bytes) -> IO [Bytes] -> IO Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => BufferedInput -> IO [Bytes]
BufferedInput -> IO [Bytes]
readAll BufferedInput
i

-- | Push bytes back into buffer(if not empty).
--
unReadBuffer :: HasCallStack => V.Bytes -> BufferedInput -> IO ()
unReadBuffer :: 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
..} = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
pb') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    IORef Bytes -> (Bytes -> Bytes) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Bytes
bufPushBack (\ Bytes
pb -> Bytes
pb' Bytes -> Bytes -> Bytes
forall (v :: * -> *) a. Vec v a => v a -> v a -> v a
`V.append` Bytes
pb)

-- | Read buffer and parse with 'Parser'.
--
-- This function will continuously draw data from input before parsing finish. Unconsumed
-- bytes will be returned to buffer.
--
-- Either during parsing or before parsing, reach EOF will result in 'P.ParseError'.
readParser :: HasCallStack => P.Parser a -> BufferedInput -> IO (Either P.ParseError a)
readParser :: Parser a -> BufferedInput -> IO (Either ParseError a)
readParser Parser a
p BufferedInput
i = do
    Bytes
bs <- HasCallStack => BufferedInput -> IO Bytes
BufferedInput -> IO Bytes
readBuffer BufferedInput
i
    (Bytes
rest, Either ParseError a
r) <- Parser a -> IO Bytes -> Bytes -> IO (Bytes, Either ParseError a)
forall (m :: * -> *) a.
Monad m =>
Parser a -> m Bytes -> Bytes -> m (Bytes, Either ParseError a)
P.parseChunks Parser a
p (HasCallStack => BufferedInput -> IO Bytes
BufferedInput -> IO Bytes
readBuffer BufferedInput
i) Bytes
bs
    HasCallStack => Bytes -> BufferedInput -> IO ()
Bytes -> BufferedInput -> IO ()
unReadBuffer Bytes
rest BufferedInput
i
    Either ParseError a -> IO (Either ParseError a)
forall (m :: * -> *) a. Monad m => a -> m a
return Either ParseError a
r

{-| 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
readToMagic :: Word8 -> BufferedInput -> IO Bytes
readToMagic Word8
magic0 BufferedInput
h0 = [Bytes] -> Bytes
forall (v :: * -> *) a. Vec v a => [v a] -> v a
V.concat ([Bytes] -> Bytes) -> IO [Bytes] -> IO Bytes
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
BufferedInput -> IO Bytes
readBuffer BufferedInput
h
        if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
chunk
        then [Bytes] -> IO [Bytes]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        else case Word8 -> Bytes -> Maybe Int
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) = Int -> Bytes -> (Bytes, Bytes)
forall (v :: * -> *) a. Vec v a => Int -> v a -> (v a, v a)
V.splitAt (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Bytes
chunk
                HasCallStack => Bytes -> BufferedInput -> IO ()
Bytes -> BufferedInput -> IO ()
unReadBuffer Bytes
rest BufferedInput
h
                [Bytes] -> IO [Bytes]
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
                [Bytes] -> IO [Bytes]
forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes
chunk Bytes -> [Bytes] -> [Bytes]
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)
readLine :: 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
Word8 -> BufferedInput -> IO Bytes
readToMagic Word8
10 BufferedInput
i
    if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then Maybe Bytes -> IO (Maybe Bytes)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Bytes
forall a. Maybe a
Nothing
    else Maybe Bytes -> IO (Maybe Bytes)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Bytes -> IO (Maybe Bytes))
-> Maybe Bytes -> IO (Maybe Bytes)
forall a b. (a -> b) -> a -> b
$ case Bytes
bs Bytes -> Int -> Maybe Word8
forall (v :: * -> *) a. Vec v a => v a -> Int -> Maybe a
`V.indexMaybe` (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) of
        Just Word8
r | Word8
r Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
13   -> Bytes -> Maybe Bytes
forall a. a -> Maybe a
Just (PrimArray Word8 -> Int -> Int -> Bytes
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
s (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2))
               | Bool
otherwise -> Bytes -> Maybe Bytes
forall a. a -> Maybe a
Just (PrimArray Word8 -> Int -> Int -> Bytes
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
s (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
        Maybe Word8
_ | Bytes -> Word8
forall (v :: * -> *) a. (Vec v a, HasCallStack) => v a -> a
V.head Bytes
bs Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
10 -> Bytes -> Maybe Bytes
forall a. a -> Maybe a
Just (PrimArray Word8 -> Int -> Int -> Bytes
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
s (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
          | Bool
otherwise -> Bytes -> Maybe Bytes
forall a. a -> Maybe a
Just (PrimArray Word8 -> Int -> Int -> Bytes
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 ()
writeBuffer :: 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 <- Counter -> IO Int
forall a. Prim a => PrimIORef a -> IO a
readPrimIORef Counter
bufIndex
    Int
bufSiz <- MutablePrimArray (PrimState IO) Word8 -> IO Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
outputBuffer
    if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
    then if Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
bufSiz
        then do
            -- current buffer can hold it
            MutablePrimArray (PrimState IO) Word8
-> Int -> PrimArray Word8 -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
outputBuffer Int
i PrimArray Word8
ba Int
s Int
l   -- copy to buffer
            Counter -> Int -> IO ()
forall a. Prim a => PrimIORef a -> a -> IO ()
writePrimIORef Counter
bufIndex (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l)              -- update index
        else do
            -- flush the buffer first
            MutablePrimArray RealWorld Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
withMutablePrimArrayContents MutablePrimArray RealWorld Word8
outputBuffer ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
ptr -> Ptr Word8 -> Int -> IO ()
bufOutput Ptr Word8
ptr Int
i
            Counter -> Int -> IO ()
forall a. Prim a => PrimIORef a -> a -> IO ()
writePrimIORef Counter
bufIndex Int
0
            -- try write to buffer again
            HasCallStack => BufferedOutput -> Bytes -> IO ()
BufferedOutput -> Bytes -> IO ()
writeBuffer BufferedOutput
o Bytes
v
    else
        if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
bufSiz Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1
        then Bytes -> (Ptr Word8 -> Int -> IO ()) -> IO ()
forall a b.
Prim a =>
PrimVector a -> (Ptr a -> Int -> IO b) -> IO b
withPrimVectorSafe Bytes
v Ptr Word8 -> Int -> IO ()
bufOutput
        else do
            MutablePrimArray (PrimState IO) Word8
-> Int -> PrimArray Word8 -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
outputBuffer Int
i PrimArray Word8
ba Int
s Int
l   -- copy to buffer
            Counter -> Int -> IO ()
forall a. Prim a => PrimIORef a -> a -> IO ()
writePrimIORef Counter
bufIndex Int
l             -- update index


-- | 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 ()
writeBuilder :: 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 <- Counter -> IO Int
forall a. Prim a => PrimIORef a -> IO a
readPrimIORef Counter
bufIndex
    Int
originBufSiz <- MutablePrimArray (PrimState IO) Word8 -> IO Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
outputBuffer
    Int -> BuildResult -> IO ()
loop Int
originBufSiz (BuildResult -> IO ()) -> IO BuildResult -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (a -> BuildStep) -> BuildStep
b (\ a
_ -> BuildResult -> IO BuildResult
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildResult -> IO BuildResult)
-> (Buffer -> BuildResult) -> BuildStep
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 MutablePrimArray RealWorld Word8
-> MutablePrimArray RealWorld Word8 -> Bool
forall s a. MutablePrimArray s a -> MutablePrimArray s a -> Bool
sameMutablePrimArray MutablePrimArray RealWorld Word8
buf' MutablePrimArray RealWorld Word8
outputBuffer
            then Counter -> Int -> IO ()
forall a. Prim a => PrimIORef a -> a -> IO ()
writePrimIORef Counter
bufIndex Int
i'
            else if Int
i' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
originBufSiz
                then do
                    Bytes -> IO ()
action (Bytes -> IO ()) -> IO Bytes -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Buffer -> IO Bytes
forall (m :: * -> *).
(PrimMonad m, PrimState m ~ RealWorld) =>
Buffer -> m Bytes
freezeBuffer Buffer
buffer
                    Counter -> Int -> IO ()
forall a. Prim a => PrimIORef a -> a -> IO ()
writePrimIORef Counter
bufIndex Int
0
                else do
                    MutablePrimArray (PrimState IO) Word8
-> Int
-> MutablePrimArray (PrimState IO) Word8
-> Int
-> Int
-> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
outputBuffer Int
0 MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
buf' Int
0 Int
i'
                    Counter -> Int -> IO ()
forall a. Prim a => PrimIORef a -> a -> IO ()
writePrimIORef Counter
bufIndex Int
i'
        B.BufferFull buffer :: Buffer
buffer@(B.Buffer MutablePrimArray RealWorld Word8
_ Int
i') Int
wantSiz BuildStep
k -> do
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Bytes -> IO ()
action (Bytes -> IO ()) -> IO Bytes -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Buffer -> IO Bytes
forall (m :: * -> *).
(PrimMonad m, PrimState m ~ RealWorld) =>
Buffer -> m Bytes
freezeBuffer Buffer
buffer)
            if Int
wantSiz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
originBufSiz
            then Int -> BuildResult -> IO ()
loop Int
originBufSiz (BuildResult -> IO ()) -> IO BuildResult -> IO ()
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 <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray Int
wantSiz
                Int -> BuildResult -> IO ()
loop Int
originBufSiz (BuildResult -> IO ()) -> IO BuildResult -> IO ()
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
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Bytes -> IO ()
action (Bytes -> IO ()) -> IO Bytes -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Buffer -> IO Bytes
forall (m :: * -> *).
(PrimMonad m, PrimState m ~ RealWorld) =>
Buffer -> m Bytes
freezeBuffer Buffer
buffer)
            if Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
originBufSiz
            then do
                MutablePrimArray (PrimState IO) Word8
-> Int -> PrimArray Word8 -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
outputBuffer Int
0 PrimArray Word8
arr Int
s Int
l
                Int -> BuildResult -> IO ()
loop Int
originBufSiz (BuildResult -> IO ()) -> IO BuildResult -> IO ()
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 (BuildResult -> IO ()) -> IO BuildResult -> IO ()
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 = Bytes -> (Ptr Word8 -> Int -> IO ()) -> IO ()
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 <- MutablePrimArray (PrimState m) Word8 -> m (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState m) Word8
buf
        Bytes -> m Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray Word8 -> Int -> Int -> Bytes
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
0 Int
offset)

-- | Flush the buffer into output device(if buffer is not empty).
--
flushBuffer :: HasCallStack => BufferedOutput -> IO ()
flushBuffer :: 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 <- Counter -> IO Int
forall a. Prim a => PrimIORef a -> IO a
readPrimIORef Counter
bufIndex
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        MutablePrimArray RealWorld Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
withMutablePrimArrayContents MutablePrimArray RealWorld Word8
outputBuffer ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
ptr -> Ptr Word8 -> Int -> IO ()
bufOutput Ptr Word8
ptr Int
i
        Counter -> Int -> IO ()
forall a. Prim a => PrimIORef a -> a -> IO ()
writePrimIORef Counter
bufIndex Int
0