{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ImplicitParams #-}
module Z.IO.Buffered
(
Input(..), Output(..)
, BufferedInput
, newBufferedInput
, readBuffer
, unReadBuffer
, readParser
, readExactly
, readToMagic, readToMagic'
, readLine, readLine'
, readAll, readAll'
, BufferedOutput
, newBufferedOutput
, writeBuffer
, writeBuilder
, flushBuffer
, ShortReadException(..)
, 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
class Input i where
readInput :: HasCallStack => i -> Ptr Word8 -> Int -> IO Int
class Output o where
writeOutput :: HasCallStack => o -> Ptr Word8 -> Int -> IO ()
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))
}
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)
}
newBufferedInput :: Int
-> 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)
newBufferedOutput :: Int
-> 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)
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
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
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
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
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)
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)
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
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
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
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)
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)
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)
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)
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
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
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)
else do
if (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
then 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 -> 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
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)
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
[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 []
| 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 []
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