{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Streamly.External.Archive
  ( -- ** Read
    readArchive,

    -- *** Read options
    ReadOptions,
    mapHeaderMaybe,

    -- ** Utility functions

    -- | Various utility functions that some might find useful.
    groupByLeft,
    eitherByLeft,
    chunkOn,
    chunkOnFold,

    -- ** Header
    Header,
    FileType (..),
    headerFileType,
    headerPathName,
    headerPathNameUtf8,
    headerSize,
  )
where

import Control.Exception
import Control.Monad.IO.Class
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Either
import Data.Foldable
import Data.Function
import qualified Data.Sequence as Seq
import Foreign
import Foreign.C.Types
import Streamly.Data.Fold (Fold)
import qualified Streamly.Data.Parser as P
import Streamly.Data.Stream.Prelude (Stream)
import qualified Streamly.Data.Stream.Prelude as S
import Streamly.Data.Unfold
import Streamly.External.Archive.Internal.Foreign
import qualified Streamly.Internal.Data.Fold as F
import Streamly.Internal.Data.IOFinalizer
import qualified Streamly.Internal.Data.Stream as S
import qualified Streamly.Internal.Data.Unfold as U

-- | Header information for an entry in the archive.
newtype Header = Header Entry

{-# INLINE headerFileType #-}
headerFileType :: Header -> IO (Maybe FileType)
headerFileType :: Header -> IO (Maybe FileType)
headerFileType (Header Entry
e) = Entry -> IO (Maybe FileType)
archive_entry_filetype Entry
e

{-# INLINE headerPathName #-}
headerPathName :: Header -> IO (Maybe ByteString)
headerPathName :: Header -> IO (Maybe ByteString)
headerPathName (Header Entry
e) = Entry -> IO (Maybe ByteString)
archive_entry_pathname Entry
e

{-# INLINE headerPathNameUtf8 #-}
headerPathNameUtf8 :: Header -> IO (Maybe ByteString)
headerPathNameUtf8 :: Header -> IO (Maybe ByteString)
headerPathNameUtf8 (Header Entry
e) = Entry -> IO (Maybe ByteString)
archive_entry_pathname_utf8 Entry
e

-- | Returns the file size of the entry, if it has been set; returns 'Nothing' otherwise.
{-# INLINE headerSize #-}
headerSize :: Header -> IO (Maybe Int)
headerSize :: Header -> IO (Maybe Int)
headerSize (Header Entry
e) = Entry -> IO (Maybe Int)
archive_entry_size Entry
e

-- | Creates an unfold with which we can stream data out of the given archive.
--
-- By default (with 'id' as the read options modifier), we get for each entry in the archive a
-- 'Header' followed by zero or more @ByteString@s containing chunks of file data.
--
-- To modify the read options, one can use function composition.
{-# INLINE readArchive #-}
readArchive ::
  (MonadIO m) =>
  Unfold m (ReadOptions m Header -> ReadOptions m a, FilePath) (Either a ByteString)
readArchive :: forall (m :: * -> *) a.
MonadIO m =>
Unfold
  m
  (ReadOptions m Header -> ReadOptions m a, FilePath)
  (Either a ByteString)
readArchive =
  ((ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
  Int64, IOFinalizer, Bool)
 -> m (Step
         (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
          Int64, IOFinalizer, Bool)
         (Either a ByteString)))
-> ((ReadOptions m Header -> ReadOptions m a, FilePath)
    -> m (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize,
          Ptr Int64, Int64, IOFinalizer, Bool))
-> Unfold
     m
     (ReadOptions m Header -> ReadOptions m a, FilePath)
     (Either a ByteString)
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
U.Unfold
    ( \(ReadOptions m a
ropts, Archive
arch, Ptr (Ptr CChar)
buf, Ptr CSize
sz, Ptr Int64
offs, Int64
pos, IOFinalizer
ref, Bool
readHeader) ->
        if Bool
readHeader
          then do
            Maybe Entry
me <- IO (Maybe Entry) -> m (Maybe Entry)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Entry) -> m (Maybe Entry))
-> IO (Maybe Entry) -> m (Maybe Entry)
forall a b. (a -> b) -> a -> b
$ Archive -> IO (Maybe Entry)
archive_read_next_header Archive
arch
            case Maybe Entry
me of
              Maybe Entry
Nothing -> do
                IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IOFinalizer -> IO ()
forall (m :: * -> *). MonadIO m => IOFinalizer -> m ()
runIOFinalizer IOFinalizer
ref
                Step
  (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
   Int64, IOFinalizer, Bool)
  (Either a ByteString)
-> m (Step
        (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
         Int64, IOFinalizer, Bool)
        (Either a ByteString))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
   Int64, IOFinalizer, Bool)
  (Either a ByteString)
forall s a. Step s a
U.Stop
              Just Entry
e -> do
                let hdr :: Header
hdr = Entry -> Header
Header Entry
e
                Maybe a
m <- ReadOptions m a -> Header -> m (Maybe a)
forall (m :: * -> *) a. ReadOptions m a -> Header -> m (Maybe a)
_mapHeaderMaybe ReadOptions m a
ropts Header
hdr
                Step
  (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
   Int64, IOFinalizer, Bool)
  (Either a ByteString)
-> m (Step
        (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
         Int64, IOFinalizer, Bool)
        (Either a ByteString))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
    Int64, IOFinalizer, Bool)
   (Either a ByteString)
 -> m (Step
         (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
          Int64, IOFinalizer, Bool)
         (Either a ByteString)))
-> Step
     (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
      Int64, IOFinalizer, Bool)
     (Either a ByteString)
-> m (Step
        (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
         Int64, IOFinalizer, Bool)
        (Either a ByteString))
forall a b. (a -> b) -> a -> b
$ case Maybe a
m of
                  Maybe a
Nothing -> (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
 Int64, IOFinalizer, Bool)
-> Step
     (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
      Int64, IOFinalizer, Bool)
     (Either a ByteString)
forall s a. s -> Step s a
U.Skip (ReadOptions m a
ropts, Archive
arch, Ptr (Ptr CChar)
buf, Ptr CSize
sz, Ptr Int64
offs, Int64
0, IOFinalizer
ref, Bool
True)
                  Just a
a -> Either a ByteString
-> (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize,
    Ptr Int64, Int64, IOFinalizer, Bool)
-> Step
     (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
      Int64, IOFinalizer, Bool)
     (Either a ByteString)
forall s a. a -> s -> Step s a
U.Yield (a -> Either a ByteString
forall a b. a -> Either a b
Left a
a) (ReadOptions m a
ropts, Archive
arch, Ptr (Ptr CChar)
buf, Ptr CSize
sz, Ptr Int64
offs, Int64
0, IOFinalizer
ref, Bool
False)
          else do
            (ByteString
bs, Bool
done) <- IO (ByteString, Bool) -> m (ByteString, Bool)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ByteString, Bool) -> m (ByteString, Bool))
-> IO (ByteString, Bool) -> m (ByteString, Bool)
forall a b. (a -> b) -> a -> b
$ Archive
-> Ptr (Ptr CChar)
-> Ptr CSize
-> Ptr Int64
-> Int64
-> IO (ByteString, Bool)
archive_read_data_block Archive
arch Ptr (Ptr CChar)
buf Ptr CSize
sz Ptr Int64
offs Int64
pos
            Step
  (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
   Int64, IOFinalizer, Bool)
  (Either a ByteString)
