{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ImplicitParams #-}

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

This module provide buffered IO interface.

-}

module Z.IO.Buffered
  ( -- * Input & Output device
    Input(..), Output(..)
    -- * Buffered Input
  , BufferedInput
  , newBufferedInput
  , readBuffer
  , unReadBuffer
  , readParser
  , readExactly
  , readToMagic, readToMagic'
  , readLine, readLine'
  , readAll, readAll'
    -- * Buffered Output
  , BufferedOutput
  , newBufferedOutput
  , writeBuffer
  , writeBuilder
  , flushBuffer
    -- * Exceptions
  , ShortReadException(..)
    -- * common buffer size
  , V.defaultChunkSize
  , V.smallChunkSize
  ) where

import           Control.Monad
import           Control.Monad.Primitive     (ioToPrim, primToIO)
import           Control.Monad.ST
import           Data.IORef
import           Data.Primitive.PrimArray
import           Data.Typeable
import           Data.Word
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.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 :: HasCallStack => 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 :: HasCallStack => 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 i = BufferedInput
    { BufferedInput i -> i
bufInput    :: i
    , BufferedInput i -> IORef Bytes
bufPushBack :: {-# UNPACK #-} !(IORef V.Bytes)
    , BufferedInput i -> 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 o = BufferedOutput
    { BufferedOutput o -> o
bufOutput     :: o
    , BufferedOutput o -> Counter
bufIndex      :: {-# UNPACK #-} !Counter
    , BufferedOutput o -> MutablePrimArray RealWorld Word8
outputBuffer  :: {-# UNPACK #-} !(MutablePrimArray RealWorld Word8)
    }

-- | Open a new buffered input with given buffer size, e.g. 'V.defaultChunkSize'.
newBufferedInput :: Int     -- ^ Input buffer size
                 -> input
                 -> IO (BufferedInput input)
newBufferedInput :: Int -> input -> IO (BufferedInput input)
newBufferedInput Int
bufSiz input
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 input -> IO (BufferedInput input)
forall (m :: * -> *) a. Monad m => a -> m a
return (input
-> IORef Bytes
-> IORef (MutablePrimArray RealWorld Word8)
-> BufferedInput input
forall i.
i
-> IORef Bytes
-> IORef (MutablePrimArray RealWorld Word8)
-> BufferedInput i
BufferedInput input
i IORef Bytes
pb IORef (MutablePrimArray RealWorld Word8)
inputBuffer)

-- | Open a new buffered output with given buffer size, e.g. 'V.defaultChunkSize'.
newBufferedOutput :: Int    -- ^ Output buffer size
                  -> output
                  -> IO (BufferedOutput output)
newBufferedOutput :: Int -> output -> IO (BufferedOutput output)
newBufferedOutput Int
bufSiz output
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 output -> IO (BufferedOutput output)
forall (m :: * -> *) a. Monad m => a -> m a
return (output
-> Counter
-> MutablePrimArray RealWorld Word8
-> BufferedOutput output
forall o.
o
-> Counter -> MutablePrimArray RealWorld Word8 -> BufferedOutput o
BufferedOutput output
o Counter
index MutablePrimArray RealWorld Word8
buf)

-- | Request bytes 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, Input i) => BufferedInput i -> IO V.Bytes
readBuffer :: BufferedInput i -> IO Bytes
readBuffer BufferedInput{i
IORef (MutablePrimArray RealWorld Word8)
IORef Bytes
inputBuffer :: IORef (MutablePrimArray RealWorld Word8)
bufPushBack :: IORef Bytes
bufInput :: i
inputBuffer :: forall i.
BufferedInput i -> IORef (MutablePrimArray RealWorld Word8)
bufPushBack :: forall i. BufferedInput i -> IORef Bytes
bufInput :: forall i. BufferedInput i -> i
..} = 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 <- i -> Ptr Word8 -> Int -> IO Int
forall i.
(Input i, HasCallStack) =>
i -> Ptr Word8 -> Int -> IO Int
readInput i
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. Integral a => a -> a -> a
`quot` Int
2                -- 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 PrimArray Word8
IArray PrimVector 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'
            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 PrimArray Word8
IArray PrimVector 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

-- | Read exactly N bytes
--
-- If EOF reached before N bytes read, a 'ShortReadException' will be thrown
--
readExactly :: (HasCallStack, Input i) => Int -> BufferedInput i -> IO V.Bytes
readExactly :: Int -> BufferedInput i -> IO Bytes
readExactly Int
n0 BufferedInput i
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 i -> Int -> IO [Bytes]
forall i. Input i => BufferedInput i -> Int -> IO [Bytes]
go BufferedInput i
h0 Int
n0)
  where
    go :: BufferedInput i -> Int -> IO [Bytes]
go BufferedInput i
h Int
n = do
        Bytes
chunk <- BufferedInput i -> IO Bytes
forall i. (HasCallStack, Input i) => BufferedInput i -> IO Bytes
readBuffer BufferedInput i
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
lastChunk, 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
            Bytes -> BufferedInput i -> IO ()
forall i.
(HasCallStack, Input i) =>
Bytes -> BufferedInput i -> IO ()
unReadBuffer Bytes
rest BufferedInput i
h
            [Bytes] -> IO [Bytes]
forall (m :: * -> *) a. Monad m => a -> m a
return [Bytes
lastChunk]
        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
                    ShortReadException -> IO [Bytes]
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ShortReadException
ShortReadException
                        (String -> String -> CallStack -> IOEInfo
IOEInfo String
"" String
"unexpected EOF reached" CallStack
HasCallStack => CallStack
callStack))
                else do
                    [Bytes]
chunks <- BufferedInput i -> Int -> IO [Bytes]
go BufferedInput i
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'.
readAll :: (HasCallStack, Input i) => BufferedInput i -> IO [V.Bytes]
readAll :: BufferedInput i -> IO [Bytes]
readAll BufferedInput i
i = [Bytes] -> IO [Bytes]
loop []
  where
    loop :: [Bytes] -> IO [Bytes]
loop [Bytes]
acc = do
        Bytes
chunk <- BufferedInput i -> IO Bytes
forall i. (HasCallStack, Input i) => BufferedInput i -> IO Bytes
readBuffer BufferedInput i
i
        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.
readAll' :: (HasCallStack, Input i) => BufferedInput i -> IO V.Bytes
readAll' :: BufferedInput i -> IO Bytes
readAll' BufferedInput i
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
<$> BufferedInput i -> IO [Bytes]
forall i. (HasCallStack, Input i) => BufferedInput i -> IO [Bytes]
readAll BufferedInput i
i

data ShortReadException = ShortReadException IOEInfo deriving (Int -> ShortReadException -> ShowS
[ShortReadException] -> ShowS
ShortReadException -> String
(Int -> ShortReadException -> ShowS)
-> (ShortReadException -> String)
-> ([ShortReadException] -> ShowS)
-> Show ShortReadException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShortReadException] -> ShowS
$cshowList :: [ShortReadException] -> ShowS
show :: ShortReadException -> String
$cshow :: ShortReadException -> String
showsPrec :: Int -> ShortReadException -> ShowS
$cshowsPrec :: Int -> ShortReadException -> ShowS
Show, Typeable)

