{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UnboxedTuples         #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE UnliftedFFITypes      #-}

-- |
-- Module      : Streaming.ByteString.Internal
-- Copyright   : (c) Don Stewart 2006
--               (c) Duncan Coutts 2006-2011
--               (c) Michael Thompson 2015
-- License     : BSD-style

module Streaming.ByteString.Internal
  ( ByteStream(..)
  , ByteString
  , consChunk
  , chunkOverhead
  , defaultChunkSize
  , materialize
  , dematerialize
  , foldrChunks
  , foldlChunks

  , foldrChunksM
  , foldlChunksM
  , chunkFold
  , chunkFoldM
  , chunkMap
  , chunkMapM
  , chunkMapM_
  , unfoldMChunks
  , unfoldrChunks

  , packChars
  , packBytes
  , unpackBytes
  , chunk
  , smallChunkSize
  , mwrap
  , unfoldrNE
  , reread
  , unsafeLast
  , unsafeInit
  , copy
  , findIndexOrEnd

    -- * ResourceT help
  , bracketByteString

    -- * Re-export from GHC 9.0
  , unsafeWithForeignPtr
  ) where

import           Control.Monad
import           Control.Monad.Morph
import           Control.Monad.Trans
import           Prelude hiding
    (all, any, appendFile, break, concat, concatMap, cycle, drop, dropWhile,
    elem, filter, foldl, foldl1, foldr, foldr1, getContents, getLine, head,
    init, interact, iterate, last, length, lines, map, maximum, minimum,
    notElem, null, putStr, putStrLn, readFile, repeat, replicate, reverse,
    scanl, scanl1, scanr, scanr1, span, splitAt, tail, take, takeWhile,
    unlines, unzip, writeFile, zip, zipWith)
import qualified Prelude

#if !MIN_VERSION_base(4,11,0)
import           Data.Semigroup
#endif

import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B

import           Streaming (Of(..))
import           Streaming.Internal hiding (concats)
import qualified Streaming.Prelude as SP

import           Data.String
import           Foreign.Ptr
import           Foreign.Storable
import           GHC.Types (SPEC(..))

import           Data.Functor.Identity
import           Data.Word
import           GHC.Base (realWorld#)
import           GHC.IO (IO(IO))
import           System.IO.Unsafe (unsafePerformIO)

import           Control.Monad.Base
import           Control.Monad.Catch (MonadCatch(..))
import           Control.Monad.Trans.Resource

#if MIN_VERSION_base(4,15,0)
import           GHC.ForeignPtr (unsafeWithForeignPtr)
#else
import           Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
#endif

#if !MIN_VERSION_base(4,15,0)
-- | Synonym of 'withForeignPtr' for GHC prior to 9.0.
unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr = withForeignPtr
#endif

-- | A type alias for back-compatibility.
type ByteString = ByteStream
{-# DEPRECATED ByteString "Use ByteStream instead." #-}

-- | A space-efficient representation of a succession of 'Word8' vectors,
-- supporting many efficient operations.
--
-- An effectful 'ByteStream' contains 8-bit bytes, or by using the operations
-- from "Streaming.ByteString.Char8" it can be interpreted as containing
-- 8-bit characters.
data ByteStream m r =
  Empty r
  | Chunk {-# UNPACK #-} !B.ByteString (ByteStream m r )
  | Go (m (ByteStream m r ))

instance Monad m => Functor (ByteStream m) where
  fmap :: forall a b. (a -> b) -> ByteStream m a -> ByteStream m b
fmap a -> b
f ByteStream m a
x = case ByteStream m a
x of
    Empty a
a      -> forall (m :: * -> *) r. r -> ByteStream m r
Empty (a -> b
f a
a)
    Chunk ByteString
bs ByteStream m a
bss -> forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk ByteString
bs (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ByteStream m a
bss)
    Go m (ByteStream m a)
mbss      -> forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) m (ByteStream m a)
mbss)

instance Monad m => Applicative (ByteStream m) where
  pure :: forall a. a -> ByteStream m a
pure = forall (m :: * -> *) r. r -> ByteStream m r
Empty
  {-# INLINE pure #-}
  ByteStream m (a -> b)
bf <*> :: forall a b.
ByteStream m (a -> b) -> ByteStream m a -> ByteStream m b
<*> ByteStream m a
bx = do {a -> b
f <- ByteStream m (a -> b)
bf; a
x <- ByteStream m a
bx; forall (m :: * -> *) r. r -> ByteStream m r
Empty (a -> b
f a
x)}
  {-# INLINE (<*>) #-}
  ByteStream m a
x0 *> :: forall a b. ByteStream m a -> ByteStream m b -> ByteStream m b
*> ByteStream m b
y = SPEC -> ByteStream m a -> ByteStream m b
loop SPEC
SPEC ByteStream m a
x0 where
    loop :: SPEC -> ByteStream m a -> ByteStream m b
loop !SPEC
_ ByteStream m a
x = case ByteStream m a
x of   -- this seems to be insanely effective
      Empty a
_   -> ByteStream m b
y
      Chunk ByteString
a ByteStream m a
b -> forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk ByteString
a (SPEC -> ByteStream m a -> ByteStream m b
loop SPEC
SPEC ByteStream m a
b)
      Go m (ByteStream m a)
m      -> forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SPEC -> ByteStream m a -> ByteStream m b
loop SPEC
SPEC) m (ByteStream m a)
m)
  {-# INLINEABLE (*>) #-}

instance Monad m => Monad (ByteStream m) where
  return :: forall a. a -> ByteStream m a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE return #-}
  >> :: forall a b. ByteStream m a -> ByteStream m b -> ByteStream m b
(>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
  {-# INLINE (>>) #-}
  ByteStream m a
x >>= :: forall a b.
ByteStream m a -> (a -> ByteStream m b) -> ByteStream m b
>>= a -> ByteStream m b
f =
    -- case x of
    --   Empty a -> f a
    --   Chunk bs bss -> Chunk bs (bss >>= f)
    --   Go mbss      -> Go (fmap (>>= f) mbss)
    SPEC -> ByteStream m a -> ByteStream m b
loop SPEC
SPEC2 ByteStream m a
x where -- unlike >> this SPEC seems pointless
      loop :: SPEC -> ByteStream m a -> ByteStream m b
loop !SPEC
_ ByteStream m a
y = case ByteStream m a
y of
        Empty a
a      -> a -> ByteStream m b
f a
a
        Chunk ByteString
bs ByteStream m a
bss -> forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk ByteString
bs (SPEC -> ByteStream m a -> ByteStream m b
loop SPEC
SPEC ByteStream m a
bss)
        Go m (ByteStream m a)
mbss      -> forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SPEC -> ByteStream m a -> ByteStream m b
loop SPEC
SPEC) m (ByteStream m a)
mbss)
  {-# INLINEABLE (>>=) #-}

instance MonadIO m => MonadIO (ByteStream m) where
  liftIO :: forall a. IO a -> ByteStream m a
liftIO IO a
io = forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) r. r -> ByteStream m r
Empty (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
io))
  {-# INLINE liftIO #-}

instance MonadTrans ByteStream where
  lift :: forall (m :: * -> *) a. Monad m => m a -> ByteStream m a
lift m a
ma = forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) r. r -> ByteStream m r
Empty m a
ma
  {-# INLINE lift #-}

instance MFunctor ByteStream where
  hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> ByteStream m b -> ByteStream n b
hoist forall a. m a -> n a
phi ByteStream m b
bs = case ByteStream m b
bs of
    Empty b
r        -> forall (m :: * -> *) r. r -> ByteStream m r
Empty b
r
    Chunk ByteString
bs' ByteStream m b
rest -> forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk ByteString
bs' (forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> n a
phi ByteStream m b
rest)
    Go m (ByteStream m b)
m           -> forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go (forall a. m a -> n a
phi (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> n a
phi) m (ByteStream m b)
m))
  {-# INLINABLE hoist #-}

instance (r ~ ()) => IsString (ByteStream m r) where
  fromString :: String -> ByteStream m r
fromString = forall (m :: * -> *). ByteString -> ByteStream m ()
chunk forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
B.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
Prelude.map Char -> Word8
B.c2w
  {-# INLINE fromString #-}

instance (m ~ Identity, Show r) => Show (ByteStream m r) where
  show :: ByteStream m r -> String
show ByteStream m r
bs0 = case ByteStream m r
bs0 of  -- the implementation this instance deserves ...
    Empty r
r           -> String
"Empty (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show r
r forall a. [a] -> [a] -> [a]
++ String
")"
    Go (Identity ByteStream m r
bs') -> String
"Go (Identity (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ByteStream m r
bs' forall a. [a] -> [a] -> [a]
++ String
"))"
    Chunk ByteString
bs'' ByteStream m r
bs     -> String
"Chunk " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ByteString
bs'' forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ByteStream m r
bs forall a. [a] -> [a] -> [a]
++ String
")"

instance (Semigroup r, Monad m) => Semigroup (ByteStream m r) where
  <> :: ByteStream m r -> ByteStream m r -> ByteStream m r
(<>) = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. Semigroup a => a -> a -> a
(<>)
  {-# INLINE (<>) #-}

instance (Monoid r, Monad m) => Monoid (ByteStream m r) where
  mempty :: ByteStream m r
mempty = forall (m :: * -> *) r. r -> ByteStream m r
Empty forall a. Monoid a => a
mempty
  {-# INLINE mempty #-}
#if MIN_VERSION_base(4,11,0)
  mappend :: ByteStream m r -> ByteStream m r -> ByteStream m r
mappend = forall a. Semigroup a => a -> a -> a
(<>)
#else
  mappend = liftM2 mappend
#endif
  {-# INLINE mappend #-}

instance (MonadBase b m) => MonadBase b (ByteStream m) where
  liftBase :: forall α. b α -> ByteStream m α
liftBase  = forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
mwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase
  {-# INLINE liftBase #-}

instance (MonadThrow m) => MonadThrow (ByteStream m) where
  throwM :: forall e a. Exception e => e -> ByteStream m a
throwM = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
  {-# INLINE throwM #-}

instance (MonadCatch m) => MonadCatch (ByteStream m) where
  catch :: forall e a.
Exception e =>
ByteStream m a -> (e -> ByteStream m a) -> ByteStream m a
catch ByteStream m a
str e -> ByteStream m a
f = ByteStream m a -> ByteStream m a
go ByteStream m a
str
    where
    go :: ByteStream m a -> ByteStream m a
go ByteStream m a
p = case ByteStream m a
p of
      Chunk ByteString
bs ByteStream m a
rest  -> forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk ByteString
bs (ByteStream m a -> ByteStream m a
go ByteStream m a
rest)
      Empty  a
r       -> forall (m :: * -> *) r. r -> ByteStream m r
Empty a
r
      Go  m (ByteStream m a)
m          -> forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go (forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (do
          ByteStream m a
p' <- m (ByteStream m a)
m
          forall (m :: * -> *) a. Monad m => a -> m a
return (ByteStream m a -> ByteStream m a
go ByteStream m a
p'))
       (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ByteStream m a
f))
  {-# INLINABLE catch #-}

instance (MonadResource m) => MonadResource (ByteStream m) where
  liftResourceT :: forall a. ResourceT IO a -> ByteStream m a
liftResourceT = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadResource m => ResourceT IO a -> m a
liftResourceT
  {-# INLINE liftResourceT #-}

-- | Like @bracket@, but specialized for `ByteString`.
bracketByteString :: MonadResource m => IO a -> (a -> IO ()) -> (a -> ByteStream m b) -> ByteStream m b
bracketByteString :: forall (m :: * -> *) a b.
MonadResource m =>
IO a -> (a -> IO ()) -> (a -> ByteStream m b) -> ByteStream m b
bracketByteString IO a
alloc a -> IO ()
free a -> ByteStream m b
inside = do
        (ReleaseKey
key, a
seed) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate IO a
alloc a -> IO ()
free)
        forall {m :: * -> *} {r}.
MonadIO m =>
ReleaseKey -> ByteStream m r -> ByteStream m r
clean ReleaseKey
key (a -> ByteStream m b
inside a
seed)
  where
    clean :: ReleaseKey -> ByteStream m r -> ByteStream m r
clean ReleaseKey
key = ByteStream m r -> ByteStream m r
loop where
      loop :: ByteStream m r -> ByteStream m r
loop ByteStream m r
str = case ByteStream m r
str of
        Empty r
r       -> forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go (forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
release ReleaseKey
key forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) r. r -> ByteStream m r
Empty r
r))
        Go m (ByteStream m r)
m          -> forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteStream m r -> ByteStream m r
loop m (ByteStream m r)
m)
        Chunk ByteString
bs ByteStream m r
rest -> forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk ByteString
bs (ByteStream m r -> ByteStream m r
loop ByteStream m r
rest)
{-# INLINABLE bracketByteString #-}

-- -- ------------------------------------------------------------------------
--
-- | Smart constructor for 'Chunk'.
consChunk :: B.ByteString -> ByteStream m r -> ByteStream m r
consChunk :: forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
consChunk c :: ByteString
c@(B.PS ForeignPtr Word8
_ Int
_ Int
len) ByteStream m r
cs
  | Int
len forall a. Eq a => a -> a -> Bool
== Int
0  = ByteStream m r
cs
  | Bool
otherwise = forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk ByteString
c ByteStream m r
cs
{-# INLINE consChunk #-}

-- | Yield-style smart constructor for 'Chunk'.
chunk :: B.ByteString -> ByteStream m ()
chunk :: forall (m :: * -> *). ByteString -> ByteStream m ()
chunk ByteString
bs = forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
consChunk ByteString
bs (forall (m :: * -> *) r. r -> ByteStream m r
Empty ())
{-# INLINE chunk #-}


{- | Reconceive an effect that results in an effectful bytestring as an effectful bytestring.
    Compare Streaming.mwrap. The closest equivalent of

>>> Streaming.wrap :: f (Stream f m r) -> Stream f m r

    is here  @consChunk@. @mwrap@ is the smart constructor for the internal @Go@ constructor.
-}
mwrap :: m (ByteStream m r) -> ByteStream m r
mwrap :: forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
mwrap = forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go
{-# INLINE mwrap #-}

-- | Construct a succession of chunks from its Church encoding (compare @GHC.Exts.build@)
materialize :: (forall x . (r -> x) -> (B.ByteString -> x -> x) -> (m x -> x) -> x) -> ByteStream m r
materialize :: forall r (m :: * -> *).
(forall x. (r -> x) -> (ByteString -> x -> x) -> (m x -> x) -> x)
-> ByteStream m r
materialize forall x. (r -> x) -> (ByteString -> x -> x) -> (m x -> x) -> x
phi = forall x. (r -> x) -> (ByteString -> x -> x) -> (m x -> x) -> x
phi forall (m :: * -> *) r. r -> ByteStream m r
Empty forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go
{-# INLINE[0] materialize #-}

-- | Resolve a succession of chunks into its Church encoding; this is
-- not a safe operation; it is equivalent to exposing the constructors
dematerialize :: Monad m
              => ByteStream m r
              -> (forall x . (r -> x) -> (B.ByteString -> x -> x) -> (m x -> x) -> x)
dematerialize :: forall (m :: * -> *) r.
Monad m =>
ByteStream m r
-> forall x. (r -> x) -> (ByteString -> x -> x) -> (m x -> x) -> x
dematerialize ByteStream m r
x0 r -> x
nil ByteString -> x -> x
cons m x -> x
mwrap' = SPEC -> ByteStream m r -> x
loop SPEC
SPEC ByteStream m r
x0
  where
  loop :: SPEC -> ByteStream m r -> x
loop !SPEC
_ ByteStream m r
x = case ByteStream m r
x of
     Empty r
r    -> r -> x
nil r
r
     Chunk ByteString
b ByteStream m r
bs -> ByteString -> x -> x
cons ByteString
b (SPEC -> ByteStream m r -> x
loop SPEC
SPEC ByteStream m r
bs )
     Go m (ByteStream m r)
ms      -> m x -> x
mwrap' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SPEC -> ByteStream m r -> x
loop SPEC
SPEC) m (ByteStream m r)
ms)
{-# INLINE [1] dematerialize #-}

{-# RULES
  "dematerialize/materialize" forall (phi :: forall b . (r -> b) -> (B.ByteString -> b -> b) -> (m b -> b)  -> b). dematerialize (materialize phi) = phi ;
  #-}
------------------------------------------------------------------------

-- The representation uses lists of packed chunks. When we have to convert from
-- a lazy list to the chunked representation, then by default we use this
-- chunk size. Some functions give you more control over the chunk size.
--
-- Measurements here:
--  http://www.cse.unsw.edu.au/~dons/tmp/chunksize_v_cache.png
--
-- indicate that a value around 0.5 to 1 x your L2 cache is best.
-- The following value assumes people have something greater than 128k,
-- and need to share the cache with other programs.

-- | The chunk size used for I\/O. Currently set to 32k, less the memory management overhead
defaultChunkSize :: Int
defaultChunkSize :: Int
defaultChunkSize = Int
32 forall a. Num a => a -> a -> a
* Int
k forall a. Num a => a -> a -> a
- Int
chunkOverhead
   where k :: Int
k = Int
1024
{-# INLINE defaultChunkSize #-}
-- | The recommended chunk size. Currently set to 4k, less the memory management overhead
smallChunkSize :: Int
smallChunkSize :: Int
smallChunkSize = Int
4 forall a. Num a => a -> a -> a
* Int
k forall a. Num a => a -> a -> a
- Int
chunkOverhead
   where k :: Int
k = Int
1024
{-# INLINE smallChunkSize #-}

-- | The memory management overhead. Currently this is tuned for GHC only.
chunkOverhead :: Int
chunkOverhead :: Int
chunkOverhead = Int
2 forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: Int)
{-# INLINE chunkOverhead #-}

-- | Packing and unpacking from lists
-- packBytes' :: Monad m => [Word8] -> ByteString m ()
-- packBytes' cs0 =
--     packChunks 32 cs0
--   where
--     packChunks n cs = case B.packUptoLenBytes n cs of
--       (bs, [])  -> Chunk bs (Empty ())
--       (bs, cs') -> Chunk bs (packChunks (min (n * 2) BI.smallChunkSize) cs')
--     -- packUptoLenBytes :: Int -> [Word8] -> (ByteString, [Word8])
--     packUptoLenBytes len xs0 =
--         accursedUnutterablePerformIO (createUptoN' len $ \p -> go p len xs0)
--       where
--         go !_ !n []     = return (len-n, [])
--         go !_ !0 xs     = return (len,   xs)
--         go !p !n (x:xs) = poke p x >> go (p `plusPtr` 1) (n-1) xs
--         createUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> IO (B.ByteString, a)
--         createUptoN' l f = do
--             fp <- B.mallocByteString l
--             (l', res) <- withForeignPtr fp $ \p -> f p
--             assert (l' <= l) $ return (B.PS fp 0 l', res)
-- {-# INLINABLE packBytes' #-}

-- | Convert a `Stream` of pure `Word8` into a chunked 'ByteStream'.
packBytes :: Monad m => Stream (Of Word8) m r -> ByteStream m r
packBytes :: forall (m :: * -> *) r.
Monad m =>
Stream (Of Word8) m r -> ByteStream m r
packBytes Stream (Of Word8) m r
cs0 = do
  -- XXX: Why 32?  It seems like a rather small chunk size, wouldn't
  -- smallChunkSize make a better choice?
  ([Word8]
bytes :> Stream (Of Word8) m r
rest) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> m (Of [a] r)
SP.toList forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
Int -> Stream f m r -> Stream f m (Stream f m r)
SP.splitAt Int
32 Stream (Of Word8) m r
cs0
  case [Word8]
bytes of
    [] -> case Stream (Of Word8) m r
rest of
      Return r
r -> forall (m :: * -> *) r. r -> ByteStream m r
Empty r
r
      Step Of Word8 (Stream (Of Word8) m r)
as  -> forall (m :: * -> *) r.
Monad m =>
Stream (Of Word8) m r -> ByteStream m r
packBytes (forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step Of Word8 (Stream (Of Word8) m r)
as)  -- these two pattern matches
      Effect m (Stream (Of Word8) m r)
m -> forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) r.
Monad m =>
Stream (Of Word8) m r -> ByteStream m r
packBytes m (Stream (Of Word8) m r)
m -- should be avoided.
    [Word8]
_  -> forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk ([Word8] -> ByteString
B.packBytes [Word8]
bytes) (forall (m :: * -> *) r.
Monad m =>
Stream (Of Word8) m r -> ByteStream m r
packBytes Stream (Of Word8) m r
rest)
{-# INLINABLE packBytes #-}

-- | Convert a vanilla `Stream` of characters into a stream of bytes.
--
-- /Note:/ Each `Char` value is truncated to 8 bits.
packChars :: Monad m => Stream (Of Char) m r -> ByteStream m r
packChars :: forall (m :: * -> *) r.
Monad m =>
Stream (Of Char) m r -> ByteStream m r
packChars Stream (Of Char) m r
str = do
  -- XXX: Why 32?  It seems like a rather small chunk size, wouldn't
  -- smallChunkSize make a better choice?
  --
  -- We avoid the cost of converting the stream of Chars to a stream
  -- of Word8 (passed to packBytes), and instead pass the original
  -- `Char` arrays to 'B.packChars', which will be more efficient,
  -- the conversion there will be essentially free.
  (String
chars :> Stream (Of Char) m r
rest) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> m (Of [a] r)
SP.toList forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
Int -> Stream f m r -> Stream f m (Stream f m r)
SP.splitAt Int
32 Stream (Of Char) m r
str
  case String
chars of
    [] -> case Stream (Of Char) m r
rest of
      Return r
r -> forall (m :: * -> *) r. r -> ByteStream m r
Empty r
r
      Step Of Char (Stream (Of Char) m r)
as  -> forall (m :: * -> *) r.
Monad m =>
Stream (Of Char) m r -> ByteStream m r
packChars (forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step Of Char (Stream (Of Char) m r)
as)  -- these two pattern matches
      Effect m (Stream (Of Char) m r)
m -> forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) r.
Monad m =>
Stream (Of Char) m r -> ByteStream m r
packChars m (Stream (Of Char) m r)
m -- should be avoided.
    String
_  -> forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk (String -> ByteString
B.packChars String
chars) (forall (m :: * -> *) r.
Monad m =>
Stream (Of Char) m r -> ByteStream m r
packChars Stream (Of Char) m r
rest)
{-# INLINABLE packChars #-}

-- | The reverse of `packChars`. Given a stream of bytes, produce a `Stream`
-- individual bytes.
unpackBytes :: Monad m => ByteStream m r -> Stream (Of Word8) m r
unpackBytes :: forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> Stream (Of Word8) m r
unpackBytes ByteStream m r
bss = forall (m :: * -> *) r.
Monad m =>
ByteStream m r
-> forall x. (r -> x) -> (ByteString -> x -> x) -> (m x -> x) -> x
dematerialize ByteStream m r
bss forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return forall (m :: * -> *) r.
ByteString -> Stream (Of Word8) m r -> Stream (Of Word8) m r
unpackAppendBytesLazy forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect
  where
  unpackAppendBytesLazy :: B.ByteString -> Stream (Of Word8) m r -> Stream (Of Word8) m r
  unpackAppendBytesLazy :: forall (m :: * -> *) r.
ByteString -> Stream (Of Word8) m r -> Stream (Of Word8) m r
unpackAppendBytesLazy b :: ByteString
b@(B.PS ForeignPtr Word8
fp Int
off Int
len) Stream (Of Word8) m r
xs
    | Int
len forall a. Ord a => a -> a -> Bool
<= Int
100 = forall (m :: * -> *) r.
ByteString -> Stream (Of Word8) m r -> Stream (Of Word8) m r
unpackAppendBytesStrict ByteString
b Stream (Of Word8) m r
xs
    | Bool
otherwise  = forall (m :: * -> *) r.
ByteString -> Stream (Of Word8) m r -> Stream (Of Word8) m r
unpackAppendBytesStrict (ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS ForeignPtr Word8
fp Int
off Int
100) Stream (Of Word8) m r
remainder
    where
      remainder :: Stream (Of Word8) m r
remainder  = forall (m :: * -> *) r.
ByteString -> Stream (Of Word8) m r -> Stream (Of Word8) m r
unpackAppendBytesLazy (ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS ForeignPtr Word8
fp (Int
offforall a. Num a => a -> a -> a
+Int
100) (Int
lenforall a. Num a => a -> a -> a
-Int
100)) Stream (Of Word8) m r
xs

  unpackAppendBytesStrict :: B.ByteString -> Stream (Of Word8) m r -> Stream (Of Word8) m r
  unpackAppendBytesStrict :: forall (m :: * -> *) r.
ByteString -> Stream (Of Word8) m r -> Stream (Of Word8) m r
unpackAppendBytesStrict (B.PS ForeignPtr Word8
fp Int
off Int
len) Stream (Of Word8) m r
xs =
    forall a. IO a -> a
B.accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
base ->
      forall {b} {m :: * -> *} {r}.
Storable b =>
Ptr b -> Ptr b -> Stream (Of b) m r -> IO (Stream (Of b) m r)
loop (Ptr Word8
base forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offforall a. Num a => a -> a -> a
-Int
1)) (Ptr Word8
base forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offforall a. Num a => a -> a -> a
-Int
1forall a. Num a => a -> a -> a
+Int
len)) Stream (Of Word8) m r
xs
    where
      loop :: Ptr b -> Ptr b -> Stream (Of b) m r -> IO (Stream (Of b) m r)
loop !Ptr b
sentinel !Ptr b
p Stream (Of b) m r
acc
        | Ptr b
p forall a. Eq a => a -> a -> Bool
== Ptr b
sentinel = forall (m :: * -> *) a. Monad m => a -> m a
return Stream (Of b) m r
acc
        | Bool
otherwise     = do
            b
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr b
p
            Ptr b -> Ptr b -> Stream (Of b) m r -> IO (Stream (Of b) m r)
loop Ptr b
sentinel (Ptr b
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)) (forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (b
x forall a b. a -> b -> Of a b
:> Stream (Of b) m r
acc))
{-# INLINABLE unpackBytes #-}

-- | Copied from Data.ByteString.Unsafe for compatibility with older bytestring.
unsafeLast :: B.ByteString -> Word8
unsafeLast :: ByteString -> Word8
unsafeLast (B.PS ForeignPtr Word8
x Int
s Int
l) =
    forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
p (Int
sforall a. Num a => a -> a -> a
+Int
lforall a. Num a => a -> a -> a
-Int
1)
 where
      accursedUnutterablePerformIO :: IO a -> a
accursedUnutterablePerformIO (IO State# RealWorld -> (# State# RealWorld, a #)
m) = case State# RealWorld -> (# State# RealWorld, a #)
m State# RealWorld
realWorld# of (# State# RealWorld
_, a
r #) -> a
r
{-# INLINE unsafeLast #-}

-- | Copied from Data.ByteString.Unsafe for compatibility with older bytestring.
unsafeInit :: B.ByteString -> B.ByteString
unsafeInit :: ByteString -> ByteString
unsafeInit (B.PS ForeignPtr Word8
ps Int
s Int
l) = ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS ForeignPtr Word8
ps Int
s (Int
lforall a. Num a => a -> a -> a
-Int
1)
{-# INLINE unsafeInit #-}

-- | Consume the chunks of an effectful `ByteString` with a natural right fold.
foldrChunks :: Monad m => (B.ByteString -> a -> a) -> a -> ByteStream m r -> m a
foldrChunks :: forall (m :: * -> *) a r.
Monad m =>
(ByteString -> a -> a) -> a -> ByteStream m r -> m a
foldrChunks ByteString -> a -> a
step a
nil ByteStream m r
bs = forall (m :: * -> *) r.
Monad m =>
ByteStream m r
-> forall x. (r -> x) -> (ByteString -> x -> x) -> (m x -> x) -> x
dematerialize ByteStream m r
bs
  (\r
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return a
nil)
  (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> a -> a
step)
  forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
{-# INLINE foldrChunks #-}

-- | Consume the chunks of an effectful `ByteString` with a left fold. Suitable
-- for use with `SP.mapped`.
foldlChunks :: Monad m => (a -> B.ByteString -> a) -> a -> ByteStream m r -> m (Of a r)
foldlChunks :: forall (m :: * -> *) a r.
Monad m =>
(a -> ByteString -> a) -> a -> ByteStream m r -> m (Of a r)
foldlChunks a -> ByteString -> a
f a
z = a -> ByteStream m r -> m (Of a r)
go a
z
  where go :: a -> ByteStream m r -> m (Of a r)
go a
a ByteStream m r
_            | a
a seq :: forall a b. a -> b -> b
`seq` Bool
False = forall a. HasCallStack => a
undefined
        go a
a (Empty r
r)    = forall (m :: * -> *) a. Monad m => a -> m a
return (a
a forall a b. a -> b -> Of a b
:> r
r)
        go a
a (Chunk ByteString
c ByteStream m r
cs) = a -> ByteStream m r -> m (Of a r)
go (a -> ByteString -> a
f a
a ByteString
c) ByteStream m r
cs
        go a
a (Go m (ByteStream m r)
m)       = m (ByteStream m r)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ByteStream m r -> m (Of a r)
go a
a
{-# INLINABLE foldlChunks #-}

-- | Instead of mapping over each `Word8` or `Char`, map over each strict
-- `B.ByteString` chunk in the stream.
chunkMap :: Monad m => (B.ByteString -> B.ByteString) -> ByteStream m r -> ByteStream m r
chunkMap :: forall (m :: * -> *) r.
Monad m =>
(ByteString -> ByteString) -> ByteStream m r -> ByteStream m r
chunkMap ByteString -> ByteString
f ByteStream m r
bs = forall (m :: * -> *) r.
Monad m =>
ByteStream m r
-> forall x. (r -> x) -> (ByteString -> x -> x) -> (m x -> x) -> x
dematerialize ByteStream m r
bs forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
f) forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go
{-# INLINE chunkMap #-}

-- | Like `chunkMap`, but map effectfully.
chunkMapM :: Monad m => (B.ByteString -> m B.ByteString) -> ByteStream m r -> ByteStream m r
chunkMapM :: forall (m :: * -> *) r.
Monad m =>
(ByteString -> m ByteString) -> ByteStream m r -> ByteStream m r
chunkMapM ByteString -> m ByteString
f ByteStream m r
bs = forall (m :: * -> *) r.
Monad m =>
ByteStream m r
-> forall x. (r -> x) -> (ByteString -> x -> x) -> (m x -> x) -> x
dematerialize ByteStream m r
bs forall (m :: * -> *) a. Monad m => a -> m a
return (\ByteString
bs' ByteStream m r
bss -> forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
`Chunk` ByteStream m r
bss) (ByteString -> m ByteString
f ByteString
bs'))) forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go
{-# INLINE chunkMapM #-}

-- | Like `chunkMapM`, but discard the result of each effectful mapping.
chunkMapM_ :: Monad m => (B.ByteString -> m x) -> ByteStream m r -> m r
chunkMapM_ :: forall (m :: * -> *) x r.
Monad m =>
(ByteString -> m x) -> ByteStream m r -> m r
chunkMapM_ ByteString -> m x
f ByteStream m r
bs = forall (m :: * -> *) r.
Monad m =>
ByteStream m r
-> forall x. (r -> x) -> (ByteString -> x -> x) -> (m x -> x) -> x
dematerialize ByteStream m r
bs forall (m :: * -> *) a. Monad m => a -> m a
return (\ByteString
bs' m r
mr -> ByteString -> m x
f ByteString
bs' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m r
mr) forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
{-# INLINE chunkMapM_ #-}

-- | @chunkFold@ is preferable to @foldlChunks@ since it is an appropriate
-- argument for @Control.Foldl.purely@ which permits many folds and sinks to be
-- run simultaneously on one bytestream.
chunkFold :: Monad m => (x -> B.ByteString -> x) -> x -> (x -> a) -> ByteStream m r -> m (Of a r)
chunkFold :: forall (m :: * -> *) x a r.
Monad m =>
(x -> ByteString -> x)
-> x -> (x -> a) -> ByteStream m r -> m (Of a r)
chunkFold x -> ByteString -> x
step x
begin x -> a
done = x -> ByteStream m r -> m (Of a r)
go x
begin
  where go :: x -> ByteStream m r -> m (Of a r)
go x
a ByteStream m r
_            | x
a seq :: forall a b. a -> b -> b
`seq` Bool
False = forall a. HasCallStack => a
undefined
        go x
a (Empty r
r)    = forall (m :: * -> *) a. Monad m => a -> m a
return (x -> a
done x
a forall a b. a -> b -> Of a b
:> r
r)
        go x
a (Chunk ByteString
c ByteStream m r
cs) = x -> ByteStream m r -> m (Of a r)
go (x -> ByteString -> x
step x
a ByteString
c) ByteStream m r
cs
        go x
a (Go m (ByteStream m r)
m)       = m (ByteStream m r)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x -> ByteStream m r -> m (Of a r)
go x
a
{-# INLINABLE chunkFold #-}

-- | 'chunkFoldM' is preferable to 'foldlChunksM' since it is an appropriate
-- argument for 'Control.Foldl.impurely' which permits many folds and sinks to
-- be run simultaneously on one bytestream.
chunkFoldM :: Monad m => (x -> B.ByteString -> m x) -> m x -> (x -> m a) -> ByteStream m r -> m (Of a r)
chunkFoldM :: forall (m :: * -> *) x a r.
Monad m =>
(x -> ByteString -> m x)
-> m x -> (x -> m a) -> ByteStream m r -> m (Of a r)
chunkFoldM x -> ByteString -> m x
step m x
begin x -> m a
done ByteStream m r
bs = m x
begin forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteStream m r -> x -> m (Of a r)
go ByteStream m r
bs
  where
    go :: ByteStream m r -> x -> m (Of a r)
go ByteStream m r
str !x
x = case ByteStream m r
str of
      Empty r
r    -> x -> m a
done x
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
a forall a b. a -> b -> Of a b
:> r
r)
      Chunk ByteString
c ByteStream m r
cs -> x -> ByteString -> m x
step x
x ByteString
c forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteStream m r -> x -> m (Of a r)
go ByteStream m r
cs
      Go m (ByteStream m r)
m       -> m (ByteStream m r)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteStream m r
str' -> ByteStream m r -> x -> m (Of a r)
go ByteStream m r
str' x
x
{-# INLINABLE chunkFoldM  #-}

-- | Like `foldlChunks`, but fold effectfully. Suitable for use with `SP.mapped`.
foldlChunksM :: Monad m => (a -> B.ByteString -> m a) -> m a -> ByteStream m r -> m (Of a r)
foldlChunksM :: forall (m :: * -> *) a r.
Monad m =>
(a -> ByteString -> m a) -> m a -> ByteStream m r -> m (Of a r)
foldlChunksM a -> ByteString -> m a
f m a
z ByteStream m r
bs = m a
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> a -> ByteStream m r -> m (Of a r)
go a
a ByteStream m r
bs
  where
    go :: a -> ByteStream m r -> m (Of a r)
go !a
a ByteStream m r
str = case ByteStream m r
str of
      Empty r
r    -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
a forall a b. a -> b -> Of a b
:> r
r)
      Chunk ByteString
c ByteStream m r
cs -> a -> ByteString -> m a
f a
a ByteString
c forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
aa -> a -> ByteStream m r -> m (Of a r)
go a
aa ByteStream m r
cs
      Go m (ByteStream m r)
m       -> m (ByteStream m r)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ByteStream m r -> m (Of a r)
go a
a
{-# INLINABLE foldlChunksM #-}

-- | Consume the chunks of an effectful ByteString with a natural right monadic fold.
foldrChunksM :: Monad m => (B.ByteString -> m a -> m a) -> m a -> ByteStream m r -> m a
foldrChunksM :: forall (m :: * -> *) a r.
Monad m =>
(ByteString -> m a -> m a) -> m a -> ByteStream m r -> m a
foldrChunksM ByteString -> m a -> m a
step m a
nil ByteStream m r
bs = forall (m :: * -> *) r.
Monad m =>
ByteStream m r
-> forall x. (r -> x) -> (ByteString -> x -> x) -> (m x -> x) -> x
dematerialize ByteStream m r
bs (forall a b. a -> b -> a
const m a
nil) ByteString -> m a -> m a
step forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
{-# INLINE foldrChunksM #-}

-- | Internal utility for @unfoldr@.
unfoldrNE :: Int -> (a -> Either r (Word8, a)) -> a -> (B.ByteString, Either r a)
unfoldrNE :: forall a r.
Int -> (a -> Either r (Word8, a)) -> a -> (ByteString, Either r a)
unfoldrNE Int
i a -> Either r (Word8, a)
f a
x0
    | Int
i forall a. Ord a => a -> a -> Bool
< Int
0     = (ByteString
B.empty, forall a b. b -> Either a b
Right a
x0)
    | Bool
otherwise = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a.
Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
B.createAndTrim' Int
i forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> a -> Int -> IO (Int, Int, Either r a)
go Ptr Word8
p a
x0 Int
0
  where
    go :: Ptr Word8 -> a -> Int -> IO (Int, Int, Either r a)
go !Ptr Word8
p !a
x !Int
n
      | Int
n forall a. Eq a => a -> a -> Bool
== Int
i    = forall (m :: * -> *) a. Monad m => a -> m a
return (Int
0, Int
n, forall a b. b -> Either a b
Right a
x)
      | Bool
otherwise = case a -> Either r (Word8, a)
f a
x of
                      Left r
r     -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int
0, Int
n, forall a b. a -> Either a b
Left r
r)
                      Right (Word8
w,a
x') -> do forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p Word8
w
                                         Ptr Word8 -> a -> Int -> IO (Int, Int, Either r a)
go (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) a
x' (Int
nforall a. Num a => a -> a -> a
+Int
1)
{-# INLINE unfoldrNE #-}

-- | Given some continual monadic action that produces strict `B.ByteString`
-- chunks, produce a stream of bytes.
unfoldMChunks :: Monad m => (s -> m (Maybe (B.ByteString, s))) -> s -> ByteStream m ()
unfoldMChunks :: forall (m :: * -> *) s.
Monad m =>
(s -> m (Maybe (ByteString, s))) -> s -> ByteStream m ()
unfoldMChunks s -> m (Maybe (ByteString, s))
step = s -> ByteStream m ()
loop where
  loop :: s -> ByteStream m ()
loop s
s = forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go forall a b. (a -> b) -> a -> b
$ do
    Maybe (ByteString, s)
m <- s -> m (Maybe (ByteString, s))
step s
s
    case Maybe (ByteString, s)
m of
      Maybe (ByteString, s)
Nothing      -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) r. r -> ByteStream m r
Empty ())
      Just (ByteString
bs,s
s') -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk ByteString
bs (s -> ByteStream m ()
loop s
s')
{-# INLINABLE unfoldMChunks #-}

-- | Like `unfoldMChunks`, but feed through a final @r@ return value.
unfoldrChunks :: Monad m => (s -> m (Either r (B.ByteString, s))) -> s -> ByteStream m r
unfoldrChunks :: forall (m :: * -> *) s r.
Monad m =>
(s -> m (Either r (ByteString, s))) -> s -> ByteStream m r
unfoldrChunks s -> m (Either r (ByteString, s))
step = s -> ByteStream m r
loop where
  loop :: s -> ByteStream m r
loop !s
s = forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go forall a b. (a -> b) -> a -> b
$ do
    Either r (ByteString, s)
m <- s -> m (Either r (ByteString, s))
step s
s
    case Either r (ByteString, s)
m of
      Left r
r        -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) r. r -> ByteStream m r
Empty r
r)
      Right (ByteString
bs,s
s') -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk ByteString
bs (s -> ByteStream m r
loop s
s')
{-# INLINABLE unfoldrChunks #-}

-- | Stream chunks from something that contains @m (Maybe ByteString)@ until it
-- returns 'Nothing'. 'reread' is of particular use rendering @io-streams@ input
-- streams as byte streams in the present sense.
--
-- > import qualified Data.ByteString as B
-- > import qualified System.IO.Streams as S
-- > Q.reread S.read            :: S.InputStream B.ByteString -> Q.ByteStream IO ()
-- > Q.reread (liftIO . S.read) :: MonadIO m => S.InputStream B.ByteString -> Q.ByteStream m ()
--
-- The other direction here is
--
-- > S.unfoldM Q.unconsChunk    :: Q.ByteString IO r -> IO (S.InputStream B.ByteString)
reread :: Monad m => (s -> m (Maybe B.ByteString)) -> s -> ByteStream m ()
reread :: forall (m :: * -> *) s.
Monad m =>
(s -> m (Maybe ByteString)) -> s -> ByteStream m ()
reread s -> m (Maybe ByteString)
step s
s = ByteStream m ()
loop where
  loop :: ByteStream m ()
loop = forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go forall a b. (a -> b) -> a -> b
$ do
    Maybe ByteString
m <- s -> m (Maybe ByteString)
step s
s
    case Maybe ByteString
m of
      Maybe ByteString
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) r. r -> ByteStream m r
Empty ())
      Just ByteString
a  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk ByteString
a ByteStream m ()
loop)
{-# INLINEABLE reread #-}

{-| Make the information in a bytestring available to more than one eliminating fold, e.g.

>>>  Q.count 'l' $ Q.count 'o' $ Q.copy $ "hello\nworld"
3 :> (2 :> ())

>>> Q.length $ Q.count 'l' $ Q.count 'o' $ Q.copy $ Q.copy "hello\nworld"
11 :> (3 :> (2 :> ()))

>>> runResourceT $ Q.writeFile "hello2.txt" $ Q.writeFile "hello1.txt" $ Q.copy $ "hello\nworld\n"
>>> :! cat hello2.txt
hello
world
>>> :! cat hello1.txt
hello
world

    This sort of manipulation could as well be acheived by combining folds - using
    @Control.Foldl@ for example. But any sort of manipulation can be involved in
    the fold.  Here are a couple of trivial complications involving splitting by lines:

>>> let doubleLines = Q.unlines . maps (<* Q.chunk "\n" ) . Q.lines
>>> let emphasize = Q.unlines . maps (<* Q.chunk "!" ) . Q.lines
>>> runResourceT $ Q.writeFile "hello2.txt" $ emphasize $ Q.writeFile "hello1.txt" $ doubleLines $ Q.copy $ "hello\nworld"
>>> :! cat hello2.txt
hello!
world!
>>> :! cat hello1.txt
hello
<BLANKLINE>
world
<BLANKLINE>

    As with the parallel operations in @Streaming.Prelude@, we have

> Q.effects . Q.copy       = id
> hoist Q.effects . Q.copy = id

   The duplication does not by itself involve the copying of bytestring chunks;
   it just makes two references to each chunk as it arises. This does, however
   double the number of constructors associated with each chunk.

-}
copy :: Monad m => ByteStream m r -> ByteStream (ByteStream m) r
copy :: forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> ByteStream (ByteStream m) r
copy = forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> ByteStream (ByteStream m) r
loop where
  loop :: ByteStream m r -> ByteStream (ByteStream m) r
loop ByteStream m r
str = case ByteStream m r
str of
    Empty r
r       -> forall (m :: * -> *) r. r -> ByteStream m r
Empty r
r
    Go m (ByteStream m r)
m          -> forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteStream m r -> ByteStream (ByteStream m) r
loop (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (ByteStream m r)
m))
    Chunk ByteString
bs ByteStream m r
rest -> forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk ByteString
bs (forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go (forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk ByteString
bs (forall (m :: * -> *) r. r -> ByteStream m r
Empty (ByteStream m r -> ByteStream (ByteStream m) r
loop ByteStream m r
rest))))
{-# INLINABLE copy #-}

-- | 'findIndexOrEnd' is a variant of findIndex, that returns the length of the
-- string if no element is found, rather than Nothing.
findIndexOrEnd :: (Word8 -> Bool) -> B.ByteString -> Int
findIndexOrEnd :: (Word8 -> Bool) -> ByteString -> Int
findIndexOrEnd Word8 -> Bool
k (B.PS ForeignPtr Word8
x Int
s Int
l) =
    forall a. IO a -> a
B.accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$
      forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x forall a b. (a -> b) -> a -> b
$ \Ptr Word8
f -> Ptr Word8 -> Int -> IO Int
go (Ptr Word8
f forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) Int
0
  where
    go :: Ptr Word8 -> Int -> IO Int
go !Ptr Word8
ptr !Int
n | Int
n forall a. Ord a => a -> a -> Bool
>= Int
l    = forall (m :: * -> *) a. Monad m => a -> m a
return Int
l
               | Bool
otherwise = do Word8
w <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr
                                if Word8 -> Bool
k Word8
w
                                  then forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
                                  else Ptr Word8 -> Int -> IO Int
go (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Int
nforall a. Num a => a -> a -> a
+Int
1)
{-# INLINABLE findIndexOrEnd #-}