-> m (Step
        (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
         Int64, IOFinalizer, Bool)
        (Either a ByteString))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
    Int64, IOFinalizer, Bool)
   (Either a ByteString)
 -> m (Step
         (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
          Int64, IOFinalizer, Bool)
         (Either a ByteString)))
-> Step
     (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
      Int64, IOFinalizer, Bool)
     (Either a ByteString)
-> m (Step
        (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
         Int64, IOFinalizer, Bool)
        (Either a ByteString))
forall a b. (a -> b) -> a -> b
$
              if ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                then
                  Either a ByteString
-> (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize,
    Ptr Int64, Int64, IOFinalizer, Bool)
-> Step
     (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
      Int64, IOFinalizer, Bool)
     (Either a ByteString)
forall s a. a -> s -> Step s a
U.Yield
                    (ByteString -> Either a ByteString
forall a b. b -> Either a b
Right ByteString
bs)
                    (ReadOptions m a
ropts, Archive
arch, Ptr (Ptr CChar)
buf, Ptr CSize
sz, Ptr Int64
offs, Int64
pos Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bs), IOFinalizer
ref, Bool
done)
                else (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
 Int64, IOFinalizer, Bool)
-> Step
     (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
      Int64, IOFinalizer, Bool)
     (Either a ByteString)
forall s a. s -> Step s a
U.Skip (ReadOptions m a
ropts, Archive
arch, Ptr (Ptr CChar)
buf, Ptr CSize
sz, Ptr Int64
offs, Int64
pos, IOFinalizer
ref, Bool
done)
    )
    ( \(ReadOptions m Header -> ReadOptions m a
modifier, FilePath
fp) -> do
        (Archive
arch, Ptr (Ptr CChar)
buf, Ptr CSize
sz, Ptr Int64
offs, IOFinalizer
ref) <- IO (Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64, IOFinalizer)
-> m (Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64, IOFinalizer)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64, IOFinalizer)
 -> m (Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64, IOFinalizer))
-> (IO
      (Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64, IOFinalizer)
    -> IO
         (Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64, IOFinalizer))
-> IO (Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64, IOFinalizer)
-> m (Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64, IOFinalizer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64, IOFinalizer)
-> IO (Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64, IOFinalizer)
forall a. IO a -> IO a
mask_ (IO (Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64, IOFinalizer)
 -> m (Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64, IOFinalizer))
-> IO (Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64, IOFinalizer)
-> m (Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64, IOFinalizer)
forall a b. (a -> b) -> a -> b
$ do
          Archive
arch <- IO Archive -> IO Archive
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Archive
archive_read_new
          Ptr (Ptr CChar)
buf :: Ptr (Ptr CChar) <- IO (Ptr (Ptr CChar)) -> IO (Ptr (Ptr CChar))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Ptr (Ptr CChar))
forall a. Storable a => IO (Ptr a)
malloc
          Ptr CSize
sz :: Ptr CSize <- IO (Ptr CSize) -> IO (Ptr CSize)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Ptr CSize)
forall a. Storable a => IO (Ptr a)
malloc
          Ptr Int64
offs :: Ptr Int64 <- IO (Ptr Int64) -> IO (Ptr Int64)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
malloc
          IOFinalizer
ref <- IO () -> IO IOFinalizer
forall (m :: * -> *) a. MonadIO m => IO a -> m IOFinalizer
newIOFinalizer (IO () -> IO IOFinalizer) -> IO () -> IO IOFinalizer
forall a b. (a -> b) -> a -> b
$ Archive -> IO ()
archive_read_free Archive
arch IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
free Ptr (Ptr CChar)
buf IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr CSize -> IO ()
forall a. Ptr a -> IO ()
free Ptr CSize
sz IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
free Ptr Int64
offs
          (Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64, IOFinalizer)