instance Exception ShortReadException where
    toException :: ShortReadException -> SomeException
toException = ShortReadException -> SomeException
forall e. Exception e => e -> SomeException
ioExceptionToException
    fromException :: SomeException -> Maybe ShortReadException
fromException = SomeException -> Maybe ShortReadException
forall e. Exception e => SomeException -> Maybe e
ioExceptionFromException

-- | Push bytes back into buffer.
--
unReadBuffer :: (HasCallStack, Input i) => V.Bytes -> BufferedInput i -> IO ()
unReadBuffer :: Bytes -> BufferedInput i -> IO ()
unReadBuffer Bytes
pb' BufferedInput{i
IORef (MutablePrimArray RealWorld Word8)
IORef Bytes
inputBuffer :: IORef (MutablePrimArray RealWorld Word8)
bufPushBack :: IORef Bytes
bufInput :: i
inputBuffer :: forall i.
BufferedInput i -> IORef (MutablePrimArray RealWorld Word8)
bufPushBack :: forall i. BufferedInput i -> IORef Bytes
bufInput :: forall i. BufferedInput i -> i
..} = do
    IORef Bytes -> (Bytes -> Bytes) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Bytes
bufPushBack ((Bytes -> Bytes) -> IO ()) -> (Bytes -> Bytes) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ 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.
readParser :: (HasCallStack, Input i) => P.Parser a -> BufferedInput i -> IO (V.Bytes, Either P.ParseError a)
readParser :: Parser a -> BufferedInput i -> IO (Bytes, Either ParseError a)
readParser Parser a
p BufferedInput i
i = do
    Bytes
