module Z.IO.BIO.Base (
BIO, pattern EOF, Source, Sink
, appendSource, concatSource, concatSource'
, joinSink, fuseSink
, discard
, step, step_
, run, run_
, runBlock, runBlock_, unsafeRunBlock
, runBlocks, runBlocks_, unsafeRunBlocks
, fromPure, fromIO
, filter, filterIO
, fold', foldIO'
, initSourceFromFile
, initSourceFromFile'
, sourceFromIO
, sourceFromList
, sourceFromBuffered
, sourceTextFromBuffered
, sourceJSONFromBuffered
, sourceParserFromBuffered
, sourceParseChunkFromBuffered
, sinkToIO
, sinkToList
, initSinkToFile
, sinkToBuffered
, sinkBuilderToBuffered
, newReChunk
, newUTF8Decoder
, newParser, newMagicSplitter, newLineSplitter
, newBase64Encoder, newBase64Decoder
, hexEncode
, newHexDecoder
, counter
, seqNum
, newGrouping
, ungrouping
, consumed
) where
import Prelude hiding (filter)
import Control.Concurrent.MVar
import Control.Concurrent.STM
import qualified Control.Foldl as L
import Control.Monad
import Control.Monad.IO.Class
import Data.Bits ((.|.))
import Data.IORef
import qualified Data.List as List
import Data.Void
import Data.Word
import System.IO.Unsafe (unsafePerformIO)
import qualified Z.Data.Array as A
import qualified Z.Data.Builder as B
import Z.Data.CBytes (CBytes)
import qualified Z.Data.JSON as JSON
import qualified Z.Data.Parser as P
import Z.Data.PrimRef
import qualified Z.Data.Text as T
import qualified Z.Data.Text.UTF8Codec as T
import qualified Z.Data.Vector as V
import qualified Z.Data.Vector.Base as V
import Z.Data.Vector.Base64
import qualified Z.Data.Vector.Hex as Hex
import Z.IO.Buffered
import Z.IO.Exception
import qualified Z.IO.FileSystem.Base as FS
import Z.IO.Resource
type BIO inp out = (Maybe out -> IO ())
-> Maybe inp
-> IO ()
pattern EOF :: Maybe a
pattern $bEOF :: forall a. Maybe a
$mEOF :: forall {r} {a}. Maybe a -> ((# #) -> r) -> ((# #) -> r) -> r
EOF = Nothing
type Source x = BIO Void x
type Sink x = BIO x ()
appendSource :: HasCallStack => Source a -> Source a -> Source a
{-# INLINABLE appendSource #-}
Source a
b1 appendSource :: forall a. HasCallStack => Source a -> Source a -> Source a
`appendSource` Source a
b2 = \ Maybe a -> IO ()
k Maybe Void
_ ->
Source a
b1 (\ Maybe a
y ->
case Maybe a
y of Just a
_ -> Maybe a -> IO ()
k Maybe a
y
Maybe a
_ -> Source a
b2 Maybe a -> IO ()
k forall a. Maybe a
EOF) forall a. Maybe a
EOF
joinSink :: HasCallStack => Sink out -> Sink out -> Sink out
{-# INLINABLE joinSink #-}
Sink out
b1 joinSink :: forall out. HasCallStack => Sink out -> Sink out -> Sink out
`joinSink` Sink out
b2 = \ Maybe () -> IO ()
k Maybe out
mx ->
case Maybe out
mx of
Just out
_ -> do
Sink out
b1 forall a. a -> IO ()
discard Maybe out
mx
Sink out
b2 forall a. a -> IO ()
discard Maybe out
mx
Maybe out
_ -> do
Sink out
b1 forall a. a -> IO ()
discard forall a. Maybe a
EOF
Sink out
b2 forall a. a -> IO ()
discard forall a. Maybe a
EOF
Maybe () -> IO ()
k forall a. Maybe a
EOF
fuseSink :: HasCallStack => [Sink out] -> Sink out
{-# INLINABLE fuseSink #-}
fuseSink :: forall out. HasCallStack => [Sink out] -> Sink out
fuseSink [Sink out]
ss = \ Maybe () -> IO ()
k Maybe out
mx ->
case Maybe out
mx of
Just out
_ -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ Sink out
s -> Sink out
s forall a. a -> IO ()
discard Maybe out
mx) [Sink out]
ss
Maybe out
_ -> do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ Sink out
s -> Sink out
s forall a. a -> IO ()
discard Maybe out
mx) [Sink out]
ss
Maybe () -> IO ()
k forall a. Maybe a
EOF
concatSource :: HasCallStack => [Source a] -> Source a
{-# INLINABLE concatSource #-}
concatSource :: forall a. HasCallStack => [Source a] -> Source a
concatSource = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' forall a. HasCallStack => Source a -> Source a -> Source a
appendSource forall a. Source a
emptySource
emptySource :: Source a
{-# INLINABLE emptySource #-}
emptySource :: forall a. Source a
emptySource = \ Maybe a -> IO ()
k Maybe Void
_ -> Maybe a -> IO ()
k forall a. Maybe a
EOF
concatSource' :: HasCallStack => Source (Source a) -> Source a
{-# INLINABLE concatSource' #-}
concatSource' :: forall a. HasCallStack => Source (Source a) -> Source a
concatSource' Source (Source a)
ssrc = \ Maybe a -> IO ()
k Maybe Void
_ -> Source (Source a)
ssrc (\ Maybe (Source a)
msrc ->
case Maybe (Source a)
msrc of
Just Source a
src -> Source a
src (\ Maybe a
mx ->
case Maybe a
mx of Just a
_ -> Maybe a -> IO ()
k Maybe a
mx
Maybe a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall a. Maybe a
EOF
Maybe (Source a)
_ -> Maybe a -> IO ()
k forall a. Maybe a
EOF) forall a. Maybe a
EOF
discard :: a -> IO ()
{-# INLINABLE discard #-}
discard :: forall a. a -> IO ()
discard a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
step :: HasCallStack => BIO inp out -> inp -> IO [out]
{-# INLINABLE step #-}
step :: forall inp out. HasCallStack => BIO inp out -> inp -> IO [out]
step BIO inp out
bio inp
inp = do
IORef [out]
accRef <- forall a. a -> IO (IORef a)
newIORef []
BIO inp out
bio (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a b. (a -> b) -> a -> b
$ \ out
x -> forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [out]
accRef (out
xforall a. a -> [a] -> [a]
:)) (forall a. a -> Maybe a
Just inp
inp)
forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef [out]
accRef
step_ :: HasCallStack => BIO inp out -> inp -> IO ()
{-# INLINABLE step_ #-}
step_ :: forall inp out. HasCallStack => BIO inp out -> inp -> IO ()
step_ BIO inp out
bio = BIO inp out
bio forall a. a -> IO ()
discard forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just
run_ :: HasCallStack => BIO inp out -> IO ()
{-# INLINABLE run_ #-}
run_ :: forall inp out. HasCallStack => BIO inp out -> IO ()
run_ BIO inp out
bio = BIO inp out
bio forall a. a -> IO ()
discard forall a. Maybe a
EOF
run :: HasCallStack => BIO inp out -> IO [out]
{-# INLINABLE run #-}
run :: forall inp out. HasCallStack => BIO inp out -> IO [out]
run BIO inp out
bio = do
IORef [out]
accRef <- forall a. a -> IO (IORef a)
newIORef []
BIO inp out
bio (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a b. (a -> b) -> a -> b
$ \ out
x -> forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [out]
accRef (out
xforall a. a -> [a] -> [a]
:)) forall a. Maybe a
EOF
forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef [out]
accRef
fold' :: L.Fold a b -> Source a -> IO b
{-# INLINABLE fold' #-}
fold' :: forall a b. Fold a b -> Source a -> IO b
fold' (L.Fold x -> a -> x
s x
i x -> b
e) Source a
bio = do
IORef x
iref <- forall a. a -> IO (IORef a)
newIORef x
i
Source a
bio (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ a
x -> forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef x
iref (\ x
i' -> x -> a -> x
s x
i' a
x))) forall a. Maybe a
Nothing
x -> b
e forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef x
iref
foldIO' :: L.FoldM IO a b -> Source a -> IO b
{-# INLINABLE foldIO' #-}
foldIO' :: forall a b. FoldM IO a b -> Source a -> IO b
foldIO' (L.FoldM x -> a -> IO x
s IO x
i x -> IO b
e) Source a
bio = do
IORef x
iref <- forall a. a -> IO (IORef a)
newIORef forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO x
i
Source a
bio (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ a
x -> do
x
i' <- forall a. IORef a -> IO a
readIORef IORef x
iref
!x
x' <- x -> a -> IO x
s x
i' a
x
forall a. IORef a -> a -> IO ()
writeIORef IORef x
iref x
x')) forall a. Maybe a
Nothing
x -> IO b
e forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IORef a -> IO a
readIORef IORef x
iref
runBlock :: HasCallStack => BIO inp out -> inp -> IO [out]
{-# INLINABLE runBlock #-}
runBlock :: forall inp out. HasCallStack => BIO inp out -> inp -> IO [out]
runBlock BIO inp out
bio inp
inp = do
IORef [out]
accRef <- forall a. a -> IO (IORef a)
newIORef []
BIO inp out
bio (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a b. (a -> b) -> a -> b
$ \ out
x -> forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [out]
accRef (out
xforall a. a -> [a] -> [a]
:)) (forall a. a -> Maybe a
Just inp
inp)
BIO inp out
bio (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a b. (a -> b) -> a -> b
$ \ out
x -> forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [out]
accRef (out
xforall a. a -> [a] -> [a]
:)) forall a. Maybe a
EOF
forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef [out]
accRef
runBlock_ :: HasCallStack => BIO inp out -> inp -> IO ()
{-# INLINABLE runBlock_ #-}
runBlock_ :: forall inp out. HasCallStack => BIO inp out -> inp -> IO ()
runBlock_ BIO inp out
bio inp
inp = do
BIO inp out
bio forall a. a -> IO ()
discard (forall a. a -> Maybe a
Just inp
inp)
BIO inp out
bio forall a. a -> IO ()
discard forall a. Maybe a
EOF
unsafeRunBlock :: HasCallStack => IO (BIO inp out) -> inp -> [out]
{-# INLINABLE unsafeRunBlock #-}
unsafeRunBlock :: forall inp out. HasCallStack => IO (BIO inp out) -> inp -> [out]
unsafeRunBlock IO (BIO inp out)
new inp
inp = forall a. IO a -> a
unsafePerformIO (IO (BIO inp out)
new forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ BIO inp out
bio -> forall inp out. HasCallStack => BIO inp out -> inp -> IO [out]
runBlock BIO inp out
bio inp
inp)
runBlocks :: HasCallStack => BIO inp out -> [inp] -> IO [out]
{-# INLINABLE runBlocks #-}
runBlocks :: forall inp out. HasCallStack => BIO inp out -> [inp] -> IO [out]
runBlocks BIO inp out
bio [inp]
inps = do
IORef [out]
accRef <- forall a. a -> IO (IORef a)
newIORef []
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [inp]
inps forall a b. (a -> b) -> a -> b
$ BIO inp out
bio (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a b. (a -> b) -> a -> b
$ \ out
x -> forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [out]
accRef (out
xforall a. a -> [a] -> [a]
:)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just
BIO inp out
bio (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a b. (a -> b) -> a -> b
$ \ out
x -> forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [out]
accRef (out
xforall a. a -> [a] -> [a]
:)) forall a. Maybe a
EOF
forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef [out]
accRef
runBlocks_ :: HasCallStack => BIO inp out -> [inp] -> IO ()
{-# INLINABLE runBlocks_ #-}
runBlocks_ :: forall inp out. HasCallStack => BIO inp out -> [inp] -> IO ()
runBlocks_ BIO inp out
bio [inp]
inps = do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [inp]
inps forall a b. (a -> b) -> a -> b
$ BIO inp out
bio forall a. a -> IO ()
discard forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just
BIO inp out
bio forall a. a -> IO ()
discard forall a. Maybe a
EOF
unsafeRunBlocks :: HasCallStack => IO (BIO inp out) -> [inp] -> [out]
{-# INLINABLE unsafeRunBlocks #-}
unsafeRunBlocks :: forall inp out. HasCallStack => IO (BIO inp out) -> [inp] -> [out]
unsafeRunBlocks IO (BIO inp out)
new [inp]
inps = forall a. IO a -> a
unsafePerformIO (IO (BIO inp out)
new forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ BIO inp out
bio -> forall inp out. HasCallStack => BIO inp out -> [inp] -> IO [out]
runBlocks BIO inp out
bio [inp]
inps)
sourceFromList :: Foldable f => f a -> Source a
{-# INLINABLE sourceFromList #-}
sourceFromList :: forall (f :: * -> *) a. Foldable f => f a -> Source a
sourceFromList f a
xs0 = \ Maybe a -> IO ()
k Maybe Void
_ -> do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Maybe a -> IO ()
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) f a
xs0
Maybe a -> IO ()
k forall a. Maybe a
EOF
sourceFromBuffered :: HasCallStack => BufferedInput -> Source V.Bytes
{-# INLINABLE sourceFromBuffered #-}
sourceFromBuffered :: HasCallStack => BufferedInput -> Source Bytes
sourceFromBuffered BufferedInput
i = \ Maybe Bytes -> IO ()
k Maybe Void
_ -> (Maybe Bytes -> IO ()) -> IO ()
loop Maybe Bytes -> IO ()
k
where
loop :: (Maybe Bytes -> IO ()) -> IO ()
loop Maybe Bytes -> IO ()
k = do
Bytes
x <- HasCallStack => BufferedInput -> IO Bytes
readBuffer BufferedInput
i
if forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
x then Maybe Bytes -> IO ()
k forall a. Maybe a
EOF else Maybe Bytes -> IO ()
k (forall a. a -> Maybe a
Just Bytes
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Maybe Bytes -> IO ()) -> IO ()
loop Maybe Bytes -> IO ()
k
sourceFromIO :: HasCallStack => IO (Maybe a) -> Source a
{-# INLINABLE sourceFromIO #-}
sourceFromIO :: forall a. HasCallStack => IO (Maybe a) -> Source a
sourceFromIO IO (Maybe a)
io = \ Maybe a -> IO ()
k Maybe Void
_ -> (Maybe a -> IO ()) -> IO ()
loop Maybe a -> IO ()
k
where
loop :: (Maybe a -> IO ()) -> IO ()
loop Maybe a -> IO ()
k = do
Maybe a
x <- IO (Maybe a)
io
case Maybe a
x of
Just a
_ -> Maybe a -> IO ()
k Maybe a
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Maybe a -> IO ()) -> IO ()
loop Maybe a -> IO ()
k
Maybe a
_ -> Maybe a -> IO ()
k forall a. Maybe a
EOF
sourceTextFromBuffered :: HasCallStack => BufferedInput -> Source T.Text
{-# INLINABLE sourceTextFromBuffered #-}
sourceTextFromBuffered :: HasCallStack => BufferedInput -> Source Text
sourceTextFromBuffered BufferedInput
i = \ Maybe Text -> IO ()
k Maybe Void
_ -> (Maybe Text -> IO ()) -> IO ()
loop Maybe Text -> IO ()
k
where
loop :: (Maybe Text -> IO ()) -> IO ()
loop Maybe Text -> IO ()
k = do
Text
x <- HasCallStack => BufferedInput -> IO Text
readBufferText BufferedInput
i
if Text -> Bool
T.null Text
x then Maybe Text -> IO ()
k forall a. Maybe a
EOF else Maybe Text -> IO ()
k (forall a. a -> Maybe a
Just Text
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Maybe Text -> IO ()) -> IO ()
loop Maybe Text -> IO ()
k
sourceJSONFromBuffered :: forall a. (JSON.JSON a, HasCallStack) => BufferedInput -> Source a
{-# INLINABLE sourceJSONFromBuffered #-}
sourceJSONFromBuffered :: forall a. (JSON a, HasCallStack) => BufferedInput -> Source a
sourceJSONFromBuffered = forall e a.
(HasCallStack, Print e) =>
(Bytes -> Result e a) -> BufferedInput -> Source a
sourceParseChunkFromBuffered forall a. JSON a => Bytes -> Result DecodeError a
JSON.decodeChunk
sourceParserFromBuffered :: HasCallStack => P.Parser a -> BufferedInput -> Source a
{-# INLINABLE sourceParserFromBuffered #-}
sourceParserFromBuffered :: forall a. HasCallStack => Parser a -> BufferedInput -> Source a
sourceParserFromBuffered Parser a
p = forall e a.
(HasCallStack, Print e) =>
(Bytes -> Result e a) -> BufferedInput -> Source a
sourceParseChunkFromBuffered (forall a. Parser a -> Bytes -> Result [Text] a
P.parseChunk Parser a
p)
sourceParseChunkFromBuffered :: (HasCallStack, T.Print e)
=> (V.Bytes -> P.Result e a) -> BufferedInput -> Source a
{-# INLINABLE sourceParseChunkFromBuffered #-}
sourceParseChunkFromBuffered :: forall e a.
(HasCallStack, Print e) =>
(Bytes -> Result e a) -> BufferedInput -> Source a
sourceParseChunkFromBuffered Bytes -> Result e a
pc BufferedInput
bi = \ Maybe a -> IO ()
k Maybe Void
_ ->
let loopA :: IO ()
loopA = do
Bytes
bs <- HasCallStack => BufferedInput -> IO Bytes
readBuffer BufferedInput
bi
if forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
bs
then Maybe a -> IO ()
k forall a. Maybe a
EOF
else Bytes -> IO ()
loopB Bytes
bs
loopB :: Bytes -> IO ()
loopB Bytes
bs = do
(Bytes
rest, Either e a
r) <- forall (m :: * -> *) e a.
Monad m =>
(Bytes -> Result e a) -> ParseChunks m e a
P.parseChunks Bytes -> Result e a
pc (HasCallStack => BufferedInput -> IO Bytes
readBuffer BufferedInput
bi) Bytes
bs
case Either e a
r of Right a
v -> Maybe a -> IO ()
k (forall a. a -> Maybe a
Just a
v)
Left e
e -> forall a. HasCallStack => Text -> Text -> IO a
throwOtherError Text
"EPARSE" (forall a. Print a => a -> Text
T.toText e
e)
if forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
rest
then IO ()
loopA
else Bytes -> IO ()
loopB Bytes
rest
in IO ()
loopA
initSourceFromFile :: HasCallStack => CBytes -> Resource (Source V.Bytes)
{-# INLINABLE initSourceFromFile #-}
initSourceFromFile :: HasCallStack => CBytes -> Resource (Source Bytes)
initSourceFromFile CBytes
p = do
File
f <- HasCallStack => CBytes -> FileFlag -> FileFlag -> Resource File
FS.initFile CBytes
p FileFlag
FS.O_RDONLY FileFlag
FS.DEFAULT_FILE_MODE
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HasCallStack => BufferedInput -> Source Bytes
sourceFromBuffered forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i. Input i => i -> IO BufferedInput
newBufferedInput File
f)
initSourceFromFile' :: HasCallStack => CBytes -> Int -> Resource (Source V.Bytes)
{-# INLINABLE initSourceFromFile' #-}
initSourceFromFile' :: HasCallStack => CBytes -> Int -> Resource (Source Bytes)
initSourceFromFile' CBytes
p Int
bufSiz = do
File
f <- HasCallStack => CBytes -> FileFlag -> FileFlag -> Resource File
FS.initFile CBytes
p FileFlag
FS.O_RDONLY FileFlag
FS.DEFAULT_FILE_MODE
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HasCallStack => BufferedInput -> Source Bytes
sourceFromBuffered forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i. Input i => Int -> i -> IO BufferedInput
newBufferedInput' Int
bufSiz File
f)
sinkToBuffered :: HasCallStack => BufferedOutput -> Sink V.Bytes
{-# INLINABLE sinkToBuffered #-}
sinkToBuffered :: HasCallStack => BufferedOutput -> Sink Bytes
sinkToBuffered BufferedOutput
bo = \ Maybe () -> IO ()
k Maybe Bytes
mbs ->
case Maybe Bytes
mbs of
Just Bytes
bs -> HasCallStack => BufferedOutput -> Bytes -> IO ()
writeBuffer BufferedOutput
bo Bytes
bs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe () -> IO ()
k (forall a. a -> Maybe a
Just ())
Maybe Bytes
_ -> HasCallStack => BufferedOutput -> IO ()
flushBuffer BufferedOutput
bo forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe () -> IO ()
k forall a. Maybe a
EOF
sinkBuilderToBuffered :: HasCallStack => BufferedOutput -> Sink (B.Builder a)
{-# INLINABLE sinkBuilderToBuffered #-}
sinkBuilderToBuffered :: forall a. HasCallStack => BufferedOutput -> Sink (Builder a)
sinkBuilderToBuffered BufferedOutput
bo = \ Maybe () -> IO ()
k Maybe (Builder a)
mbs ->
case Maybe (Builder a)
mbs of
Just Builder a
bs -> forall a. HasCallStack => BufferedOutput -> Builder a -> IO ()
writeBuilder BufferedOutput
bo Builder a
bs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe () -> IO ()
k (forall a. a -> Maybe a
Just ())
Maybe (Builder a)
_ -> HasCallStack => BufferedOutput -> IO ()
flushBuffer BufferedOutput
bo forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe () -> IO ()
k forall a. Maybe a
EOF
initSinkToFile :: HasCallStack => CBytes -> Resource (Sink V.Bytes)
{-# INLINABLE initSinkToFile #-}
initSinkToFile :: HasCallStack => CBytes -> Resource (Sink Bytes)
initSinkToFile CBytes
p = do
File
f <- HasCallStack => CBytes -> FileFlag -> FileFlag -> Resource File
FS.initFile CBytes
p (FileFlag
FS.O_APPEND forall a. Bits a => a -> a -> a
.|. FileFlag
FS.O_CREAT forall a. Bits a => a -> a -> a
.|. FileFlag
FS.O_WRONLY) FileFlag
FS.DEFAULT_FILE_MODE
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HasCallStack => BufferedOutput -> Sink Bytes
sinkToBuffered forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall o. Output o => o -> IO BufferedOutput
newBufferedOutput File
f)
sinkToIO :: HasCallStack => (a -> IO ()) -> Sink a
{-# INLINABLE sinkToIO #-}
sinkToIO :: forall a. HasCallStack => (a -> IO ()) -> Sink a
sinkToIO a -> IO ()
f = \ Maybe () -> IO ()
k Maybe a
ma ->
case Maybe a
ma of
Just a
a -> a -> IO ()
f a
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe () -> IO ()
k (forall a. a -> Maybe a
Just ())
Maybe a
_ -> Maybe () -> IO ()
k forall a. Maybe a
EOF
sinkToIO' :: HasCallStack => (a -> IO ()) -> IO () -> Sink a
{-# INLINABLE sinkToIO' #-}
sinkToIO' :: forall a. HasCallStack => (a -> IO ()) -> IO () -> Sink a
sinkToIO' a -> IO ()
f IO ()
flush = \ Maybe () -> IO ()
k Maybe a
ma ->
case Maybe a
ma of
Just a
a -> a -> IO ()
f a
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe () -> IO ()
k (forall a. a -> Maybe a
Just ())
Maybe a
_ -> IO ()
flush forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe () -> IO ()
k forall a. Maybe a
EOF
sinkToList :: IO (MVar [a], Sink a)
sinkToList :: forall a. IO (MVar [a], Sink a)
sinkToList = do
IORef [a]
xsRef <- forall a. a -> IO (IORef a)
newIORef []
MVar [a]
rRef <- forall a. IO (MVar a)
newEmptyMVar
forall (m :: * -> *) a. Monad m => a -> m a
return (MVar [a]
rRef, forall a. HasCallStack => (a -> IO ()) -> IO () -> Sink a
sinkToIO' (\ a
x -> forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [a]
xsRef (a
xforall a. a -> [a] -> [a]
:))
(do forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [a]
xsRef forall a. [a] -> [a]
reverse
[a]
xs <- forall a. IORef a -> IO a
readIORef IORef [a]
xsRef
forall a. MVar a -> a -> IO ()
putMVar MVar [a]
rRef [a]
xs))
fromPure :: (a -> b) -> BIO a b
{-# INLINABLE fromPure #-}
fromPure :: forall a b. (a -> b) -> BIO a b
fromPure a -> b
f = \ Maybe b -> IO ()
k Maybe a
x -> Maybe b -> IO ()
k (a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
x)
fromIO :: HasCallStack => (a -> IO b) -> BIO a b
{-# INLINABLE fromIO #-}
fromIO :: forall a b. HasCallStack => (a -> IO b) -> BIO a b
fromIO a -> IO b
f = \ Maybe b -> IO ()
k Maybe a
x ->
case Maybe a
x of Just a
x' -> a -> IO b
f a
x' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe b -> IO ()
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just
Maybe a
_ -> Maybe b -> IO ()
k forall a. Maybe a
EOF
filter :: (a -> Bool) -> BIO a a
{-# INLINABLE filter #-}
filter :: forall a. (a -> Bool) -> BIO a a
filter a -> Bool
f Maybe a -> IO ()
k = Maybe a -> IO ()
go
where
go :: Maybe a -> IO ()
go (Just a
a) = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Bool
f a
a) forall a b. (a -> b) -> a -> b
$ Maybe a -> IO ()
k (forall a. a -> Maybe a
Just a
a)
go Maybe a
Nothing = Maybe a -> IO ()
k forall a. Maybe a
Nothing
filterIO :: (a -> IO Bool) -> BIO a a
{-# INLINABLE filterIO #-}
filterIO :: forall a. (a -> IO Bool) -> BIO a a
filterIO a -> IO Bool
f Maybe a -> IO ()
k = Maybe a -> IO ()
go
where
go :: Maybe a -> IO ()
go (Just a
a) = do
Bool
mbool <- a -> IO Bool
f a
a
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
mbool forall a b. (a -> b) -> a -> b
$ Maybe a -> IO ()
k (forall a. a -> Maybe a
Just a
a)
go Maybe a
Nothing = Maybe a -> IO ()
k forall a. Maybe a
Nothing
newReChunk :: Int
-> IO (BIO V.Bytes V.Bytes)
{-# INLINABLE newReChunk #-}
newReChunk :: Int -> IO (BIO Bytes Bytes)
newReChunk Int
n = do
IORef Bytes
trailingRef <- forall a. a -> IO (IORef a)
newIORef forall (v :: * -> *) a. Vec v a => v a
V.empty
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \ Maybe Bytes -> IO ()
k Maybe Bytes
mbs ->
case Maybe Bytes
mbs of
Just Bytes
bs -> do
Bytes
trailing <- forall a. IORef a -> IO a
readIORef IORef Bytes
trailingRef
let chunk :: Bytes
chunk = Bytes
trailing forall (v :: * -> *) a. Vec v a => v a -> v a -> v a
`V.append` Bytes
bs
l :: Int
l = forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
chunk
if Int
l forall a. Ord a => a -> a -> Bool
>= Int
n
then do
let l' :: Int
l' = Int
l forall a. Num a => a -> a -> a
- (Int
l forall a. Integral a => a -> a -> a
`rem` Int
n)
(Bytes
chunk', Bytes
rest) = forall (v :: * -> *) a. Vec v a => Int -> v a -> (v a, v a)
V.splitAt Int
l' Bytes
chunk
forall a. IORef a -> a -> IO ()
writeIORef IORef Bytes
trailingRef Bytes
rest
Maybe Bytes -> IO ()
k (forall a. a -> Maybe a
Just Bytes
chunk')
else forall a. IORef a -> a -> IO ()
writeIORef IORef Bytes
trailingRef Bytes
chunk
Maybe Bytes
_ -> do
Bytes
trailing <- forall a. IORef a -> IO a
readIORef IORef Bytes
trailingRef
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
trailing) forall a b. (a -> b) -> a -> b
$ do
forall a. IORef a -> a -> IO ()
writeIORef IORef Bytes
trailingRef forall (v :: * -> *) a. Vec v a => v a
V.empty
Maybe Bytes -> IO ()
k (forall a. a -> Maybe a
Just Bytes
trailing)
Maybe Bytes -> IO ()
k forall a. Maybe a
EOF
newParser :: HasCallStack => P.Parser a -> IO (BIO V.Bytes a)
{-# INLINABLE newParser #-}
newParser :: forall a. HasCallStack => Parser a -> IO (BIO Bytes a)
newParser Parser a
p = do
IORef (Maybe (ParseStep [Text] a))
resultRef <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
EOF
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \ Maybe a -> IO ()
k Maybe Bytes
mbs -> do
let loop :: ParseStep [Text] a -> Bytes -> IO ()
loop ParseStep [Text] a
f Bytes
chunk = case ParseStep [Text] a
f Bytes
chunk of
P.Success a
a Bytes
trailing -> do
Maybe a -> IO ()
k (forall a. a -> Maybe a
Just a
a)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
trailing) (ParseStep [Text] a -> Bytes -> IO ()
loop ParseStep [Text] a
f Bytes
trailing)
P.Partial ParseStep [Text] a
f' ->
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ParseStep [Text] a))
resultRef (forall a. a -> Maybe a
Just ParseStep [Text] a
f')
P.Failure [Text]
e Bytes
_ ->
forall a. HasCallStack => Text -> Text -> IO a
throwOtherError Text
"EPARSE" (forall a. Print a => a -> Text
T.toText [Text]
e)
Maybe (ParseStep [Text] a)
lastResult <- forall a. IORef a -> IO a
readIORef IORef (Maybe (ParseStep [Text] a))
resultRef
case Maybe Bytes
mbs of
Just Bytes
bs -> do
let f :: ParseStep [Text] a
f = case Maybe (ParseStep [Text] a)
lastResult of
Just ParseStep [Text] a
x -> ParseStep [Text] a
x
Maybe (ParseStep [Text] a)
_ -> forall a. Parser a -> Bytes -> Result [Text] a
P.parseChunk Parser a
p
ParseStep [Text] a -> Bytes -> IO ()
loop ParseStep [Text] a
f Bytes
bs
Maybe Bytes
_ ->
case Maybe (ParseStep [Text] a)
lastResult of
Just ParseStep [Text] a
f -> ParseStep [Text] a -> Bytes -> IO ()
loop ParseStep [Text] a
f forall (v :: * -> *) a. Vec v a => v a
V.empty
Maybe (ParseStep [Text] a)
_ -> Maybe a -> IO ()
k forall a. Maybe a
EOF
newUTF8Decoder :: HasCallStack => IO (BIO V.Bytes T.Text)
{-# INLINABLE newUTF8Decoder #-}
newUTF8Decoder :: HasCallStack => IO (BIO Bytes Text)
newUTF8Decoder = do
IORef Bytes
trailingRef <- forall a. a -> IO (IORef a)
newIORef forall (v :: * -> *) a. Vec v a => v a
V.empty
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \ Maybe Text -> IO ()
k Maybe Bytes
mbs -> do
case Maybe Bytes
mbs of
Just Bytes
bs -> do
Bytes
trailing <- forall a. IORef a -> IO a
readIORef IORef Bytes
trailingRef
let chunk :: Bytes
chunk = Bytes
trailing forall (v :: * -> *) a. Vec v a => v a -> v a -> v a
`V.append` Bytes
bs
(V.PrimVector PrimArray Word8
arr Int
s Int
l) = Bytes
chunk
if Int
l forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& PrimArray Word8 -> Int -> Int
T.decodeCharLen PrimArray Word8
arr Int
s forall a. Ord a => a -> a -> Bool
<= Int
l
then do
let (Int
i, Maybe Word8
_) = forall (v :: * -> *) a.
Vec v a =>
(a -> Bool) -> v a -> (Int, Maybe a)
V.findR (\ Word8
w -> Word8
w forall a. Ord a => a -> a -> Bool
>= Word8
0b11000000 Bool -> Bool -> Bool
|| Word8
w forall a. Ord a => a -> a -> Bool
<= Word8
0b01111111) Bytes
chunk
if (Int
i forall a. Eq a => a -> a -> Bool
== -Int
1)
then forall a. HasCallStack => Text -> Text -> IO a
throwOtherError Text
"EINVALIDUTF8" Text
"invalid UTF8 bytes"
else do
if PrimArray Word8 -> Int -> Int
T.decodeCharLen PrimArray Word8
arr (Int
s forall a. Num a => a -> a -> a
+ Int
i) forall a. Ord a => a -> a -> Bool
> Int
l forall a. Num a => a -> a -> a
- Int
i
then do
forall a. IORef a -> a -> IO ()
writeIORef IORef Bytes
trailingRef (forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
V.fromArr PrimArray Word8
arr (Int
sforall a. Num a => a -> a -> a
+Int
i) (Int
lforall a. Num a => a -> a -> a
-Int
i))
Maybe Text -> IO ()
k (forall a. a -> Maybe a
Just (HasCallStack => Bytes -> Text
T.validate (forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
V.fromArr PrimArray Word8
arr Int
s Int
i)))
else do
forall a. IORef a -> a -> IO ()
writeIORef IORef Bytes
trailingRef forall (v :: * -> *) a. Vec v a => v a
V.empty
Maybe Text -> IO ()
k (forall a. a -> Maybe a
Just (HasCallStack => Bytes -> Text
T.validate Bytes
chunk))
else forall a. IORef a -> a -> IO ()
writeIORef IORef Bytes
trailingRef Bytes
chunk
Maybe Bytes
_ -> do
Bytes
trailing <- forall a. IORef a -> IO a
readIORef IORef Bytes
trailingRef
if forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
trailing
then Maybe Text -> IO ()
k forall a. Maybe a
EOF
else forall a. HasCallStack => Text -> Text -> IO a
throwOtherError Text
"EINVALIDUTF8" Text
"invalid UTF8 bytes"
newMagicSplitter :: Word8 -> IO (BIO V.Bytes V.Bytes)
{-# INLINABLE newMagicSplitter #-}
newMagicSplitter :: Word8 -> IO (BIO Bytes Bytes)
newMagicSplitter Word8
magic = do
IORef Bytes
trailingRef <- forall a. a -> IO (IORef a)
newIORef forall (v :: * -> *) a. Vec v a => v a
V.empty
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \ Maybe Bytes -> IO ()
k Maybe Bytes
mx ->
case Maybe Bytes
mx of
Just Bytes
bs -> do
Bytes
trailing <- forall a. IORef a -> IO a
readIORef IORef Bytes
trailingRef
let loop :: Bytes -> IO ()
loop Bytes
chunk = case forall (v :: * -> *) a. (Vec v a, Eq a) => a -> v a -> Maybe Int
V.elemIndex Word8
magic Bytes
chunk of
Just Int
i -> do
let (Bytes
line, Bytes
rest) = forall (v :: * -> *) a. Vec v a => Int -> v a -> (v a, v a)
V.splitAt (Int
iforall a. Num a => a -> a -> a
+Int
1) Bytes
chunk
Maybe Bytes -> IO ()
k (forall a. a -> Maybe a
Just Bytes
line)
Bytes -> IO ()
loop Bytes
rest
Maybe Int
_ -> forall a. IORef a -> a -> IO ()
writeIORef IORef Bytes
trailingRef Bytes
chunk
Bytes -> IO ()
loop (Bytes
trailing forall (v :: * -> *) a. Vec v a => v a -> v a -> v a
`V.append` Bytes
bs)
Maybe Bytes
_ -> do
Bytes
chunk <- forall a. IORef a -> IO a
readIORef IORef Bytes
trailingRef
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
chunk) forall a b. (a -> b) -> a -> b
$ do
forall a. IORef a -> a -> IO ()
writeIORef IORef Bytes
trailingRef forall (v :: * -> *) a. Vec v a => v a
V.empty
Maybe Bytes -> IO ()
k (forall a. a -> Maybe a
Just Bytes
chunk)
Maybe Bytes -> IO ()
k forall a. Maybe a
EOF
newLineSplitter :: IO (BIO V.Bytes V.Bytes)
{-# INLINABLE newLineSplitter #-}
newLineSplitter :: IO (BIO Bytes Bytes)
newLineSplitter = do
BIO Bytes Bytes
s <- Word8 -> IO (BIO Bytes Bytes)
newMagicSplitter Word8
10
forall (m :: * -> *) a. Monad m => a -> m a
return (BIO Bytes Bytes
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> BIO a b
fromPure forall {a}. (Prim a, Eq a, Num a) => PrimVector a -> PrimVector a
dropLineEnd)
where
dropLineEnd :: PrimVector a -> PrimVector a
dropLineEnd bs :: PrimVector a
bs@(V.PrimVector PrimArray a
arr Int
s Int
l) =
case PrimVector a
bs forall (v :: * -> *) a. Vec v a => v a -> Int -> Maybe a
`V.indexMaybe` (Int
lforall a. Num a => a -> a -> a
-Int
2) of
Just a
r | a
r forall a. Eq a => a -> a -> Bool
== a
13 -> forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray a
arr Int
s (Int
lforall a. Num a => a -> a -> a
-Int
2)
| Bool
otherwise -> forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray a
arr Int
s (Int
lforall a. Num a => a -> a -> a
-Int
1)
Maybe a
_ | forall (v :: * -> *) a. (Vec v a, HasCallStack) => v a -> a
V.head PrimVector a
bs forall a. Eq a => a -> a -> Bool
== a
10 -> forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray a
arr Int
s (Int
lforall a. Num a => a -> a -> a
-Int
1)
| Bool
otherwise -> forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray a
arr Int
s Int
l
newBase64Encoder :: IO (BIO V.Bytes V.Bytes)
{-# INLINABLE newBase64Encoder #-}
newBase64Encoder :: IO (BIO Bytes Bytes)
newBase64Encoder = do
BIO Bytes Bytes
re <- Int -> IO (BIO Bytes Bytes)
newReChunk Int
3
forall (m :: * -> *) a. Monad m => a -> m a
return (BIO Bytes Bytes
re forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> BIO a b
fromPure Bytes -> Bytes
base64Encode)
newBase64Decoder :: HasCallStack => IO (BIO V.Bytes V.Bytes)
{-# INLINABLE newBase64Decoder #-}
newBase64Decoder :: HasCallStack => IO (BIO Bytes Bytes)
newBase64Decoder = do
BIO Bytes Bytes
re <- Int -> IO (BIO Bytes Bytes)
newReChunk Int
4
forall (m :: * -> *) a. Monad m => a -> m a
return (BIO Bytes Bytes
re forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> BIO a b
fromPure HasCallStack => Bytes -> Bytes
base64Decode')
hexEncode :: Bool
-> BIO V.Bytes V.Bytes
{-# INLINABLE hexEncode #-}
hexEncode :: Bool -> BIO Bytes Bytes
hexEncode Bool
upper = forall a b. (a -> b) -> BIO a b
fromPure (Bool -> Bytes -> Bytes
Hex.hexEncode Bool
upper)
newHexDecoder :: IO (BIO V.Bytes V.Bytes)
{-# INLINABLE newHexDecoder #-}
newHexDecoder :: IO (BIO Bytes Bytes)
newHexDecoder = do
BIO Bytes Bytes
re <- Int -> IO (BIO Bytes Bytes)
newReChunk Int
2
forall (m :: * -> *) a. Monad m => a -> m a
return (BIO Bytes Bytes
re forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> BIO a b
fromPure HasCallStack => Bytes -> Bytes
Hex.hexDecode')
counter :: Counter -> BIO a a
{-# INLINABLE counter #-}
counter :: forall a. Counter -> BIO a a
counter Counter
c = forall a b. HasCallStack => (a -> IO b) -> BIO a b
fromIO a -> IO a
inc
where
inc :: a -> IO a
inc a
x = do
Counter -> Int -> IO ()
atomicAddCounter_ Counter
c Int
1
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
seqNum :: Counter -> BIO a (Int, a)
{-# INLINABLE seqNum #-}
seqNum :: forall a. Counter -> BIO a (Int, a)
seqNum Counter
c = forall a b. HasCallStack => (a -> IO b) -> BIO a b
fromIO a -> IO (Int, a)
inc
where
inc :: a -> IO (Int, a)
inc a
x = do
Int
i <- Counter -> Int -> IO Int
atomicAddCounter Counter
c Int
1
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, a
x)
newGrouping :: V.Vec v a => Int -> IO (BIO a (v a))
{-# INLINABLE newGrouping #-}
newGrouping :: forall (v :: * -> *) a. Vec v a => Int -> IO (BIO a (v a))
newGrouping Int
n
| Int
n forall a. Ord a => a -> a -> Bool
< Int
1 = forall (v :: * -> *) a. Vec v a => Int -> IO (BIO a (v a))
newGrouping Int
1
| Bool
otherwise = do
Counter
c <- Int -> IO Counter
newCounter Int
0
IORef (MArr (IArray v) RealWorld a)
arrRef <- forall a. a -> IO (IORef a)
newIORef forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack) =>
Int -> m (MArr arr s a)
A.newArr Int
n
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \ Maybe (v a) -> IO ()
k Maybe a
mx ->
case Maybe a
mx of
Just a
x -> do
Int
i <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
PrimRef (PrimState m) a -> m a
readPrimRef Counter
c
if Int
i forall a. Eq a => a -> a -> Bool
== Int
n forall a. Num a => a -> a -> a
- Int
1
then do
MArr (IArray v) RealWorld a
marr <- forall a. IORef a -> IO a
readIORef IORef (MArr (IArray v) RealWorld a)
arrRef
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack) =>
MArr arr s a -> Int -> a -> m ()
A.writeArr MArr (IArray v) RealWorld a
marr Int
i a
x
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
PrimRef (PrimState m) a -> a -> m ()
writePrimRef Counter
c Int
0
forall a. IORef a -> a -> IO ()
writeIORef IORef (MArr (IArray v) RealWorld a)
arrRef forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack) =>
Int -> m (MArr arr s a)
A.newArr Int
n
IArray v a
arr <- forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
A.unsafeFreezeArr MArr (IArray v) RealWorld a
marr
Maybe (v a) -> IO ()
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
V.fromArr IArray v a
arr Int
0 Int
n
else do
MArr (IArray v) RealWorld a
marr <- forall a. IORef a -> IO a
readIORef IORef (MArr (IArray v) RealWorld a)
arrRef
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack) =>
MArr arr s a -> Int -> a -> m ()
A.writeArr MArr (IArray v) RealWorld a
marr Int
i a
x
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
PrimRef (PrimState m) a -> a -> m ()
writePrimRef Counter
c (Int
iforall a. Num a => a -> a -> a
+Int
1)
Maybe a
_ -> do
Int
i <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
PrimRef (PrimState m) a -> m a
readPrimRef Counter
c
if Int
i forall a. Eq a => a -> a -> Bool
/= Int
0
then do
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
PrimRef (PrimState m) a -> a -> m ()
writePrimRef Counter
c Int
0
MArr (IArray v) RealWorld a
marr <- forall a. IORef a -> IO a
readIORef IORef (MArr (IArray v) RealWorld a)
arrRef
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s, HasCallStack) =>
MArr arr s a -> Int -> m ()
A.shrinkMutableArr MArr (IArray v) RealWorld a
marr Int
i
IArray v a
arr <- forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
A.unsafeFreezeArr MArr (IArray v) RealWorld a
marr
Maybe (v a) -> IO ()
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
V.fromArr IArray v a
arr Int
0 Int
i
else Maybe (v a) -> IO ()
k forall a. Maybe a
EOF
ungrouping :: BIO (V.Vector a) a
{-# INLINABLE ungrouping #-}
ungrouping :: forall a. BIO (Vector a) a
ungrouping = \ Maybe a -> IO ()
k Maybe (Vector a)
mx ->
case Maybe (Vector a)
mx of
Just Vector a
x -> forall (v :: * -> *) a (f :: * -> *) b.
(Vec v a, Applicative f) =>
(a -> f b) -> v a -> f ()
V.traverse_ (Maybe a -> IO ()
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) Vector a
x
Maybe (Vector a)
_ -> Maybe a -> IO ()
k forall a. Maybe a
EOF
consumed :: TVar Bool -> BIO a a
{-# INLINABLE consumed #-}
consumed :: forall a. TVar Bool -> BIO a a
consumed TVar Bool
ref = \ Maybe a -> IO ()
k Maybe a
mx -> case Maybe a
mx of
Just a
_ -> Maybe a -> IO ()
k Maybe a
mx
Maybe a
_ -> do forall a. STM a -> IO a
atomically (forall a. TVar a -> a -> STM ()
writeTVar TVar Bool
ref Bool
True)
Maybe a -> IO ()
k forall a. Maybe a
EOF