-> IO (Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64, IOFinalizer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Archive
arch, Ptr (Ptr CChar)
buf, Ptr CSize
sz, Ptr Int64
offs, IOFinalizer
ref)
        IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Archive -> IO ()
archive_read_support_filter_all Archive
arch
        IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Archive -> IO ()
archive_read_support_format_all Archive
arch
        IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Archive -> FilePath -> IO ()
archive_read_open_filename Archive
arch FilePath
fp

        -- + We ended up with functions instead of records to avoid an error about an ambiguous
        --   monad type for defaultReadOptions when the user sets the headerFilter record.
        -- + (A dummy Proxy record worked too, but partially exporting records breaks Haddock.)
        let ropts :: ReadOptions m a
ropts = ReadOptions m Header -> ReadOptions m a
modifier ReadOptions m Header
forall (m :: * -> *). Monad m => ReadOptions m Header
_defaultReadOptions

        (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize, Ptr Int64,
 Int64, IOFinalizer, Bool)
-> m (ReadOptions m a, Archive, Ptr (Ptr CChar), Ptr CSize,
      Ptr Int64, Int64, IOFinalizer, Bool)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ReadOptions m a
ropts, Archive
arch, Ptr (Ptr CChar)
buf, Ptr CSize
sz, Ptr Int64
offs, Int64
0, IOFinalizer
ref, Bool
True)
    )

newtype ReadOptions m a = ReadOptions
  { forall (m :: * -> *) a. ReadOptions m a -> Header -> m (Maybe a)
_mapHeaderMaybe :: Header -> m (Maybe a)
  }

_defaultReadOptions :: (Monad m) => ReadOptions m Header
_defaultReadOptions :: forall (m :: * -> *). Monad m => ReadOptions m Header
_defaultReadOptions =
  ReadOptions
    { _mapHeaderMaybe :: Header -> m (Maybe Header)
_mapHeaderMaybe = Maybe Header -> m (Maybe Header)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Header -> m (Maybe Header))
-> (Header -> Maybe Header) -> Header -> m (Maybe Header)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header -> Maybe Header
forall a. a -> Maybe a
Just
    }

-- | If this returns @Just@ for a header, that header (mapped to a different value if desired) and
-- any following @ByteString@ chunks are included in the 'readArchive' unfold. If this returns
-- @Nothing@ for a header, that header and any following @ByteString@ chunks are excluded from the
-- 'readArchive' unfold.
--
-- By default, all entries are included with unaltered headers.
mapHeaderMaybe :: (Header -> m (Maybe a)) -> ReadOptions m Header -> ReadOptions m a
mapHeaderMaybe :: forall (m :: * -> *) a.
(Header -> m (Maybe a)) -> ReadOptions m Header -> ReadOptions m a
mapHeaderMaybe Header -> m (Maybe a)
x ReadOptions m Header
o = ReadOptions m Header
o {_mapHeaderMaybe = x}