bs <- BufferedInput i -> IO Bytes
forall i. (HasCallStack, Input i) => BufferedInput i -> IO Bytes
readBuffer BufferedInput i
i
    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 (BufferedInput i -> IO Bytes
forall i. (HasCallStack, Input i) => BufferedInput i -> IO Bytes
readBuffer BufferedInput i
i) Bytes
bs

-- | Read until reach a magic bytes
--
-- If EOF is reached before meet a magic byte, partial bytes are returned.
readToMagic :: (HasCallStack, Input i) => Word8 -> BufferedInput i -> IO V.Bytes
readToMagic :: Word8 -> BufferedInput i -> IO Bytes
readToMagic Word8
magic0 BufferedInput i
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 i -> Word8 -> IO [Bytes]
forall i. Input i => BufferedInput i -> Word8 -> IO [Bytes]
go BufferedInput i
h0 Word8
magic0)
  where
    go :: BufferedInput i -> Word8 -> IO [Bytes]
go BufferedInput i
h Word8
magic = do
        Bytes
chunk <- BufferedInput i -> IO Bytes
forall i. (HasCallStack, Input i) => BufferedInput i -> IO Bytes
readBuffer BufferedInput i
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
lastChunk, 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
                Bytes -> BufferedInput i -> IO ()
forall i.
(HasCallStack, Input i) =>
Bytes -> BufferedInput i -> IO ()
unReadBuffer Bytes
rest BufferedInput i
h
                [Bytes] -> IO [Bytes]
forall (m :: * -> *) a. Monad m => a -> m a
return [Bytes
lastChunk]
            Maybe Int
Nothing -> do
                [Bytes]
chunks <- BufferedInput i -> Word8 -> IO [Bytes]
go BufferedInput i
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 until reach a magic bytes
--
-- If EOF is reached before meet a magic byte, a 'ShortReadException' will be thrown.
readToMagic' :: (HasCallStack, Input i) => Word8 -> BufferedInput i -> IO V.Bytes
readToMagic' :: Word8 -> BufferedInput i -> IO Bytes
readToMagic' Word8
magic0 BufferedInput i
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 i -> Word8 -> IO [Bytes]
forall i. Input i => BufferedInput i -> Word8 -> IO [Bytes]
go BufferedInput i
h0 Word8
magic0)
  where
    go :: BufferedInput i -> Word8 -> IO [Bytes]
go BufferedInput i
h Word8
magic = do
        Bytes
chunk <- BufferedInput i -> IO Bytes
forall i. (HasCallStack, Input i) => BufferedInput i -> IO Bytes
readBuffer BufferedInput i
h
        if Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
chunk
        then ShortReadException -> IO [Bytes]
forall e a. Exception e => e -> IO a
throwIO (IOEInfo -> ShortReadException
ShortReadException
            (String -> String -> CallStack -> IOEInfo
IOEInfo String
"" String
"unexpected EOF reached" CallStack
HasCallStack => CallStack
callStack))
        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
lastChunk, 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
                Bytes -> BufferedInput i -> IO ()
forall i.
(HasCallStack, Input i) =>
Bytes -> BufferedInput i -> IO ()
unReadBuffer Bytes
rest BufferedInput i
h
                [Bytes] -> IO [Bytes]
forall (m :: * -> *) a. Monad m => a -> m a
return [Bytes
lastChunk]
            Maybe Int
Nothing -> do
                [Bytes]
chunks <- BufferedInput i -> Word8 -> IO [Bytes]
go BufferedInput i
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.
--
-- If EOF is reached before meet a magic byte, partial line is returned.
readLine :: (HasCallStack, Input i) => BufferedInput i -> IO V.Bytes
readLine :: BufferedInput i -> IO Bytes
readLine BufferedInput i
i = do
    bs :: Bytes
bs@(V.PrimVector PrimArray Word8
arr Int
s Int
l) <- Word8 -> BufferedInput i -> IO Bytes
forall i.
(HasCallStack, Input i) =>
Word8 -> BufferedInput i -> IO Bytes
readToMagic Word8
10 BufferedInput i
i
    if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then Bytes -> IO Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return Bytes
bs
    else 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
$ 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
        Maybe Word8
Nothing -> 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)
        Just Word8
r | Word8
r Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
13   -> 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 -> 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)

-- | Read to a linefeed ('\n' or '\r\n'), return 'Bytes' before it.
--
-- If EOF reached before meet a '\n', a 'ShortReadException' will be thrown.
readLine' :: (HasCallStack, Input i) => BufferedInput i -> IO V.Bytes
readLine' :: BufferedInput i -> IO Bytes
readLine' BufferedInput i
i = do
    bs :: Bytes