-- | Groups a stream of @Either@s by the @Left@s. The provided @Fold@ processes a single @Left@
-- followed by any subsequent (zero or more) @Right@s.
{-# INLINE groupByLeft #-}
groupByLeft ::
  (Monad m) =>
  Fold m (Either a b) c ->
  Stream m (Either a b) ->
  Stream m c
groupByLeft :: forall (m :: * -> *) a b c.
Monad m =>
Fold m (Either a b) c -> Stream m (Either a b) -> Stream m c
groupByLeft Fold m (Either a b) c
itemFold Stream m (Either a b)
str =
  Stream m (Either a b)
str
    Stream m (Either a b)
-> (Stream m (Either a b) -> Stream m (Either ParseError c))
-> Stream m (Either ParseError c)
forall a b. a -> (a -> b) -> b
& Parser (Either a b) m c
-> Stream m (Either a b) -> Stream m (Either ParseError c)
forall (m :: * -> *) a b.
Monad m =>
Parser a m b -> Stream m a -> Stream m (Either ParseError b)
S.parseMany ((Either a b -> Either a b -> Bool)
-> Fold m (Either a b) c -> Parser (Either a b) m c
forall (m :: * -> *) a b.
Monad m =>
(a -> a -> Bool) -> Fold m a b -> Parser a m b
P.groupBy (\Either a b
_ Either a b
e -> Either a b -> Bool
forall a b. Either a b -> Bool
isRight Either a b
e) Fold m (Either a b) c
itemFold)
    Stream m (Either ParseError c)
-> (Stream m (Either ParseError c) -> Stream m c) -> Stream m c
forall a b. a -> (a -> b) -> b
& (Either ParseError c -> c)
-> Stream m (Either ParseError c) -> Stream m c
forall a b. (a -> b) -> Stream m a -> Stream m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      ( \case
          Left ParseError
_ ->
            -- groupBy is documented to never fail.
            FilePath -> c
forall a. HasCallStack => FilePath -> a
error FilePath
"unexpected parseMany/groupBy error"
          Right c
c -> c
c
      )

-- | Associates each @Right@ in a stream with the latest @Left@ that came before it.
--
-- >>> l = [Right 10, Left "a", Right 1, Right 2, Left "b", Left "c", Right 20]
-- >>> S.fold F.toList . eitherByLeft . S.fromList $ l
-- [("a",1),("a",2),("c",20)]
eitherByLeft :: (Monad m) => Stream m (Either a b) -> Stream m (a, b)
eitherByLeft :: forall (m :: * -> *) a b.
Monad m =>
Stream m (Either a b) -> Stream m (a, b)
eitherByLeft Stream m (Either a b)
s =
  ((Maybe a, Maybe b) -> Either a b -> (Maybe a, Maybe b))
-> (Maybe a, Maybe b)
-> Stream m (Either a b)
-> Stream m (Maybe a, Maybe b)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Stream m a -> Stream m b
S.scanl'
    ( \(Maybe a
curra, Maybe b
_) Either a b
e ->
        case Either a b
e of
          Left a
newa -> (a -> Maybe a
forall a. a -> Maybe a
Just a
newa, Maybe b
forall a. Maybe a
Nothing)
          Right b
newb -> (Maybe a
curra, b -> Maybe b
forall a. a -> Maybe a
Just b
newb)
    )
    (Maybe a
forall a. Maybe a
Nothing, Maybe b
forall a. Maybe a
Nothing)
    Stream m (Either a b)
s
    Stream m (Maybe a, Maybe b)
-> (Stream m (Maybe a, Maybe b) -> Stream m (a, b))
-> Stream m (a, b)
forall a b. a -> (a -> b) -> b
& ((Maybe a, Maybe b) -> Maybe (a, b))
-> Stream m (Maybe a, Maybe b) -> Stream m (a, b)
forall (m :: * -> *) a b.
Monad m =>
(a -> Maybe b) -> Stream m a -> Stream m b
S.mapMaybe
      ( \(Maybe a
ma, Maybe b
mb) -> case (Maybe a
ma, Maybe b
mb) of
          (Just a
a, Just b
b) -> (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
a, b
b)
          (Maybe a, Maybe b)
_ -> Maybe (a, b)
forall a. Maybe a
Nothing
      )

-- | The state of the chunkOn stream.
data ChunkOnState_ is h
  = -- | The initial state; or a header is done being yielded.
    COInitOrYieldHeader_
  | -- | A bytestring not containing splitWd is being built up.
    COResidue_ !ByteString
  | -- | Chunks are being processed.
    COProcessChunks_ ![ByteString] !ByteString
  | -- | A stop has been asked for.
    COStop_
  | -- | A header yield has been asked for.
    COYieldHeader_ !h !is

-- | Chunks up the bytestrings following each @Left@ by the given word, discarding the given word.
-- (For instance, the word could be @10@ (newline), which gives us lines as the chunks.) The
-- bytestrings in the resulting stream are the desired chunks.
{-# INLINE chunkOn #-}
chunkOn ::
  (Monad m) =>
  Word8 ->
  Stream m (Either a ByteString) ->
  Stream m (Either a ByteString)
chunkOn :: forall (m :: * -> *) a.
Monad m =>
Word8
-> Stream m (Either a ByteString) -> Stream m (Either a ByteString)
chunkOn Word8
splitWd (S.Stream State StreamK m (Either a ByteString)
-> s -> m (Step s (Either a ByteString))
istep s
isinit) =
  -- "i": input.
  (State StreamK m (Either a ByteString)
 -> (s, ChunkOnState_ s a)
 -> m (Step (s, ChunkOnState_ s a) (Either a ByteString)))
-> (s, ChunkOnState_ s a) -> Stream m (Either a ByteString)
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
S.Stream State StreamK m (Either a ByteString)
-> (s, ChunkOnState_ s a)
-> m (Step (s, ChunkOnState_ s a) (Either a ByteString))
step' (s
isinit, ChunkOnState_ s a
forall is h. ChunkOnState_ is h
COInitOrYieldHeader_)
  where
    -- A utility function to obtain (chunks, next residue) from the previous residue and the latest
    -- incoming bytestring.
    {-# INLINE toChunks #-}
    toChunks :: ByteString -> ByteString -> (Seq ByteString, ByteString)
toChunks ByteString
residue ByteString
newbs =
      -- Non-empty newbs expected.
      let tentativeChunks :: Seq ByteString
tentativeChunks = [ByteString] -> Seq ByteString
forall a. [a] -> Seq a
Seq.fromList ([ByteString] -> Seq ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> Seq ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> [ByteString]
B.split Word8
splitWd (ByteString -> Seq ByteString) -> ByteString -> Seq ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
residue ByteString -> ByteString -> ByteString
`B.append` ByteString
newbs
       in case Seq ByteString
tentativeChunks of
            Seq ByteString
Seq.Empty -> (Seq ByteString
forall a. Seq a
Seq.empty, ByteString
"")
            Seq ByteString
init' Seq.:|> ByteString
last' ->
              -- Note: This logic works also when newbs ends with splitWd because then the last
              -- chunk is the empty bytestring.
              (Seq ByteString
init', ByteString
last')

    -- Processes chunks obtained with toChunks.
    {-# INLINE processChunks #-}
    processChunks :: a
-> [ByteString]
-> ByteString
-> m (Step (a, ChunkOnState_ is h) (Either a ByteString))
processChunks a
is [] ByteString
residue =
      Step (a, ChunkOnState_ is h) (Either a ByteString)
-> m (Step (a, ChunkOnState_ is h) (Either a ByteString))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (a, ChunkOnState_ is h) (Either a ByteString)
 -> m (Step (a, ChunkOnState_ is h) (Either a ByteString)))
-> Step (a, ChunkOnState_ is h) (Either a ByteString)
-> m (Step (a, ChunkOnState_ is h) (Either a ByteString))
forall a b. (a -> b) -> a -> b
$ (a, ChunkOnState_ is h)
-> Step (a, ChunkOnState_ is h) (Either a ByteString)
forall s a. s -> Step s a
S.Skip (a
is, ByteString -> ChunkOnState_ is h
forall is h. ByteString -> ChunkOnState_ is h
COResidue_ ByteString
residue)
    processChunks a
is (ByteString
chunk : [ByteString]
chunks) ByteString
residue =
      Step (a, ChunkOnState_ is h) (Either a ByteString)
-> m (Step (a, ChunkOnState_ is h) (Either a ByteString))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (a, ChunkOnState_ is h) (Either a ByteString)
 -> m (Step (a, ChunkOnState_ is h) (Either a ByteString)))
-> Step (a, ChunkOnState_ is h) (Either a ByteString)
-> m (Step (a, ChunkOnState_ is h) (Either a ByteString))
forall a b. (a -> b) -> a -> b
$ Either a ByteString
-> (a, ChunkOnState_ is h)
-> Step (a, ChunkOnState_ is h) (Either a ByteString)
forall s a. a -> s -> Step s a
S.Yield (ByteString -> Either a ByteString
forall a b. b -> Either a b
Right ByteString
chunk) (a
is, [ByteString] -> ByteString -> ChunkOnState_ is h
forall is h. [ByteString] -> ByteString -> ChunkOnState_ is h
COProcessChunks_ [ByteString]
chunks ByteString
residue)

    {-# INLINE step' #-}
    -- "is": state of the input stream.
    -- "gst": "global" state? (Inspired by '_compactOnByteCustom' in streamly-0.10.1.)
    step' :: State StreamK m (Either a ByteString)
-> (s, ChunkOnState_ s a)
-> m (Step (s, ChunkOnState_ s a) (Either a ByteString))
step' State StreamK m (Either a ByteString)
gst (s
is, ChunkOnState_ s a
s) = case ChunkOnState_ s a
s of
      ChunkOnState_ s a
COInitOrYieldHeader_ -> do
        Step s (Either a ByteString)
istep' <- State StreamK m (Either a ByteString)
-> s -> m (Step s (Either a ByteString))
istep State StreamK m (Either a ByteString)
gst s
is
        case Step s (Either a ByteString)
istep' of
          Step s (Either a ByteString)
S.Stop -> Step (s, ChunkOnState_ s a) (Either a ByteString)
-> m (Step (s, ChunkOnState_ s a) (Either a ByteString))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (s, ChunkOnState_ s a) (Either a ByteString)
forall s a. Step s a
S.Stop
          S.Skip s
is' -> Step (s, ChunkOnState_ s a) (Either a ByteString)
-> m (Step (s, ChunkOnState_ s a) (Either a ByteString))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, ChunkOnState_ s a) (Either a ByteString)
 -> m (Step (s, ChunkOnState_ s a) (Either a ByteString)))
-> Step (s, ChunkOnState_ s a) (Either a ByteString)
-> m (Step (s, ChunkOnState_ s a) (Either a ByteString))
forall a b. (a -> b) -> a -> b
$ (s, ChunkOnState_ s a)
-> Step (s, ChunkOnState_ s a) (Either a ByteString)
forall s a. s -> Step s a
S.Skip (s
is', ChunkOnState_ s a
forall is h. ChunkOnState_ is h
COInitOrYieldHeader_)
          S.Yield Either a ByteString
e s
is' -> case Either a ByteString
e of
            Left a
hdr -> Step (s, ChunkOnState_ s a) (Either a ByteString)
-> m (Step (s, ChunkOnState_ s a) (Either a ByteString))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, ChunkOnState_ s a) (Either a ByteString)
 -> m (Step (s, ChunkOnState_ s a) (Either a ByteString)))
-> Step (s, ChunkOnState_ s a) (Either a ByteString)
-> m (Step (s, ChunkOnState_ s a) (Either a ByteString))
forall a b. (a -> b) -> a -> b
$ Either a ByteString
-> (s, ChunkOnState_ s a)
-> Step (s, ChunkOnState_ s a) (Either a ByteString)
forall s a. a -> s -> Step s a
S.Yield (a -> Either a ByteString
forall a b. a -> Either a b
Left a
hdr) (s
is', ChunkOnState_ s a
forall is h. ChunkOnState_ is h
COInitOrYieldHeader_)
            Right ByteString
newbs -> do
              -- Note: In the initial case (and not just the yield header case), this is possible.
              -- Although a bytestring appearing initially without any preceding header is not what
              -- we have in mind for streamly-archive, we want this function to focus only on the
              -- bytestring splitting.
              let (Seq ByteString
chunks, ByteString
residue') = ByteString -> ByteString -> (Seq ByteString, ByteString)
toChunks ByteString
"" ByteString
newbs
              Step (s, ChunkOnState_ s a) (Either a ByteString)
-> m (Step (s, ChunkOnState_ s a) (Either a ByteString))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, ChunkOnState_ s a) (Either a ByteString)
 -> m (Step (s, ChunkOnState_ s a) (Either a ByteString)))
-> Step (s, ChunkOnState_ s a) (Either a ByteString)
-> m (Step (s, ChunkOnState_ s a) (Either a ByteString))
forall a b. (a -> b) -> a -> b
$ (s, ChunkOnState_ s a)
-> Step (s, ChunkOnState_ s a) (Either a ByteString)
forall s a. s -> Step s a
S.Skip (s
is', [ByteString] -> ByteString -> ChunkOnState_ s a
forall is h. [ByteString] -> ByteString -> ChunkOnState_ is h
COProcessChunks_ (Seq ByteString -> [ByteString]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq ByteString
chunks) ByteString
residue')
      COResidue_ !ByteString
residue -> do
        Step s (Either a ByteString)
istep' <- State StreamK m (Either a ByteString)
-> s -> m (Step s (Either a ByteString))
istep State StreamK m (Either a ByteString)
gst s
is
        case Step s (Either a ByteString)
istep' of
          Step s (Either a ByteString)
S.Stop -> Step (s, ChunkOnState_ s a) (Either a ByteString)
-> m (Step (s, ChunkOnState_ s a) (Either a ByteString))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, ChunkOnState_ s a) (Either a ByteString)
 -> m (Step (s, ChunkOnState_ s a) (Either a ByteString)))