bs@(V.PrimVector PrimArray Word8
arr Int
s Int
l) <- Word8 -> BufferedInput i -> IO Bytes
forall i.
(HasCallStack, Input i) =>
Word8 -> BufferedInput i -> IO Bytes
readToMagic' Word8
10 BufferedInput i
i
    if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then Bytes -> IO Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return Bytes
bs
    else 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
$ 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
        Maybe Word8
Nothing -> 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)
        Just Word8
r | Word8
r Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
13   -> 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 -> 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)

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

-- | Write 'V.Bytes' into buffered handle.
--
-- Copy 'V.Bytes' to buffer if it can hold, otherwise
-- write both buffer(if not empty) and 'V.Bytes'.
--
writeBuffer :: (Output o) => BufferedOutput o -> V.Bytes -> IO ()
writeBuffer :: BufferedOutput o -> Bytes -> IO ()
writeBuffer o :: BufferedOutput o
o@BufferedOutput{o
MutablePrimArray RealWorld Word8
Counter
outputBuffer :: MutablePrimArray RealWorld Word8
bufIndex :: Counter
bufOutput :: o
outputBuffer :: forall o. BufferedOutput o -> MutablePrimArray RealWorld Word8
bufIndex :: forall o. BufferedOutput o -> Counter
bufOutput :: forall o. BufferedOutput o -> o
..} 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 -> 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
        if (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
        then do
            -- flush the buffer
            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 -> o -> Ptr Word8 -> Int -> IO ()
forall o.
(Output o, HasCallStack) =>
o -> Ptr Word8 -> Int -> IO ()
writeOutput o
bufOutput Ptr Word8
ptr Int
i
            Counter -> Int -> IO ()
forall a. Prim a => PrimIORef a -> a -> IO ()
writePrimIORef Counter
bufIndex Int
0

            BufferedOutput o -> Bytes -> IO ()
forall o. Output o => BufferedOutput o -> Bytes -> IO ()
writeBuffer BufferedOutput o
o Bytes
v -- try write to buffer again
        else
            Bytes -> (Ptr Word8 -> Int -> IO ()) -> IO ()
forall a b.
Prim a =>
PrimVector a -> (Ptr a -> Int -> IO b) -> IO b
withPrimVectorSafe Bytes
v (o -> Ptr Word8 -> Int -> IO ()
forall o.
(Output o, HasCallStack) =>
o -> Ptr Word8 -> Int -> IO ()
writeOutput o
bufOutput)


-- | Write 'V.Bytes' into buffered handle.
--
-- Copy 'V.Bytes' to buffer if it can hold, otherwise
-- write both buffer(if not empty) and 'V.Bytes'.
--
writeBuilder :: (Output o) => BufferedOutput o -> B.Builder a -> IO ()
writeBuilder :: BufferedOutput o -> Builder a -> IO ()
writeBuilder BufferedOutput{o
MutablePrimArray RealWorld Word8
Counter
outputBuffer :: MutablePrimArray RealWorld Word8
bufIndex :: Counter
bufOutput :: o
outputBuffer :: forall o. BufferedOutput o -> MutablePrimArray RealWorld Word8
bufIndex :: forall o. BufferedOutput o -> Counter
bufOutput :: forall o. BufferedOutput o -> o
..} (B.Builder forall s. AllocateStrategy s -> (a -> BuildStep s) -> BuildStep s
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
    [Bytes]
_ <- ST RealWorld [Bytes] -> IO [Bytes]
forall (m :: * -> *) a.
(PrimBase m, PrimState m ~ RealWorld) =>
m a -> IO a
primToIO (AllocateStrategy RealWorld
-> (a -> BuildStep RealWorld) -> BuildStep RealWorld
forall s. AllocateStrategy s -> (a -> BuildStep s) -> BuildStep s
b ((Bytes -> ST RealWorld ()) -> AllocateStrategy RealWorld
forall s. (Bytes -> ST s ()) -> AllocateStrategy s
B.OneShotAction Bytes -> ST RealWorld ()
action) (Int -> a -> BuildStep RealWorld
forall a. Int -> a -> BuildStep RealWorld
lastStep Int
originBufSiz) (MutablePrimArray RealWorld Word8 -> Int -> Buffer RealWorld
forall s. MutablePrimArray s Word8 -> Int -> Buffer s
B.Buffer MutablePrimArray RealWorld Word8
outputBuffer Int
i))
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    action :: V.Bytes -> ST RealWorld ()
    action :: Bytes -> ST RealWorld ()
action Bytes
bytes = IO () -> ST RealWorld ()
forall (m :: * -> *) a.
(PrimMonad m, PrimState m ~ RealWorld) =>
IO a -> m a
ioToPrim (Bytes -> (Ptr Word8 -> Int -> IO ()) -> IO ()
forall a b.
Prim a =>
PrimVector a -> (Ptr a -> Int -> IO b) -> IO b
withPrimVectorSafe Bytes
bytes (o -> Ptr Word8 -> Int -> IO ()
forall o.
(Output o, HasCallStack) =>
o -> Ptr Word8 -> Int -> IO ()
writeOutput o
bufOutput))

    lastStep :: Int -> a -> B.BuildStep RealWorld
    lastStep :: Int -> a -> BuildStep RealWorld
lastStep Int
originBufSiz a
_ (B.Buffer MutablePrimArray RealWorld Word8
buf Int
offset)
        | 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 = IO [Bytes] -> ST RealWorld [Bytes]
forall (m :: * -> *) a.
(PrimMonad m, PrimState m ~ RealWorld) =>
IO a -> m a
ioToPrim (IO [Bytes] -> ST RealWorld [Bytes])
-> IO [Bytes] -> ST RealWorld [Bytes]
forall a b. (a -> b) -> a -> b
$ do
            Counter -> Int -> IO ()
forall a. Prim a => PrimIORef a -> a -> IO ()
writePrimIORef Counter
bufIndex Int
offset   -- record new buffer index
            [Bytes] -> IO [Bytes]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        | Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
originBufSiz = IO [Bytes] -> ST RealWorld [Bytes]
forall (m :: * -> *) a.
(PrimMonad m, PrimState m ~ RealWorld) =>
IO a -> m a
ioToPrim (IO [Bytes] -> ST RealWorld [Bytes])
-> IO [Bytes] -> ST RealWorld [Bytes]
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
buf ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
ptr -> o -> Ptr Word8 -> Int -> IO ()
forall o.
(Output o, HasCallStack) =>
o -> Ptr Word8 -> Int -> IO ()
writeOutput o
bufOutput Ptr Word8
ptr Int
offset
            Counter -> Int -> IO ()
forall a. Prim a => PrimIORef a -> a -> IO ()
writePrimIORef Counter
bufIndex Int
0
            [Bytes] -> IO [Bytes]
forall (m :: * -> *) a. Monad m => a -> m a
return [] -- to match 'BuildStep' return type
        | Bool
otherwise = IO [Bytes] -> ST RealWorld [Bytes]
forall (m :: * -> *) a.
(PrimMonad m, PrimState m ~ RealWorld) =>
IO a -> m a
ioToPrim (IO [Bytes] -> ST RealWorld [Bytes])
-> IO [Bytes] -> ST RealWorld [Bytes]
forall a b. (a -> b) -> a -> b
$ 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
offset
            Counter -> Int -> IO ()
forall a. Prim a => PrimIORef a -> a -> IO ()
writePrimIORef Counter
bufIndex Int
offset
            [Bytes] -> IO [Bytes]
forall (m :: * -> *) a. Monad m => a -> m a
return [] -- to match 'BuildStep' return type

-- | Flush the buffer into output device(if not empty).
--
flushBuffer :: Output f => BufferedOutput f -> IO ()
flushBuffer :: BufferedOutput f -> IO ()
flushBuffer BufferedOutput{f
MutablePrimArray RealWorld Word8
Counter
outputBuffer :: MutablePrimArray RealWorld Word8
bufIndex :: Counter
bufOutput :: f
outputBuffer :: forall o. BufferedOutput o -> MutablePrimArray RealWorld Word8
bufIndex :: forall o. BufferedOutput o -> Counter
bufOutput :: forall o. BufferedOutput o -> o
..} = do
    Int
i <- Counter -> IO Int
forall a. Prim a => PrimIORef a -> IO a
readPrimIORef Counter
bufIndex
    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 -> f -> Ptr Word8 -> Int -> IO ()
forall o.
(Output o, HasCallStack) =>
o -> Ptr Word8 -> Int -> IO ()
writeOutput f
bufOutput Ptr Word8
ptr Int
i
    Counter -> Int -> IO ()
forall a. Prim a => PrimIORef a -> a -> IO ()
writePrimIORef Counter
bufIndex Int
0