-> Step (s, ChunkOnState_ s a) (Either a ByteString)
-> m (Step (s, ChunkOnState_ s a) (Either a ByteString))
forall a b. (a -> b) -> a -> b
$ Either a ByteString
-> (s, ChunkOnState_ s a)
-> Step (s, ChunkOnState_ s a) (Either a ByteString)
forall s a. a -> s -> Step s a
S.Yield (ByteString -> Either a ByteString
forall a b. b -> Either a b
Right ByteString
residue) (s
is, ChunkOnState_ s a
forall is h. ChunkOnState_ is h
COStop_)
          S.Skip s
is' -> Step (s, ChunkOnState_ s a) (Either a ByteString)
-> m (Step (s, ChunkOnState_ s a) (Either a ByteString))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, ChunkOnState_ s a) (Either a ByteString)
 -> m (Step (s, ChunkOnState_ s a) (Either a ByteString)))
-> Step (s, ChunkOnState_ s a) (Either a ByteString)
-> m (Step (s, ChunkOnState_ s a) (Either a ByteString))
forall a b. (a -> b) -> a -> b
$ (s, ChunkOnState_ s a)
-> Step (s, ChunkOnState_ s a) (Either a ByteString)
forall s a. s -> Step s a
S.Skip (s
is', ByteString -> ChunkOnState_ s a
forall is h. ByteString -> ChunkOnState_ is h
COResidue_ ByteString
residue)
          S.Yield Either a ByteString
e s
is' -> case Either a ByteString
e of
            Left a
hdr -> Step (s, ChunkOnState_ s a) (Either a ByteString)
-> m (Step (s, ChunkOnState_ s a) (Either a ByteString))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, ChunkOnState_ s a) (Either a ByteString)
 -> m (Step (s, ChunkOnState_ s a) (Either a ByteString)))
-> Step (s, ChunkOnState_ s a) (Either a ByteString)
-> m (Step (s, ChunkOnState_ s a) (Either a ByteString))
forall a b. (a -> b) -> a -> b
$ Either a ByteString
-> (s, ChunkOnState_ s a)
-> Step (s, ChunkOnState_ s a) (Either a ByteString)
forall s a. a -> s -> Step s a
S.Yield (ByteString -> Either a ByteString
forall a b. b -> Either a b
Right ByteString
residue) (s
is', a -> s -> ChunkOnState_ s a
forall is h. h -> is -> ChunkOnState_ is h
COYieldHeader_ a
hdr s
is')
            Right ByteString
newbs -> do
              let (Seq ByteString
chunks, ByteString
residue') = ByteString -> ByteString -> (Seq ByteString, ByteString)
toChunks ByteString
residue ByteString
newbs
              Step (s, ChunkOnState_ s a) (Either a ByteString)
-> m (Step (s, ChunkOnState_ s a) (Either a ByteString))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, ChunkOnState_ s a) (Either a ByteString)
 -> m (Step (s, ChunkOnState_ s a) (Either a ByteString)))
-> Step (s, ChunkOnState_ s a) (Either a ByteString)
-> m (Step (s, ChunkOnState_ s a) (Either a ByteString))
forall a b. (a -> b) -> a -> b
$ (s, ChunkOnState_ s a)
-> Step (s, ChunkOnState_ s a) (Either a ByteString)
forall s a. s -> Step s a
S.Skip (s
is', [ByteString] -> ByteString -> ChunkOnState_ s a
forall is h. [ByteString] -> ByteString -> ChunkOnState_ is h
COProcessChunks_ (Seq ByteString -> [ByteString]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq ByteString
chunks) ByteString
residue')
      ChunkOnState_ s a
COStop_ -> Step (s, ChunkOnState_ s a) (Either a ByteString)
-> m (Step (s, ChunkOnState_ s a) (Either a ByteString))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (s, ChunkOnState_ s a) (Either a ByteString)
forall s a. Step s a
S.Stop
      COYieldHeader_ !a
hdr !s
is' -> Step (s, ChunkOnState_ s a) (Either a ByteString)
-> m (Step (s, ChunkOnState_ s a) (Either a ByteString))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, ChunkOnState_ s a) (Either a ByteString)
 -> m (Step (s, ChunkOnState_ s a) (Either a ByteString)))
-> Step (s, ChunkOnState_ s a) (Either a ByteString)
-> m (Step (s, ChunkOnState_ s a) (Either a ByteString))
forall a b. (a -> b) -> a -> b
$ Either a ByteString
-> (s, ChunkOnState_ s a)
-> Step (s, ChunkOnState_ s a) (Either a ByteString)
forall s a. a -> s -> Step s a
S.Yield (a -> Either a ByteString
forall a b. a -> Either a b
Left a
hdr) (s
is', ChunkOnState_ s a
forall is h. ChunkOnState_ is h
COInitOrYieldHeader_)
      COProcessChunks_ ![ByteString]
chunks !ByteString
residue ->
        s
-> [ByteString]
-> ByteString
-> m (Step (s, ChunkOnState_ s a) (Either a ByteString))
forall {m :: * -> *} {a} {is} {h} {a}.
Monad m =>
a
-> [ByteString]
-> ByteString
-> m (Step (a, ChunkOnState_ is h) (Either a ByteString))
processChunks s
is [ByteString]
chunks ByteString
residue

-- | The state of the outer 'chunkOnFold' fold.
data ChunkOnFoldState_
  = -- | The initialization of the fold is complete. This state occurs only once (in the beginning).
    Init_
  | -- | The processing of a header is complete.
    Header_
  | -- | The processing of chunks is complete, and a residue (possibly empty) has been made
    -- available.
    Chunks_ !ByteString

-- | Chunks up the bytestrings following each @Left@ by the given word, discarding the given word.
-- (For instance, the word could be @10@ (newline), which gives us lines as the chunks.) The
-- bytestrings in the provided fold are the desired chunks.
{-# INLINE chunkOnFold #-}
chunkOnFold ::
  (Monad m) =>
  Word8 ->
  Fold m (Either a ByteString) b ->
  Fold m (Either a ByteString) b
chunkOnFold :: forall (m :: * -> *) a b.
Monad m =>
Word8
-> Fold m (Either a ByteString) b -> Fold m (Either a ByteString) b
chunkOnFold Word8
splitWd (F.Fold s -> Either a ByteString -> m (Step s b)
chstep m (Step s b)
chinit s -> m b
chextr s -> m b
chfinal) =
  -- "ch": chunk.
  let -- A utility function to consume all the chunks available in the same iteration.
      {-# INLINE go #-}
      go :: s -> [ByteString] -> m (Step s b)
go s
chs [] = Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ s -> Step s b
forall s b. s -> Step s b
F.Partial s
chs -- "chs": state of the chunk fold.
      go s
chs (ByteString
chbs : [ByteString]
chbss) = do
        Step s b
chstep' <- s -> Either a ByteString -> m (Step s b)
chstep s
chs (ByteString -> Either a ByteString
forall a b. b -> Either a b
Right ByteString
chbs)
        case Step s b
chstep' of
          F.Done b
a -> Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ b -> Step s b
forall s b. b -> Step s b
F.Done b
a
          F.Partial s
chs' -> s -> [ByteString] -> m (Step s b)
go s
chs' [ByteString]
chbss
      -- A utility function to obtain (chunks, next residue) from the previous residue and the
      -- latest incoming bytestring.
      {-# INLINE toChunks #-}
      toChunks :: ByteString -> ByteString -> (Seq ByteString, ByteString)
toChunks ByteString
residue ByteString
newbs =
        -- Non-empty newbs expected.
        let tentativeChunks :: Seq ByteString
tentativeChunks = [ByteString] -> Seq ByteString
forall a. [a] -> Seq a
Seq.fromList ([ByteString] -> Seq ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> Seq ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> [ByteString]
B.split Word8
splitWd (ByteString -> Seq ByteString) -> ByteString -> Seq ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
residue ByteString -> ByteString -> ByteString
`B.append` ByteString
newbs
         in case Seq ByteString
tentativeChunks of
              Seq ByteString
Seq.Empty -> (Seq ByteString
forall a. Seq a
Seq.empty, ByteString
"")
              Seq ByteString
init' Seq.:|> ByteString
last' ->
                -- Note: This logic works also when newbs ends with splitWd because then the last
                -- chunk is the empty bytestring.
                (Seq ByteString
init', ByteString
last')

      {-# INLINE processHeader #-}
      processHeader :: s -> a -> m (Step (s, ChunkOnFoldState_) b)
processHeader s
chs a
hdr = do
        Step s b
chstep' <- s -> Either a ByteString -> m (Step s b)
chstep s
chs (a -> Either a ByteString
forall a b. a -> Either a b
Left a
hdr)
        case Step s b
chstep' of
          F.Done b
a -> Step (s, ChunkOnFoldState_) b -> m (Step (s, ChunkOnFoldState_) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, ChunkOnFoldState_) b
 -> m (Step (s, ChunkOnFoldState_) b))
-> Step (s, ChunkOnFoldState_) b
-> m (Step (s, ChunkOnFoldState_) b)
forall a b. (a -> b) -> a -> b
$ b -> Step (s, ChunkOnFoldState_) b
forall s b. b -> Step s b
F.Done b
a
          F.Partial s
chs' -> Step (s, ChunkOnFoldState_) b -> m (Step (s, ChunkOnFoldState_) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, ChunkOnFoldState_) b
 -> m (Step (s, ChunkOnFoldState_) b))
-> Step (s, ChunkOnFoldState_) b
-> m (Step (s, ChunkOnFoldState_) b)
forall a b. (a -> b) -> a -> b
$ (s, ChunkOnFoldState_) -> Step (s, ChunkOnFoldState_) b
forall s b. s -> Step s b
F.Partial (s
chs', ChunkOnFoldState_
Header_)
      {-# INLINE processBytestring #-}
      processBytestring :: s -> ByteString -> ByteString -> m (Step (s, ChunkOnFoldState_) b)
processBytestring s
chs ByteString
residue ByteString
chbs = do
        let (Seq ByteString
chunks, ByteString
residue') = ByteString -> ByteString -> (Seq ByteString, ByteString)
toChunks ByteString
residue ByteString
chbs
        Step s b
chstep' <- s -> [ByteString] -> m (Step s b)
go s
chs (Seq ByteString -> [ByteString]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq ByteString
chunks)
        case Step s b
chstep' of
          F.Done b
a -> Step (s, ChunkOnFoldState_) b -> m (Step (s, ChunkOnFoldState_) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, ChunkOnFoldState_) b
 -> m (Step (s, ChunkOnFoldState_) b))
-> Step (s, ChunkOnFoldState_) b
-> m (Step (s, ChunkOnFoldState_) b)
forall a b. (a -> b) -> a -> b
$ b -> Step (s, ChunkOnFoldState_) b
forall s b. b -> Step s b
F.Done b
a
          F.Partial s
chs' -> Step (s, ChunkOnFoldState_) b -> m (Step (s, ChunkOnFoldState_) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, ChunkOnFoldState_) b
 -> m (Step (s, ChunkOnFoldState_) b))
-> Step (s, ChunkOnFoldState_) b
-> m (Step (s, ChunkOnFoldState_) b)
forall a b. (a -> b) -> a -> b
$ (s, ChunkOnFoldState_) -> Step (s, ChunkOnFoldState_) b
forall s b. s -> Step s b
F.Partial (s
chs', ByteString -> ChunkOnFoldState_
Chunks_ ByteString
residue')
   in -- Note: If a file ends with "\n", we want to include the last empty line.
      ((s, ChunkOnFoldState_)
 -> Either a ByteString -> m (Step (s, ChunkOnFoldState_) b))
-> m (Step (s, ChunkOnFoldState_) b)
-> ((s, ChunkOnFoldState_) -> m b)
-> ((s, ChunkOnFoldState_) -> m b)
-> Fold m (Either a ByteString) b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
F.Fold
        ( \(s
chs, ChunkOnFoldState_
s) Either a ByteString
e -> case ChunkOnFoldState_
s of
            ChunkOnFoldState_
Init_ -> case Either a ByteString
e of
              Left a
hdr -> do
                s -> a -> m (Step (s, ChunkOnFoldState_) b)
processHeader s
chs a
hdr
              Right ByteString
newbs ->
                -- This case is possible. Although a bytestring appearing initially without any
                -- preceding header is not what we have in mind for streamly-archive, we want this
                -- fold to focus only on the bytestring splitting.
                s -> ByteString -> ByteString -> m (Step (s, ChunkOnFoldState_) b)
processBytestring s
chs ByteString
"" ByteString
newbs
            ChunkOnFoldState_
Header_ -> case Either a ByteString
e of
              Left a
hdr -> do
                -- No bytestrings followed the previous header.
                s -> a -> m (Step (s, ChunkOnFoldState_) b)
processHeader s
chs a
hdr
              Right ByteString
newbs ->
                s -> ByteString -> ByteString -> m (Step (s, ChunkOnFoldState_) b)
processBytestring s
chs ByteString
"" ByteString
newbs
            Chunks_ ByteString
residue -> case Either a ByteString
e of
              Left a
hdr -> do
                Step s b
chstep' <- s -> Either a ByteString -> m (Step s b)
chstep s
chs (ByteString -> Either a ByteString
forall a b. b -> Either a b
Right ByteString
residue)
                case Step s b
chstep' of
                  F.Done b
a -> Step (s, ChunkOnFoldState_) b -> m (Step (s, ChunkOnFoldState_) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, ChunkOnFoldState_) b
 -> m (Step (s, ChunkOnFoldState_) b))
-> Step (s, ChunkOnFoldState_) b
-> m (Step (s, ChunkOnFoldState_) b)
forall a b. (a -> b) -> a -> b
$ b -> Step (s, ChunkOnFoldState_) b
forall s b. b -> Step s b
F.Done b
a
                  F.Partial s
chs' -> do
                    s -> a -> m (Step (s, ChunkOnFoldState_) b)
processHeader s
chs' a
hdr
              Right ByteString
newbs ->
                s -> ByteString -> ByteString -> m (Step (s, ChunkOnFoldState_) b)
processBytestring s
chs ByteString
residue ByteString
newbs
        )
        ( do
            Step s b
chstep' <- m (Step s b)
chinit
            case Step s b
chstep' of
              F.Done b
a -> Step (s, ChunkOnFoldState_) b -> m (Step (s, ChunkOnFoldState_) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, ChunkOnFoldState_) b
 -> m (Step (s, ChunkOnFoldState_) b))
-> Step (s, ChunkOnFoldState_) b
-> m (Step (s, ChunkOnFoldState_) b)
forall a b. (a -> b) -> a -> b
$ b -> Step (s, ChunkOnFoldState_) b
forall s b. b -> Step s b
F.Done b
a
              F.Partial s
chs' -> Step (s, ChunkOnFoldState_) b -> m (Step (s, ChunkOnFoldState_) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, ChunkOnFoldState_) b
 -> m (Step (s, ChunkOnFoldState_) b))
-> Step (s, ChunkOnFoldState_) b
-> m (Step (s, ChunkOnFoldState_) b)
forall a b. (a -> b) -> a -> b
$ (s, ChunkOnFoldState_) -> Step (s, ChunkOnFoldState_) b
forall s b. s -> Step s b
F.Partial (s
chs', ChunkOnFoldState_
Init_)
        )
        (\(s
chs, ChunkOnFoldState_
_) -> s -> m b
chextr s
chs)
        ( \(s
chs, ChunkOnFoldState_
s) -> case ChunkOnFoldState_
s of
            Chunks_ ByteString
residue -> do
              Step s b
chstep' <- s -> Either a ByteString -> m (Step s b)
chstep s
chs (ByteString -> Either a ByteString
forall a b. b -> Either a b
Right ByteString
residue)
              case Step s b
chstep' of
                F.Done b
a -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
a
                F.Partial s
chs' -> s -> m b
chfinal s
chs'
            ChunkOnFoldState_
_ -> s -> m b
chfinal s
chs
        )