{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

#include "inline.hs"

-- |
-- Module      : Streamly.Internal.Data.Parser.ParserD.Tee
-- Copyright   : (c) 2020 Composewell Technologies
-- License     : BSD-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- Parallel parsers. Distributing the input to multiple parsers at the same
-- time.
--
-- For simplicity, we are using code where a particular state is unreachable
-- but it is not prevented by types.  Somehow uni-pattern match using "let"
-- produces better optimized code compared to using @case@ match and using
-- explicit error messages in unreachable cases.
--
-- There seem to be no way to silence individual warnings so we use a global
-- incomplete uni-pattern match warning suppression option for the file.
-- Disabling the warning for other code as well  has the potential to mask off
-- some legit warnings, therefore, we have segregated only the code that uses
-- uni-pattern matches in this module.

module Streamly.Internal.Data.Parser.ParserD.Tee
    (
    -- Parallel zipped
      teeWith
    , teeWithFst
    , teeWithMin

    -- Parallel alternatives
    , shortest
    , longest
    )
where

import Control.Exception (assert)
import Control.Monad.Catch (MonadCatch, try)
import Prelude
       hiding (any, all, takeWhile)

import Fusion.Plugin.Types (Fuse(..))
import Streamly.Internal.Data.Parser.ParserD.Type
       (Initial(..), Parser(..), Step(..), ParseError)

-------------------------------------------------------------------------------
-- Distribute input to two parsers and collect both results
-------------------------------------------------------------------------------

-- When the input stream is distributed to two parsers, both the parsers can
-- backtrack independently. Therefore, we need separate buffer state for each
-- parser.
--
-- ParserK
--
-- We can keep the state of each parser in the zipper and pass around that
-- zipper to the parsers. Each parser can consume from the zipper and then pass
-- around the zipper to the other parser.
--
-- ParserD
--
-- In the approach we have taken here, the driver pushes one element at a time
-- to the tee and each of the parsers in the tee may buffer it independently
-- for backtracking. So they do not need to depend on the original stream
-- source for individual parser backtracking. Problem arises when both the
-- parsers backtrack and they do not need any input from the driver rather they
-- must consume from their buffers. For such situation we may need a
-- "Continue" style driver command from the tee so that the driver runs
-- the tee without providing it any input. Or we may need a local driver loop
-- until new input is to be demanded from the input stream.
--
-- When the tee errors out or stops, the tee driver may have to backtrack by
-- the specified amount (or the tee must return the leftover input). Therefore,
-- the tee driver also has to buffer, this leads to triple buffering.
--
-- When the tee stops we need to determine the backtracking amount from the
-- leftover of both the parsers. Since both the parsers may have consumed
-- different lengths of the stream we consider the maximum of the two as
-- consumed.
--
  -- XXX We can use Initial instead of StepState
{-# ANN type StepState Fuse #-}
data StepState s a = StepState s | StepResult a

-- | State of the pair of parsers in a tee composition
-- Note: strictness annotation is important for fusing the constructors
{-# ANN type TeeState Fuse #-}
data TeeState sL sR x a b =
-- @TeePair (past buffer, parser state, future-buffer1, future-buffer2) ...@
    TeePair !([x], StepState sL a, [x], [x]) !([x], StepState sR b, [x], [x])

{-# ANN type Res Fuse #-}
data Res = Yld Int | Stp Int | Skp | Err String

-- | See 'Streamly.Internal.Data.Parser.teeWith'.
--
-- /Broken/
--
{-# INLINE teeWith #-}
teeWith :: Monad m
    => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
teeWith :: (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
teeWith a -> b -> c
zf (Parser s -> x -> m (Step s a)
stepL m (Initial s a)
initialL s -> m a
extractL) (Parser s -> x -> m (Step s b)
stepR m (Initial s b)
initialR s -> m b
extractR) =
    (TeeState s s x a b -> x -> m (Step (TeeState s s x a b) c))
-> m (Initial (TeeState s s x a b) c)
-> (TeeState s s x a b -> m c)
-> Parser m x c
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser TeeState s s x a b -> x -> m (Step (TeeState s s x a b) c)
step m (Initial (TeeState s s x a b) c)
forall x. m (Initial (TeeState s s x a b) c)
initial TeeState s s x a b -> m c
forall x. TeeState s s x a b -> m c
extract

    where

    {-# INLINE_LATE initial #-}
    initial :: m (Initial (TeeState s s x a b) c)
initial = do
        Initial s a
resL <- m (Initial s a)
initialL
        Initial s b
resR <- m (Initial s b)
initialR
        Initial (TeeState s s x a b) c
-> m (Initial (TeeState s s x a b) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (TeeState s s x a b) c
 -> m (Initial (TeeState s s x a b) c))
-> Initial (TeeState s s x a b) c
-> m (Initial (TeeState s s x a b) c)
forall a b. (a -> b) -> a -> b
$ case Initial s a
resL of
            IPartial s
sl ->
                case Initial s b
resR of
                     IPartial s
sr -> TeeState s s x a b -> Initial (TeeState s s x a b) c
forall s b. s -> Initial s b
IPartial (TeeState s s x a b -> Initial (TeeState s s x a b) c)
-> TeeState s s x a b -> Initial (TeeState s s x a b) c
forall a b. (a -> b) -> a -> b
$ ([x], StepState s a, [x], [x])
-> ([x], StepState s b, [x], [x]) -> TeeState s s x a b
forall sL sR x a b.
([x], StepState sL a, [x], [x])
-> ([x], StepState sR b, [x], [x]) -> TeeState sL sR x a b
TeePair ([], s -> StepState s a
forall s a. s -> StepState s a
StepState s
sl, [], [])
                                                       ([], s -> StepState s b
forall s a. s -> StepState s a
StepState s
sr, [], [])
                     IDone b
br -> TeeState s s x a b -> Initial (TeeState s s x a b) c
forall s b. s -> Initial s b
IPartial (TeeState s s x a b -> Initial (TeeState s s x a b) c)
-> TeeState s s x a b -> Initial (TeeState s s x a b) c
forall a b. (a -> b) -> a -> b
$ ([x], StepState s a, [x], [x])
-> ([x], StepState s b, [x], [x]) -> TeeState s s x a b
forall sL sR x a b.
([x], StepState sL a, [x], [x])
-> ([x], StepState sR b, [x], [x]) -> TeeState sL sR x a b
TeePair ([], s -> StepState s a
forall s a. s -> StepState s a
StepState s
sl, [], [])
                                                    ([], b -> StepState s b
forall s a. a -> StepState s a
StepResult b
br, [], [])
                     IError String
err -> String -> Initial (TeeState s s x a b) c
forall s b. String -> Initial s b
IError String
err
            IDone a
bl ->
                case Initial s b
resR of
                     IPartial s
sr ->
                         TeeState s s x a b -> Initial (TeeState s s x a b) c
forall s b. s -> Initial s b
IPartial (TeeState s s x a b -> Initial (TeeState s s x a b) c)
-> TeeState s s x a b -> Initial (TeeState s s x a b) c
forall a b. (a -> b) -> a -> b
$ ([x], StepState s a, [x], [x])
-> ([x], StepState s b, [x], [x]) -> TeeState s s x a b
forall sL sR x a b.
([x], StepState sL a, [x], [x])
-> ([x], StepState sR b, [x], [x]) -> TeeState sL sR x a b
TeePair ([], a -> StepState s a
forall s a. a -> StepState s a
StepResult a
bl, [], [])
                                            ([], s -> StepState s b
forall s a. s -> StepState s a
StepState s
sr, [], [])
                     IDone b
br -> c -> Initial (TeeState s s x a b) c
forall s b. b -> Initial s b
IDone (c -> Initial (TeeState s s x a b) c)
-> c -> Initial (TeeState s s x a b) c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
zf a
bl b
br
                     IError String
err -> String -> Initial (TeeState s s x a b) c
forall s b. String -> Initial s b
IError String
err
            IError String
err -> String -> Initial (TeeState s s x a b) c
forall s b. String -> Initial s b
IError String
err

    {-# INLINE consume #-}
    consume :: [t]
-> [t] -> [t] -> (t -> t -> m b) -> t -> t -> m ([t], b, [t], [t])
consume [t]
buf [t]
inp1 [t]
inp2 t -> t -> m b
stp t
st t
y = do
        let (t
x, [t]
inp11, [t]
inp21) =
                case [t]
inp1 of
                    [] -> (t
y, [], [])
                    z : [] -> (t
z, [t] -> [t]
forall a. [a] -> [a]
reverse (t
xt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
inp2), [])
                    z : zs -> (t
z, [t]
zs, t
xt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
inp2)
        b
r <- t -> t -> m b
stp t
st t
x
        let buf1 :: [t]
buf1 = t
xt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
buf
        ([t], b, [t], [t]) -> m ([t], b, [t], [t])
forall (m :: * -> *) a. Monad m => a -> m a
return ([t]
buf1, b
r, [t]
inp11, [t]
inp21)

    -- XXX This is currently broken, even though both the parsers need to
    -- consume from their buffers after backtracking the driver would still be
    -- pushing more input to the buffers.
    --
    -- consume one input item and return the next state of the fold
    {-# INLINE useStream #-}
    useStream :: [a]
-> [a]
-> [a]
-> (t -> a -> m (Step s a))
-> t
-> a
-> m (([a], StepState s a, [a], [a]), Res)
useStream [a]
buf [a]
inp1 [a]
inp2 t -> a -> m (Step s a)
stp t
st a
y = do
        ([a]
buf1, Step s a
r, [a]
inp11, [a]
inp21) <- [a]
-> [a]
-> [a]
-> (t -> a -> m (Step s a))
-> t
-> a
-> m ([a], Step s a, [a], [a])
forall (m :: * -> *) t t b.
Monad m =>
[t]
-> [t] -> [t] -> (t -> t -> m b) -> t -> t -> m ([t], b, [t], [t])
consume [a]
buf [a]
inp1 [a]
inp2 t -> a -> m (Step s a)
stp t
st a
y
        case Step s a
r of
            Partial Int
0 s
s ->
                let state :: ([a], StepState s a, [a], [a])
state = ([], s -> StepState s a
forall s a. s -> StepState s a
StepState s
s, [a]
inp11, [a]
inp21)
                 in (([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], StepState s a, [a], [a])
forall a a. ([a], StepState s a, [a], [a])
state, Int -> Res
Yld Int
0)
            Partial Int
n s
s ->
                let src0 :: [a]
src0 = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n [a]
buf1
                    src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0
                    state :: ([a], StepState s a, [a], [a])
state = ([], s -> StepState s a
forall s a. s -> StepState s a
StepState s
s, [a]
src [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
inp11, [a]
inp21)
                 in Bool
-> m (([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
buf1) ((([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], StepState s a, [a], [a])
forall a a. ([a], StepState s a, [a], [a])
state, Int -> Res
Yld Int
n))
            Done Int
n a
b ->
                let state :: ([a], StepState s a, [a], [a])
state = (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n [a]
buf1, a -> StepState s a
forall s a. a -> StepState s a
StepResult a
b, [a]
inp11, [a]
inp21)
                 in Bool
-> m (([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
buf1) ((([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], StepState s a, [a], [a])
forall s. ([a], StepState s a, [a], [a])
state, Int -> Res
Stp Int
n))
            -- Continue 0 s -> (buf1, Right s, inp11, inp21)
            Continue Int
n s
s ->
                let ([a]
src0, [a]
buf2) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
buf1
                    src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0
                    state :: ([a], StepState s a, [a], [a])
state = ([a]
buf2, s -> StepState s a
forall s a. s -> StepState s a
StepState s
s, [a]
src [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
inp11, [a]
inp21)
                 in Bool
-> m (([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
buf1) ((([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], StepState s a, [a], [a])
forall a. ([a], StepState s a, [a], [a])
state, Res
Skp))
            Error String
err -> (([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], StepState s a, [a], [a])
forall a. (?callStack::CallStack) => a
undefined, String -> Res
Err String
err)

    {-# INLINE_LATE step #-}
    step :: TeeState s s x a b -> x -> m (Step (TeeState s s x a b) c)
step (TeePair ([x]
bufL, StepState s
sL, [x]
inpL1, [x]
inpL2)
                  ([x]
bufR, StepState s
sR, [x]
inpR1, [x]
inpR2)) x
x = do
        (([x], StepState s a, [x], [x])
l,Res
stL) <- [x]
-> [x]
-> [x]
-> (s -> x -> m (Step s a))
-> s
-> x
-> m (([x], StepState s a, [x], [x]), Res)
forall (m :: * -> *) a t s a.
Monad m =>
[a]
-> [a]
-> [a]
-> (t -> a -> m (Step s a))
-> t
-> a
-> m (([a], StepState s a, [a], [a]), Res)
useStream [x]
bufL [x]
inpL1 [x]
inpL2 s -> x -> m (Step s a)
stepL s
sL x
x
        (([x], StepState s b, [x], [x])
r,Res
stR) <- [x]
-> [x]
-> [x]
-> (s -> x -> m (Step s b))
-> s
-> x
-> m (([x], StepState s b, [x], [x]), Res)
forall (m :: * -> *) a t s a.
Monad m =>
[a]
-> [a]
-> [a]
-> (t -> a -> m (Step s a))
-> t
-> a
-> m (([a], StepState s a, [a], [a]), Res)
useStream [x]
bufR [x]
inpR1 [x]
inpR2 s -> x -> m (Step s b)
stepR s
sR x
x
        let next :: TeeState s s x a b
next = ([x], StepState s a, [x], [x])
-> ([x], StepState s b, [x], [x]) -> TeeState s s x a b
forall sL sR x a b.
([x], StepState sL a, [x], [x])
-> ([x], StepState sR b, [x], [x]) -> TeeState sL sR x a b
TeePair ([x], StepState s a, [x], [x])
l ([x], StepState s b, [x], [x])
r
        Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c))
-> Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c)
forall a b. (a -> b) -> a -> b
$ case (Res
stL,Res
stR) of
            (Yld Int
n1, Yld Int
n2) -> Int -> TeeState s s x a b -> Step (TeeState s s x a b) c
forall s b. Int -> s -> Step s b
Partial (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n1 Int
n2) TeeState s s x a b
next
            (Yld Int
n1, Stp Int
n2) -> Int -> TeeState s s x a b -> Step (TeeState s s x a b) c
forall s b. Int -> s -> Step s b
Partial (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n1 Int
n2) TeeState s s x a b
next
            (Stp Int
n1, Yld Int
n2) -> Int -> TeeState s s x a b -> Step (TeeState s s x a b) c
forall s b. Int -> s -> Step s b
Partial (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n1 Int
n2) TeeState s s x a b
next
            (Stp Int
n1, Stp Int
n2) ->
                -- Uni-pattern match results in better optimized code compared
                -- to a case match.
                let ([x]
_, StepResult a
rL, [x]
_, [x]
_) = ([x], StepState s a, [x], [x])
l
                    ([x]
_, StepResult b
rR, [x]
_, [x]
_) = ([x], StepState s b, [x], [x])
r
                 in Int -> c -> Step (TeeState s s x a b) c
forall s b. Int -> b -> Step s b
Done (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n1 Int
n2) (a -> b -> c
zf a
rL b
rR)
            (Err String
err, Res
_) -> String -> Step (TeeState s s x a b) c
forall s b. String -> Step s b
Error String
err
            (Res
_, Err String
err) -> String -> Step (TeeState s s x a b) c
forall s b. String -> Step s b
Error String
err
            (Res, Res)
_ -> Int -> TeeState s s x a b -> Step (TeeState s s x a b) c
forall s b. Int -> s -> Step s b
Continue Int
0 TeeState s s x a b
next

    step (TeePair ([x]
bufL, StepState s
sL, [x]
inpL1, [x]
inpL2)
                r :: ([x], StepState s b, [x], [x])
r@([x]
_, StepResult b
rR, [x]
_, [x]
_)) x
x = do
        (([x], StepState s a, [x], [x])
l,Res
stL) <- [x]
-> [x]
-> [x]
-> (s -> x -> m (Step s a))
-> s
-> x
-> m (([x], StepState s a, [x], [x]), Res)
forall (m :: * -> *) a t s a.
Monad m =>
[a]
-> [a]
-> [a]
-> (t -> a -> m (Step s a))
-> t
-> a
-> m (([a], StepState s a, [a], [a]), Res)
useStream [x]
bufL [x]
inpL1 [x]
inpL2 s -> x -> m (Step s a)
stepL s
sL x
x
        let next :: TeeState s s x a b
next = ([x], StepState s a, [x], [x])
-> ([x], StepState s b, [x], [x]) -> TeeState s s x a b
forall sL sR x a b.
([x], StepState sL a, [x], [x])
-> ([x], StepState sR b, [x], [x]) -> TeeState sL sR x a b
TeePair ([x], StepState s a, [x], [x])
l ([x], StepState s b, [x], [x])
r
        -- XXX If the unused count of this stream is lower than the unused
        -- count of the stopped stream, only then this will be correct. We need
        -- to fix the other case. We need to keep incrementing the unused count
        -- of the stopped stream and take the min of the two.
        Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c))
-> Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c)
forall a b. (a -> b) -> a -> b
$ case Res
stL of
            Yld Int
n -> Int -> TeeState s s x a b -> Step (TeeState s s x a b) c
forall s b. Int -> s -> Step s b
Partial Int
n TeeState s s x a b
next
            Stp Int
n ->
                let ([x]
_, StepResult a
rL, [x]
_, [x]
_) = ([x], StepState s a, [x], [x])
l
                 in Int -> c -> Step (TeeState s s x a b) c
forall s b. Int -> b -> Step s b
Done Int
n (a -> b -> c
zf a
rL b
rR)
            Res
Skp -> Int -> TeeState s s x a b -> Step (TeeState s s x a b) c
forall s b. Int -> s -> Step s b
Continue Int
0 TeeState s s x a b
next
            Err String
err -> String -> Step (TeeState s s x a b) c
forall s b. String -> Step s b
Error String
err

    step (TeePair l :: ([x], StepState s a, [x], [x])
l@([x]
_, StepResult a
rL, [x]
_, [x]
_)
                    ([x]
bufR, StepState s
sR, [x]
inpR1, [x]
inpR2)) x
x = do
        (([x], StepState s b, [x], [x])
r, Res
stR) <- [x]
-> [x]
-> [x]
-> (s -> x -> m (Step s b))
-> s
-> x
-> m (([x], StepState s b, [x], [x]), Res)
forall (m :: * -> *) a t s a.
Monad m =>
[a]
-> [a]
-> [a]
-> (t -> a -> m (Step s a))
-> t
-> a
-> m (([a], StepState s a, [a], [a]), Res)
useStream [x]
bufR [x]
inpR1 [x]
inpR2 s -> x -> m (Step s b)
stepR s
sR x
x
        let next :: TeeState s s x a b
next = ([x], StepState s a, [x], [x])
-> ([x], StepState s b, [x], [x]) -> TeeState s s x a b
forall sL sR x a b.
([x], StepState sL a, [x], [x])
-> ([x], StepState sR b, [x], [x]) -> TeeState sL sR x a b
TeePair ([x], StepState s a, [x], [x])
l ([x], StepState s b, [x], [x])
r
        -- XXX If the unused count of this stream is lower than the unused
        -- count of the stopped stream, only then this will be correct. We need
        -- to fix the other case. We need to keep incrementing the unused count
        -- of the stopped stream and take the min of the two.
        Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c))
-> Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c)
forall a b. (a -> b) -> a -> b
$ case Res
stR of
            Yld Int
n -> Int -> TeeState s s x a b -> Step (TeeState s s x a b) c
forall s b. Int -> s -> Step s b
Partial Int
n TeeState s s x a b
next
            Stp Int
n ->
                let ([x]
_, StepResult b
rR, [x]
_, [x]
_) = ([x], StepState s b, [x], [x])
r
                 in Int -> c -> Step (TeeState s s x a b) c
forall s b. Int -> b -> Step s b
Done Int
n (a -> b -> c
zf a
rL b
rR)
            Res
Skp -> Int -> TeeState s s x a b -> Step (TeeState s s x a b) c
forall s b. Int -> s -> Step s b
Continue Int
0 TeeState s s x a b
next
            Err String
err -> String -> Step (TeeState s s x a b) c
forall s b. String -> Step s b
Error String
err

    step TeeState s s x a b
_ x
_ = m (Step (TeeState s s x a b) c)
forall a. (?callStack::CallStack) => a
undefined

    {-# INLINE_LATE extract #-}
    extract :: TeeState s s x a b -> m c
extract TeeState s s x a b
st =
        case TeeState s s x a b
st of
            TeePair ([x]
_, StepState s
sL, [x]
_, [x]
_) ([x]
_, StepState s
sR, [x]
_, [x]
_) -> do
                a
rL <- s -> m a
extractL s
sL
                b
rR <- s -> m b
extractR s
sR
                c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> m c) -> c -> m c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
zf a
rL b
rR
            TeePair ([x]
_, StepState s
sL, [x]
_, [x]
_) ([x]
_, StepResult b
rR, [x]
_, [x]
_) -> do
                a
rL <- s -> m a
extractL s
sL
                c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> m c) -> c -> m c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
zf a
rL b
rR
            TeePair ([x]
_, StepResult  a
rL, [x]
_, [x]
_) ([x]
_, StepState s
sR, [x]
_, [x]
_) -> do
                b
rR <- s -> m b
extractR s
sR
                c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> m c) -> c -> m c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
zf a
rL b
rR
            TeePair ([x]
_, StepResult a
rL, [x]
_, [x]
_) ([x]
_, StepResult b
rR, [x]
_, [x]
_) ->
                c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> m c) -> c -> m c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
zf a
rL b
rR

-- | See 'Streamly.Internal.Data.Parser.teeWithFst'.
--
-- /Broken/
--
{-# INLINE teeWithFst #-}
teeWithFst :: Monad m
    => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
teeWithFst :: (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
teeWithFst a -> b -> c
zf (Parser s -> x -> m (Step s a)
stepL m (Initial s a)
initialL s -> m a
extractL)
              (Parser s -> x -> m (Step s b)
stepR m (Initial s b)
initialR s -> m b
extractR) =
    (TeeState s s x a b -> x -> m (Step (TeeState s s x a b) c))
-> m (Initial (TeeState s s x a b) c)
-> (TeeState s s x a b -> m c)
-> Parser m x c
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser TeeState s s x a b -> x -> m (Step (TeeState s s x a b) c)
forall a.
TeeState s s x a b -> x -> m (Step (TeeState s s x a b) c)
step m (Initial (TeeState s s x a b) c)
forall x a. m (Initial (TeeState s s x a b) c)
initial TeeState s s x a b -> m c
forall x a. TeeState s s x a b -> m c
extract

    where

    {-# INLINE_LATE initial #-}
    initial :: m (Initial (TeeState s s x a b) c)
initial = do
        Initial s a
resL <- m (Initial s a)
initialL
        Initial s b
resR <- m (Initial s b)
initialR
        case Initial s a
resL of
            IPartial s
sl ->
                Initial (TeeState s s x a b) c
-> m (Initial (TeeState s s x a b) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (TeeState s s x a b) c
 -> m (Initial (TeeState s s x a b) c))
-> Initial (TeeState s s x a b) c
-> m (Initial (TeeState s s x a b) c)
forall a b. (a -> b) -> a -> b
$ case Initial s b
resR of
                     IPartial s
sr -> TeeState s s x a b -> Initial (TeeState s s x a b) c
forall s b. s -> Initial s b
IPartial (TeeState s s x a b -> Initial (TeeState s s x a b) c)
-> TeeState s s x a b -> Initial (TeeState s s x a b) c
forall a b. (a -> b) -> a -> b
$ ([x], StepState s a, [x], [x])
-> ([x], StepState s b, [x], [x]) -> TeeState s s x a b
forall sL sR x a b.
([x], StepState sL a, [x], [x])
-> ([x], StepState sR b, [x], [x]) -> TeeState sL sR x a b
TeePair ([], s -> StepState s a
forall s a. s -> StepState s a
StepState s
sl, [], [])
                                                       ([], s -> StepState s b
forall s a. s -> StepState s a
StepState s
sr, [], [])
                     IDone b
br -> TeeState s s x a b -> Initial (TeeState s s x a b) c
forall s b. s -> Initial s b
IPartial (TeeState s s x a b -> Initial (TeeState s s x a b) c)
-> TeeState s s x a b -> Initial (TeeState s s x a b) c
forall a b. (a -> b) -> a -> b
$ ([x], StepState s a, [x], [x])
-> ([x], StepState s b, [x], [x]) -> TeeState s s x a b
forall sL sR x a b.
([x], StepState sL a, [x], [x])
-> ([x], StepState sR b, [x], [x]) -> TeeState sL sR x a b
TeePair ([], s -> StepState s a
forall s a. s -> StepState s a
StepState s
sl, [], [])
                                                    ([], b -> StepState s b
forall s a. a -> StepState s a
StepResult b
br, [], [])
                     IError String
err -> String -> Initial (TeeState s s x a b) c
forall s b. String -> Initial s b
IError String
err
            IDone a
bl ->
                case Initial s b
resR of
                     IPartial s
sr -> c -> Initial (TeeState s s x a b) c
forall s b. b -> Initial s b
IDone (c -> Initial (TeeState s s x a b) c)
-> (b -> c) -> b -> Initial (TeeState s s x a b) c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c
zf a
bl (b -> Initial (TeeState s s x a b) c)
-> m b -> m (Initial (TeeState s s x a b) c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
extractR s
sr
                     IDone b
br -> Initial (TeeState s s x a b) c
-> m (Initial (TeeState s s x a b) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (TeeState s s x a b) c
 -> m (Initial (TeeState s s x a b) c))
-> Initial (TeeState s s x a b) c
-> m (Initial (TeeState s s x a b) c)
forall a b. (a -> b) -> a -> b
$ c -> Initial (TeeState s s x a b) c
forall s b. b -> Initial s b
IDone (c -> Initial (TeeState s s x a b) c)
-> c -> Initial (TeeState s s x a b) c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
zf a
bl b
br
                     IError String
err -> Initial (TeeState s s x a b) c
-> m (Initial (TeeState s s x a b) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (TeeState s s x a b) c
 -> m (Initial (TeeState s s x a b) c))
-> Initial (TeeState s s x a b) c
-> m (Initial (TeeState s s x a b) c)
forall a b. (a -> b) -> a -> b
$ String -> Initial (TeeState s s x a b) c
forall s b. String -> Initial s b
IError String
err
            IError String
err -> Initial (TeeState s s x a b) c
-> m (Initial (TeeState s s x a b) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (TeeState s s x a b) c
 -> m (Initial (TeeState s s x a b) c))
-> Initial (TeeState s s x a b) c
-> m (Initial (TeeState s s x a b) c)
forall a b. (a -> b) -> a -> b
$ String -> Initial (TeeState s s x a b) c
forall s b. String -> Initial s b
IError String
err

    {-# INLINE consume #-}
    consume :: [t]
-> [t] -> [t] -> (t -> t -> m b) -> t -> t -> m ([t], b, [t], [t])
consume [t]
buf [t]
inp1 [t]
inp2 t -> t -> m b
stp t
st t
y = do
        let (t
x, [t]
inp11, [t]
inp21) =
                case [t]
inp1 of
                    [] -> (t
y, [], [])
                    z : [] -> (t
z, [t] -> [t]
forall a. [a] -> [a]
reverse (t
xt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
inp2), [])
                    z : zs -> (t
z, [t]
zs, t
xt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
inp2)
        b
r <- t -> t -> m b
stp t
st t
x
        let buf1 :: [t]
buf1 = t
xt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
buf
        ([t], b, [t], [t]) -> m ([t], b, [t], [t])
forall (m :: * -> *) a. Monad m => a -> m a
return ([t]
buf1, b
r, [t]
inp11, [t]
inp21)

    -- consume one input item and return the next state of the fold
    {-# INLINE useStream #-}
    useStream :: [a]
-> [a]
-> [a]
-> (t -> a -> m (Step s a))
-> t
-> a
-> m (([a], StepState s a, [a], [a]), Res)
useStream [a]
buf [a]
inp1 [a]
inp2 t -> a -> m (Step s a)
stp t
st a
y = do
        ([a]
buf1, Step s a
r, [a]
inp11, [a]
inp21) <- [a]
-> [a]
-> [a]
-> (t -> a -> m (Step s a))
-> t
-> a
-> m ([a], Step s a, [a], [a])
forall (m :: * -> *) t t b.
Monad m =>
[t]
-> [t] -> [t] -> (t -> t -> m b) -> t -> t -> m ([t], b, [t], [t])
consume [a]
buf [a]
inp1 [a]
inp2 t -> a -> m (Step s a)
stp t
st a
y
        case Step s a
r of
            Partial Int
0 s
s ->
                let state :: ([a], StepState s a, [a], [a])
state = ([], s -> StepState s a
forall s a. s -> StepState s a
StepState s
s, [a]
inp11, [a]
inp21)
                 in (([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], StepState s a, [a], [a])
forall a a. ([a], StepState s a, [a], [a])
state, Int -> Res
Yld Int
0)
            Partial Int
n s
_ -> (([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], StepState s a, [a], [a])
forall a. (?callStack::CallStack) => a
undefined, Int -> Res
Yld Int
n) -- Not implemented
            Done Int
n a
b ->
                let state :: ([a], StepState s a, [a], [a])
state = (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n [a]
buf1, a -> StepState s a
forall s a. a -> StepState s a
StepResult a
b, [a]
inp11, [a]
inp21)
                 in Bool
-> m (([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
buf1) ((([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], StepState s a, [a], [a])
forall s. ([a], StepState s a, [a], [a])
state, Int -> Res
Stp Int
n))
            -- Continue 0 s -> (buf1, Right s, inp11, inp21)
            Continue Int
n s
s ->
                let ([a]
src0, [a]
buf2) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
buf1
                    src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0
                    state :: ([a], StepState s a, [a], [a])
state = ([a]
buf2, s -> StepState s a
forall s a. s -> StepState s a
StepState s
s, [a]
src [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
inp11, [a]
inp21)
                 in Bool
-> m (([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
buf1) ((([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], StepState s a, [a], [a])
forall a. ([a], StepState s a, [a], [a])
state, Res
Skp))
            Error String
err -> (([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], StepState s a, [a], [a])
forall a. (?callStack::CallStack) => a
undefined, String -> Res
Err String
err)

    {-# INLINE_LATE step #-}
    step :: TeeState s s x a b -> x -> m (Step (TeeState s s x a b) c)
step (TeePair ([x]
bufL, StepState s
sL, [x]
inpL1, [x]
inpL2)
                  ([x]
bufR, StepState s
sR, [x]
inpR1, [x]
inpR2)) x
x = do
        (([x], StepState s a, [x], [x])
l,Res
stL) <- [x]
-> [x]
-> [x]
-> (s -> x -> m (Step s a))
-> s
-> x
-> m (([x], StepState s a, [x], [x]), Res)
forall (m :: * -> *) a t s a.
Monad m =>
[a]
-> [a]
-> [a]
-> (t -> a -> m (Step s a))
-> t
-> a
-> m (([a], StepState s a, [a], [a]), Res)
useStream [x]
bufL [x]
inpL1 [x]
inpL2 s -> x -> m (Step s a)
stepL s
sL x
x
        (([x], StepState s b, [x], [x])
r,Res
stR) <- [x]
-> [x]
-> [x]
-> (s -> x -> m (Step s b))
-> s
-> x
-> m (([x], StepState s b, [x], [x]), Res)
forall (m :: * -> *) a t s a.
Monad m =>
[a]
-> [a]
-> [a]
-> (t -> a -> m (Step s a))
-> t
-> a
-> m (([a], StepState s a, [a], [a]), Res)
useStream [x]
bufR [x]
inpR1 [x]
inpR2 s -> x -> m (Step s b)
stepR s
sR x
x
        let next :: TeeState s s x a b
next = ([x], StepState s a, [x], [x])
-> ([x], StepState s b, [x], [x]) -> TeeState s s x a b
forall sL sR x a b.
([x], StepState sL a, [x], [x])
-> ([x], StepState sR b, [x], [x]) -> TeeState sL sR x a b
TeePair ([x], StepState s a, [x], [x])
l ([x], StepState s b, [x], [x])
r
        case (Res
stL,Res
stR) of
            -- XXX what if the first parser returns an unused count which is
            -- more than the second parser's unused count? It does not make
            -- sense for the second parser to consume more than the first
            -- parser. We reset the input cursor based on the first parser.
            -- Error out if the second one has consumed more then the first?
            (Stp Int
n1, Stp Int
_) ->
                -- Uni-pattern match results in better optimized code compared
                -- to a case match.
                let ([x]
_, StepResult a
rL, [x]
_, [x]
_) = ([x], StepState s a, [x], [x])
l
                    ([x]
_, StepResult b
rR, [x]
_, [x]
_) = ([x], StepState s b, [x], [x])
r
                 in Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c))
-> Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Step (TeeState s s x a b) c
forall s b. Int -> b -> Step s b
Done Int
n1 (a -> b -> c
zf a
rL b
rR)
            (Stp Int
n1, Yld Int
_) ->
                let ([x]
_, StepResult a
rL, [x]
_, [x]
_) = ([x], StepState s a, [x], [x])
l
                    ([x]
_, StepState  s
ssR, [x]
_, [x]
_) = ([x], StepState s b, [x], [x])
r
                 in do
                    b
rR <- s -> m b
extractR s
ssR
                    Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c))
-> Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Step (TeeState s s x a b) c
forall s b. Int -> b -> Step s b
Done Int
n1 (a -> b -> c
zf a
rL b
rR)
            (Yld Int
n1, Yld Int
n2) -> Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c))
-> Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c)
forall a b. (a -> b) -> a -> b
$ Int -> TeeState s s x a b -> Step (TeeState s s x a b) c
forall s b. Int -> s -> Step s b
Partial (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n1 Int
n2) TeeState s s x a b
next
            (Yld Int
n1, Stp Int
n2) -> Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c))
-> Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c)
forall a b. (a -> b) -> a -> b
$ Int -> TeeState s s x a b -> Step (TeeState s s x a b) c
forall s b. Int -> s -> Step s b
Partial (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n1 Int
n2) TeeState s s x a b
next
            (Err String
err, Res
_) -> Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c))
-> Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c)
forall a b. (a -> b) -> a -> b
$ String -> Step (TeeState s s x a b) c
forall s b. String -> Step s b
Error String
err
            (Res
_, Err String
err) -> Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c))
-> Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c)
forall a b. (a -> b) -> a -> b
$ String -> Step (TeeState s s x a b) c
forall s b. String -> Step s b
Error String
err
            (Res, Res)
_ -> Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c))
-> Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c)
forall a b. (a -> b) -> a -> b
$ Int -> TeeState s s x a b -> Step (TeeState s s x a b) c
forall s b. Int -> s -> Step s b
Continue Int
0 TeeState s s x a b
next

    step (TeePair ([x]
bufL, StepState s
sL, [x]
inpL1, [x]
inpL2)
                r :: ([x], StepState s b, [x], [x])
r@([x]
_, StepResult b
rR, [x]
_, [x]
_)) x
x = do
        (([x], StepState s a, [x], [x])
l,Res
stL) <- [x]
-> [x]
-> [x]
-> (s -> x -> m (Step s a))
-> s
-> x
-> m (([x], StepState s a, [x], [x]), Res)
forall (m :: * -> *) a t s a.
Monad m =>
[a]
-> [a]
-> [a]
-> (t -> a -> m (Step s a))
-> t
-> a
-> m (([a], StepState s a, [a], [a]), Res)
useStream [x]
bufL [x]
inpL1 [x]
inpL2 s -> x -> m (Step s a)
stepL s
sL x
x
        let next :: TeeState s s x a b
next = ([x], StepState s a, [x], [x])
-> ([x], StepState s b, [x], [x]) -> TeeState s s x a b
forall sL sR x a b.
([x], StepState sL a, [x], [x])
-> ([x], StepState sR b, [x], [x]) -> TeeState sL sR x a b
TeePair ([x], StepState s a, [x], [x])
l ([x], StepState s b, [x], [x])
r
        -- XXX If the unused count of this stream is lower than the unused
        -- count of the stopped stream, only then this will be correct. We need
        -- to fix the other case. We need to keep incrementing the unused count
        -- of the stopped stream and take the min of the two.
        Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c))
-> Step (TeeState s s x a b) c -> m (Step (TeeState s s x a b) c)
forall a b. (a -> b) -> a -> b
$ case Res
stL of
            Yld Int
n -> Int -> TeeState s s x a b -> Step (TeeState s s x a b) c
forall s b. Int -> s -> Step s b
Partial Int
n TeeState s s x a b
next
            Stp Int
n ->
                let ([x]
_, StepResult a
rL, [x]
_, [x]
_) = ([x], StepState s a, [x], [x])
l
                 in Int -> c -> Step (TeeState s s x a b) c
forall s b. Int -> b -> Step s b
Done Int
n (a -> b -> c
zf a
rL b
rR)
            Res
Skp -> Int -> TeeState s s x a b -> Step (TeeState s s x a b) c
forall s b. Int -> s -> Step s b
Continue Int
0 TeeState s s x a b
next
            Err String
err -> String -> Step (TeeState s s x a b) c
forall s b. String -> Step s b
Error String
err

    step TeeState s s x a b
_ x
_ = m (Step (TeeState s s x a b) c)
forall a. (?callStack::CallStack) => a
undefined

    {-# INLINE_LATE extract #-}
    extract :: TeeState s s x a b -> m c
extract TeeState s s x a b
st =
        case TeeState s s x a b
st of
            TeePair ([x]
_, StepState s
sL, [x]
_, [x]
_) ([x]
_, StepState s
sR, [x]
_, [x]
_) -> do
                a
rL <- s -> m a
extractL s
sL
                b
rR <- s -> m b
extractR s
sR
                c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> m c) -> c -> m c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
zf a
rL b
rR
            TeePair ([x]
_, StepState s
sL, [x]
_, [x]
_) ([x]
_, StepResult b
rR, [x]
_, [x]
_) -> do
                a
rL <- s -> m a
extractL s
sL
                c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> m c) -> c -> m c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
zf a
rL b
rR
            TeeState s s x a b
_ -> String -> m c
forall a. (?callStack::CallStack) => String -> a
error String
"unreachable"

-- | See 'Streamly.Internal.Data.Parser.teeWithMin'.
--
-- /Unimplemented/
--
{-# INLINE teeWithMin #-}
teeWithMin ::
    -- Monad m =>
    (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
teeWithMin :: (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
teeWithMin = (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
forall a. (?callStack::CallStack) => a
undefined

-------------------------------------------------------------------------------
-- Distribute input to two parsers and choose one result
-------------------------------------------------------------------------------

-- | See 'Streamly.Internal.Data.Parser.shortest'.
--
-- /Broken/
--
{-# INLINE shortest #-}
shortest :: Monad m => Parser m x a -> Parser m x a -> Parser m x a
shortest :: Parser m x a -> Parser m x a -> Parser m x a
shortest (Parser s -> x -> m (Step s a)
stepL m (Initial s a)
initialL s -> m a
extractL) (Parser s -> x -> m (Step s a)
stepR m (Initial s a)
initialR s -> m a
_) =
    (TeeState s s x a a -> x -> m (Step (TeeState s s x a a) a))
-> m (Initial (TeeState s s x a a) a)
-> (TeeState s s x a a -> m a)
-> Parser m x a
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser TeeState s s x a a -> x -> m (Step (TeeState s s x a a) a)
forall a b.
TeeState s s x a b -> x -> m (Step (TeeState s s x a a) a)
step m (Initial (TeeState s s x a a) a)
forall x a b. m (Initial (TeeState s s x a b) a)
initial TeeState s s x a a -> m a
forall sR x a b. TeeState s sR x a b -> m a
extract

    where

    {-# INLINE_LATE initial #-}
    initial :: m (Initial (TeeState s s x a b) a)
initial = do
        Initial s a
resL <- m (Initial s a)
initialL
        Initial s a
resR <- m (Initial s a)
initialR
        Initial (TeeState s s x a b) a
-> m (Initial (TeeState s s x a b) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (TeeState s s x a b) a
 -> m (Initial (TeeState s s x a b) a))
-> Initial (TeeState s s x a b) a
-> m (Initial (TeeState s s x a b) a)
forall a b. (a -> b) -> a -> b
$ case Initial s a
resL of
            IPartial s
sl ->
                case Initial s a
resR of
                     IPartial s
sr -> TeeState s s x a b -> Initial (TeeState s s x a b) a
forall s b. s -> Initial s b
IPartial (TeeState s s x a b -> Initial (TeeState s s x a b) a)
-> TeeState s s x a b -> Initial (TeeState s s x a b) a
forall a b. (a -> b) -> a -> b
$ ([x], StepState s a, [x], [x])
-> ([x], StepState s b, [x], [x]) -> TeeState s s x a b
forall sL sR x a b.
([x], StepState sL a, [x], [x])
-> ([x], StepState sR b, [x], [x]) -> TeeState sL sR x a b
TeePair ([], s -> StepState s a
forall s a. s -> StepState s a
StepState s
sl, [], [])
                                                       ([], s -> StepState s b
forall s a. s -> StepState s a
StepState s
sr, [], [])
                     IDone a
br -> a -> Initial (TeeState s s x a b) a
forall s b. b -> Initial s b
IDone a
br
                     IError String
err -> String -> Initial (TeeState s s x a b) a
forall s b. String -> Initial s b
IError String
err
            IDone a
bl -> a -> Initial (TeeState s s x a b) a
forall s b. b -> Initial s b
IDone a
bl
            IError String
errL ->
                case Initial s a
resR of
                     IPartial s
_ -> String -> Initial (TeeState s s x a b) a
forall s b. String -> Initial s b
IError String
errL
                     IDone a
br -> a -> Initial (TeeState s s x a b) a
forall s b. b -> Initial s b
IDone a
br
                     IError String
errR -> String -> Initial (TeeState s s x a b) a
forall s b. String -> Initial s b
IError String
errR

    {-# INLINE consume #-}
    consume :: [t]
-> [t] -> [t] -> (t -> t -> m b) -> t -> t -> m ([t], b, [t], [t])
consume [t]
buf [t]
inp1 [t]
inp2 t -> t -> m b
stp t
st t
y = do
        let (t
x, [t]
inp11, [t]
inp21) =
                case [t]
inp1 of
                    [] -> (t
y, [], [])
                    z : [] -> (t
z, [t] -> [t]
forall a. [a] -> [a]
reverse (t
xt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
inp2), [])
                    z : zs -> (t
z, [t]
zs, t
xt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
inp2)
        b
r <- t -> t -> m b
stp t
st t
x
        let buf1 :: [t]
buf1 = t
xt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
buf
        ([t], b, [t], [t]) -> m ([t], b, [t], [t])
forall (m :: * -> *) a. Monad m => a -> m a
return ([t]
buf1, b
r, [t]
inp11, [t]
inp21)

    -- consume one input item and return the next state of the fold
    {-# INLINE useStream #-}
    useStream :: [a]
-> [a]
-> [a]
-> (t -> a -> m (Step s a))
-> t
-> a
-> m (([a], StepState s a, [a], [a]), Res)
useStream [a]
buf [a]
inp1 [a]
inp2 t -> a -> m (Step s a)
stp t
st a
y = do
        ([a]
buf1, Step s a
r, [a]
inp11, [a]
inp21) <- [a]
-> [a]
-> [a]
-> (t -> a -> m (Step s a))
-> t
-> a
-> m ([a], Step s a, [a], [a])
forall (m :: * -> *) t t b.
Monad m =>
[t]
-> [t] -> [t] -> (t -> t -> m b) -> t -> t -> m ([t], b, [t], [t])
consume [a]
buf [a]
inp1 [a]
inp2 t -> a -> m (Step s a)
stp t
st a
y
        case Step s a
r of
            Partial Int
0 s
s ->
                let state :: ([a], StepState s a, [a], [a])
state = ([], s -> StepState s a
forall s a. s -> StepState s a
StepState s
s, [a]
inp11, [a]
inp21)
                 in (([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], StepState s a, [a], [a])
forall a a. ([a], StepState s a, [a], [a])
state, Int -> Res
Yld Int
0)
            Partial Int
n s
_ -> (([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], StepState s a, [a], [a])
forall a. (?callStack::CallStack) => a
undefined, Int -> Res
Yld Int
n) -- Not implemented
            Done Int
n a
b ->
                let state :: ([a], StepState s a, [a], [a])
state = (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n [a]
buf1, a -> StepState s a
forall s a. a -> StepState s a
StepResult a
b, [a]
inp11, [a]
inp21)
                 in Bool
-> m (([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
buf1) ((([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], StepState s a, [a], [a])
forall s. ([a], StepState s a, [a], [a])
state, Int -> Res
Stp Int
n))
            -- Continue 0 s -> (buf1, Right s, inp11, inp21)
            Continue Int
n s
s ->
                let ([a]
src0, [a]
buf2) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
buf1
                    src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0
                    state :: ([a], StepState s a, [a], [a])
state = ([a]
buf2, s -> StepState s a
forall s a. s -> StepState s a
StepState s
s, [a]
src [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
inp11, [a]
inp21)
                 in Bool
-> m (([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
buf1) ((([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], StepState s a, [a], [a])
forall a. ([a], StepState s a, [a], [a])
state, Res
Skp))
            Error String
err -> (([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], StepState s a, [a], [a])
forall a. (?callStack::CallStack) => a
undefined, String -> Res
Err String
err)

    -- XXX Even if a parse finished earlier it may not be shortest if the other
    -- parser finishes later but returns a lot of unconsumed input. Our current
    -- criterion of shortest is whichever parse decided to stop earlier.
    {-# INLINE_LATE step #-}
    step :: TeeState s s x a b -> x -> m (Step (TeeState s s x a a) a)
step (TeePair ([x]
bufL, StepState s
sL, [x]
inpL1, [x]
inpL2)
                  ([x]
bufR, StepState s
sR, [x]
inpR1, [x]
inpR2)) x
x = do
        (([x], StepState s a, [x], [x])
l,Res
stL) <- [x]
-> [x]
-> [x]
-> (s -> x -> m (Step s a))
-> s
-> x
-> m (([x], StepState s a, [x], [x]), Res)
forall (m :: * -> *) a t s a.
Monad m =>
[a]
-> [a]
-> [a]
-> (t -> a -> m (Step s a))
-> t
-> a
-> m (([a], StepState s a, [a], [a]), Res)
useStream [x]
bufL [x]
inpL1 [x]
inpL2 s -> x -> m (Step s a)
stepL s
sL x
x
        (([x], StepState s a, [x], [x])
r,Res
stR) <- [x]
-> [x]
-> [x]
-> (s -> x -> m (Step s a))
-> s
-> x
-> m (([x], StepState s a, [x], [x]), Res)
forall (m :: * -> *) a t s a.
Monad m =>
[a]
-> [a]
-> [a]
-> (t -> a -> m (Step s a))
-> t
-> a
-> m (([a], StepState s a, [a], [a]), Res)
useStream [x]
bufR [x]
inpR1 [x]
inpR2 s -> x -> m (Step s a)
stepR s
sR x
x
        let next :: TeeState s s x a a
next = ([x], StepState s a, [x], [x])
-> ([x], StepState s a, [x], [x]) -> TeeState s s x a a
forall sL sR x a b.
([x], StepState sL a, [x], [x])
-> ([x], StepState sR b, [x], [x]) -> TeeState sL sR x a b
TeePair ([x], StepState s a, [x], [x])
l ([x], StepState s a, [x], [x])
r
        Step (TeeState s s x a a) a -> m (Step (TeeState s s x a a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (TeeState s s x a a) a -> m (Step (TeeState s s x a a) a))
-> Step (TeeState s s x a a) a -> m (Step (TeeState s s x a a) a)
forall a b. (a -> b) -> a -> b
$ case (Res
stL,Res
stR) of
            (Stp Int
n1, Res
_) ->
                let ([x]
_, StepResult a
rL, [x]
_, [x]
_) = ([x], StepState s a, [x], [x])
l
                 in Int -> a -> Step (TeeState s s x a a) a
forall s b. Int -> b -> Step s b
Done Int
n1 a
rL
            (Res
_, Stp Int
n2) ->
                let ([x]
_, StepResult a
rR, [x]
_, [x]
_) = ([x], StepState s a, [x], [x])
r
                 in Int -> a -> Step (TeeState s s x a a) a
forall s b. Int -> b -> Step s b
Done Int
n2 a
rR
            (Yld Int
n1, Yld Int
n2) -> Int -> TeeState s s x a a -> Step (TeeState s s x a a) a
forall s b. Int -> s -> Step s b
Partial (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n1 Int
n2) TeeState s s x a a
next
            (Err String
err, Res
_) -> String -> Step (TeeState s s x a a) a
forall s b. String -> Step s b
Error String
err
            (Res
_, Err String
err) -> String -> Step (TeeState s s x a a) a
forall s b. String -> Step s b
Error String
err
            (Res, Res)
_ -> Int -> TeeState s s x a a -> Step (TeeState s s x a a) a
forall s b. Int -> s -> Step s b
Continue Int
0 TeeState s s x a a
next

    step TeeState s s x a b
_ x
_ = m (Step (TeeState s s x a a) a)
forall a. (?callStack::CallStack) => a
undefined

    {-# INLINE_LATE extract #-}
    extract :: TeeState s sR x a b -> m a
extract TeeState s sR x a b
st =
        case TeeState s sR x a b
st of
            TeePair ([x]
_, StepState s
sL, [x]
_, [x]
_) ([x], StepState sR b, [x], [x])
_ -> s -> m a
extractL s
sL
            TeeState s sR x a b
_ -> String -> m a
forall a. (?callStack::CallStack) => String -> a
error String
"unreachable"

-- | See 'Streamly.Internal.Data.Parser.longest'.
--
-- /Broken/
--
{-# INLINE longest #-}
longest :: MonadCatch m => Parser m x a -> Parser m x a -> Parser m x a
longest :: Parser m x a -> Parser m x a -> Parser m x a
longest (Parser s -> x -> m (Step s a)
stepL m (Initial s a)
initialL s -> m a
extractL) (Parser s -> x -> m (Step s a)
stepR m (Initial s a)
initialR s -> m a
extractR) =
    (TeeState s s x a a -> x -> m (Step (TeeState s s x a a) a))
-> m (Initial (TeeState s s x a a) a)
-> (TeeState s s x a a -> m a)
-> Parser m x a
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser TeeState s s x a a -> x -> m (Step (TeeState s s x a a) a)
step m (Initial (TeeState s s x a a) a)
forall x. m (Initial (TeeState s s x a a) a)
initial TeeState s s x a a -> m a
forall x. TeeState s s x a a -> m a
extract

    where


    {-# INLINE_LATE initial #-}
    initial :: m (Initial (TeeState s s x a a) a)
initial = do
        Initial s a
resL <- m (Initial s a)
initialL
        Initial s a
resR <- m (Initial s a)
initialR
        Initial (TeeState s s x a a) a
-> m (Initial (TeeState s s x a a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (TeeState s s x a a) a
 -> m (Initial (TeeState s s x a a) a))
-> Initial (TeeState s s x a a) a
-> m (Initial (TeeState s s x a a) a)
forall a b. (a -> b) -> a -> b
$ case Initial s a
resL of
            IPartial s
sl ->
                case Initial s a
resR of
                     IPartial s
sr -> TeeState s s x a a -> Initial (TeeState s s x a a) a
forall s b. s -> Initial s b
IPartial (TeeState s s x a a -> Initial (TeeState s s x a a) a)
-> TeeState s s x a a -> Initial (TeeState s s x a a) a
forall a b. (a -> b) -> a -> b
$ ([x], StepState s a, [x], [x])
-> ([x], StepState s a, [x], [x]) -> TeeState s s x a a
forall sL sR x a b.
([x], StepState sL a, [x], [x])
-> ([x], StepState sR b, [x], [x]) -> TeeState sL sR x a b
TeePair ([], s -> StepState s a
forall s a. s -> StepState s a
StepState s
sl, [], [])
                                                       ([], s -> StepState s a
forall s a. s -> StepState s a
StepState s
sr, [], [])
                     IDone a
br -> TeeState s s x a a -> Initial (TeeState s s x a a) a
forall s b. s -> Initial s b
IPartial (TeeState s s x a a -> Initial (TeeState s s x a a) a)
-> TeeState s s x a a -> Initial (TeeState s s x a a) a
forall a b. (a -> b) -> a -> b
$ ([x], StepState s a, [x], [x])
-> ([x], StepState s a, [x], [x]) -> TeeState s s x a a
forall sL sR x a b.
([x], StepState sL a, [x], [x])
-> ([x], StepState sR b, [x], [x]) -> TeeState sL sR x a b
TeePair ([], s -> StepState s a
forall s a. s -> StepState s a
StepState s
sl, [], [])
                                                    ([], a -> StepState s a
forall s a. a -> StepState s a
StepResult a
br, [], [])
                     IError String
_ ->
                         TeeState s s x a a -> Initial (TeeState s s x a a) a
forall s b. s -> Initial s b
IPartial (TeeState s s x a a -> Initial (TeeState s s x a a) a)
-> TeeState s s x a a -> Initial (TeeState s s x a a) a
forall a b. (a -> b) -> a -> b
$ ([x], StepState s a, [x], [x])
-> ([x], StepState s a, [x], [x]) -> TeeState s s x a a
forall sL sR x a b.
([x], StepState sL a, [x], [x])
-> ([x], StepState sR b, [x], [x]) -> TeeState sL sR x a b
TeePair ([], s -> StepState s a
forall s a. s -> StepState s a
StepState s
sl, [], [])
                                            ([], a -> StepState s a
forall s a. a -> StepState s a
StepResult a
forall a. (?callStack::CallStack) => a
undefined, [], [])
            IDone a
bl ->
                case Initial s a
resR of
                     IPartial s
sr ->
                         TeeState s s x a a -> Initial (TeeState s s x a a) a
forall s b. s -> Initial s b
IPartial (TeeState s s x a a -> Initial (TeeState s s x a a) a)
-> TeeState s s x a a -> Initial (TeeState s s x a a) a
forall a b. (a -> b) -> a -> b
$ ([x], StepState s a, [x], [x])
-> ([x], StepState s a, [x], [x]) -> TeeState s s x a a
forall sL sR x a b.
([x], StepState sL a, [x], [x])
-> ([x], StepState sR b, [x], [x]) -> TeeState sL sR x a b
TeePair ([], a -> StepState s a
forall s a. a -> StepState s a
StepResult a
bl, [], [])
                                            ([], s -> StepState s a
forall s a. s -> StepState s a
StepState s
sr, [], [])
                     IDone a
_ -> a -> Initial (TeeState s s x a a) a
forall s b. b -> Initial s b
IDone a
bl
                     IError String
_ -> a -> Initial (TeeState s s x a a) a
forall s b. b -> Initial s b
IDone a
bl
            IError String
_ ->
                case Initial s a
resR of
                     IPartial s
sr ->
                         TeeState s s x a a -> Initial (TeeState s s x a a) a
forall s b. s -> Initial s b
IPartial (TeeState s s x a a -> Initial (TeeState s s x a a) a)
-> TeeState s s x a a -> Initial (TeeState s s x a a) a
forall a b. (a -> b) -> a -> b
$ ([x], StepState s a, [x], [x])
-> ([x], StepState s a, [x], [x]) -> TeeState s s x a a
forall sL sR x a b.
([x], StepState sL a, [x], [x])
-> ([x], StepState sR b, [x], [x]) -> TeeState sL sR x a b
TeePair ([], a -> StepState s a
forall s a. a -> StepState s a
StepResult a
forall a. (?callStack::CallStack) => a
undefined, [], [])
                                            ([], s -> StepState s a
forall s a. s -> StepState s a
StepState s
sr, [], [])
                     IDone a
br -> a -> Initial (TeeState s s x a a) a
forall s b. b -> Initial s b
IDone a
br
                     IError String
err -> String -> Initial (TeeState s s x a a) a
forall s b. String -> Initial s b
IError String
err

    {-# INLINE consume #-}
    consume :: [t]
-> [t] -> [t] -> (t -> t -> m b) -> t -> t -> m ([t], b, [t], [t])
consume [t]
buf [t]
inp1 [t]
inp2 t -> t -> m b
stp t
st t
y = do
        let (t
x, [t]
inp11, [t]
inp21) =
                case [t]
inp1 of
                    [] -> (t
y, [], [])
                    z : [] -> (t
z, [t] -> [t]
forall a. [a] -> [a]
reverse (t
xt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
inp2), [])
                    z : zs -> (t
z, [t]
zs, t
xt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
inp2)
        b
r <- t -> t -> m b
stp t
st t
x
        let buf1 :: [t]
buf1 = t
xt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
buf
        ([t], b, [t], [t]) -> m ([t], b, [t], [t])
forall (m :: * -> *) a. Monad m => a -> m a
return ([t]
buf1, b
r, [t]
inp11, [t]
inp21)

    -- consume one input item and return the next state of the fold
    {-# INLINE useStream #-}
    useStream :: [a]
-> [a]
-> [a]
-> (t -> a -> m (Step s a))
-> t
-> a
-> m (([a], StepState s a, [a], [a]), Res)
useStream [a]
buf [a]
inp1 [a]
inp2 t -> a -> m (Step s a)
stp t
st a
y = do
        ([a]
buf1, Step s a
r, [a]
inp11, [a]
inp21) <- [a]
-> [a]
-> [a]
-> (t -> a -> m (Step s a))
-> t
-> a
-> m ([a], Step s a, [a], [a])
forall (m :: * -> *) t t b.
Monad m =>
[t]
-> [t] -> [t] -> (t -> t -> m b) -> t -> t -> m ([t], b, [t], [t])
consume [a]
buf [a]
inp1 [a]
inp2 t -> a -> m (Step s a)
stp t
st a
y
        case Step s a
r of
            Partial Int
0 s
s ->
                let state :: ([a], StepState s a, [a], [a])
state = ([], s -> StepState s a
forall s a. s -> StepState s a
StepState s
s, [a]
inp11, [a]
inp21)
                 in (([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], StepState s a, [a], [a])
forall a a. ([a], StepState s a, [a], [a])
state, Int -> Res
Yld Int
0)
            Partial Int
n s
_ -> (([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], StepState s a, [a], [a])
forall a. (?callStack::CallStack) => a
undefined, Int -> Res
Yld Int
n) -- Not implemented
            Done Int
n a
b ->
                let state :: ([a], StepState s a, [a], [a])
state = (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n [a]
buf1, a -> StepState s a
forall s a. a -> StepState s a
StepResult a
b, [a]
inp11, [a]
inp21)
                 in Bool
-> m (([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
buf1) ((([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], StepState s a, [a], [a])
forall s. ([a], StepState s a, [a], [a])
state, Int -> Res
Stp Int
n))
            -- Continue 0 s -> (buf1, Right s, inp11, inp21)
            Continue Int
n s
s ->
                let ([a]
src0, [a]
buf2) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
buf1
                    src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0
                    state :: ([a], StepState s a, [a], [a])
state = ([a]
buf2, s -> StepState s a
forall s a. s -> StepState s a
StepState s
s, [a]
src [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
inp11, [a]
inp21)
                 in Bool
-> m (([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
buf1) ((([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], StepState s a, [a], [a])
forall a. ([a], StepState s a, [a], [a])
state, Res
Skp))
            Error String
err -> (([a], StepState s a, [a], [a]), Res)
-> m (([a], StepState s a, [a], [a]), Res)
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], StepState s a, [a], [a])
forall a. (?callStack::CallStack) => a
undefined, String -> Res
Err String
err)

    {-# INLINE_LATE step #-}
    step :: TeeState s s x a a -> x -> m (Step (TeeState s s x a a) a)
step (TeePair ([x]
bufL, StepState s
sL, [x]
inpL1, [x]
inpL2)
                  ([x]
bufR, StepState s
sR, [x]
inpR1, [x]
inpR2)) x
x = do
        (([x], StepState s a, [x], [x])
l,Res
stL) <- [x]
-> [x]
-> [x]
-> (s -> x -> m (Step s a))
-> s
-> x
-> m (([x], StepState s a, [x], [x]), Res)
forall (m :: * -> *) a t s a.
Monad m =>
[a]
-> [a]
-> [a]
-> (t -> a -> m (Step s a))
-> t
-> a
-> m (([a], StepState s a, [a], [a]), Res)
useStream [x]
bufL [x]
inpL1 [x]
inpL2 s -> x -> m (Step s a)
stepL s
sL x
x
        (([x], StepState s a, [x], [x])
r,Res
stR) <- [x]
-> [x]
-> [x]
-> (s -> x -> m (Step s a))
-> s
-> x
-> m (([x], StepState s a, [x], [x]), Res)
forall (m :: * -> *) a t s a.
Monad m =>
[a]
-> [a]
-> [a]
-> (t -> a -> m (Step s a))
-> t
-> a
-> m (([a], StepState s a, [a], [a]), Res)
useStream [x]
bufR [x]
inpR1 [x]
inpR2 s -> x -> m (Step s a)
stepR s
sR x
x
        let next :: TeeState s s x a a
next = ([x], StepState s a, [x], [x])
-> ([x], StepState s a, [x], [x]) -> TeeState s s x a a
forall sL sR x a b.
([x], StepState sL a, [x], [x])
-> ([x], StepState sR b, [x], [x]) -> TeeState sL sR x a b
TeePair ([x], StepState s a, [x], [x])
l ([x], StepState s a, [x], [x])
r
        Step (TeeState s s x a a) a -> m (Step (TeeState s s x a a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (TeeState s s x a a) a -> m (Step (TeeState s s x a a) a))
-> Step (TeeState s s x a a) a -> m (Step (TeeState s s x a a) a)
forall a b. (a -> b) -> a -> b
$ case (Res
stL,Res
stR) of
            (Yld Int
n1, Yld Int
n2) -> Int -> TeeState s s x a a -> Step (TeeState s s x a a) a
forall s b. Int -> s -> Step s b
Partial (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n1 Int
n2) TeeState s s x a a
next
            (Yld Int
n1, Stp Int
n2) -> Int -> TeeState s s x a a -> Step (TeeState s s x a a) a
forall s b. Int -> s -> Step s b
Partial (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n1 Int
n2) TeeState s s x a a
next
            (Stp Int
n1, Yld Int
n2) -> Int -> TeeState s s x a a -> Step (TeeState s s x a a) a
forall s b. Int -> s -> Step s b
Partial (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n1 Int
n2) TeeState s s x a a
next
            (Stp Int
n1, Stp Int
n2) ->
                let ([x]
_, StepResult a
rL, [x]
_, [x]
_) = ([x], StepState s a, [x], [x])
l
                    ([x]
_, StepResult a
rR, [x]
_, [x]
_) = ([x], StepState s a, [x], [x])
r
                 in Int -> a -> Step (TeeState s s x a a) a
forall s b. Int -> b -> Step s b
Done (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n1 Int
n2) (if Int
n1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n2 then a
rL else a
rR)
            (Err String
err, Res
_) -> String -> Step (TeeState s s x a a) a
forall s b. String -> Step s b
Error String
err
            (Res
_, Err String
err) -> String -> Step (TeeState s s x a a) a
forall s b. String -> Step s b
Error String
err
            (Res, Res)
_ -> Int -> TeeState s s x a a -> Step (TeeState s s x a a) a
forall s b. Int -> s -> Step s b
Continue Int
0 TeeState s s x a a
next

    -- XXX the parser that finishes last may not be the longest because it may
    -- return a lot of unused input which makes it shorter. Our current
    -- criterion of deciding longest is based on whoever decides to finish
    -- last and not whoever consumed more input.
    --
    -- To actually know who made more progress we need to keep an account of
    -- how many items are unconsumed since the last yield.
    --
    step (TeePair ([x]
bufL, StepState s
sL, [x]
inpL1, [x]
inpL2)
                r :: ([x], StepState s a, [x], [x])
r@([x]
_, StepResult a
_, [x]
_, [x]
_)) x
x = do
        (([x], StepState s a, [x], [x])
l,Res
stL) <- [x]
-> [x]
-> [x]
-> (s -> x -> m (Step s a))
-> s
-> x
-> m (([x], StepState s a, [x], [x]), Res)
forall (m :: * -> *) a t s a.
Monad m =>
[a]
-> [a]
-> [a]
-> (t -> a -> m (Step s a))
-> t
-> a
-> m (([a], StepState s a, [a], [a]), Res)
useStream [x]
bufL [x]
inpL1 [x]
inpL2 s -> x -> m (Step s a)
stepL s
sL x
x
        let next :: TeeState s s x a a
next = ([x], StepState s a, [x], [x])
-> ([x], StepState s a, [x], [x]) -> TeeState s s x a a
forall sL sR x a b.
([x], StepState sL a, [x], [x])
-> ([x], StepState sR b, [x], [x]) -> TeeState sL sR x a b
TeePair ([x], StepState s a, [x], [x])
l ([x], StepState s a, [x], [x])
r
        Step (TeeState s s x a a) a -> m (Step (TeeState s s x a a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (TeeState s s x a a) a -> m (Step (TeeState s s x a a) a))
-> Step (TeeState s s x a a) a -> m (Step (TeeState s s x a a) a)
forall a b. (a -> b) -> a -> b
$ case Res
stL of
            Yld Int
n -> Int -> TeeState s s x a a -> Step (TeeState s s x a a) a
forall s b. Int -> s -> Step s b
Partial Int
n TeeState s s x a a
next
            Stp Int
n ->
                let ([x]
_, StepResult a
rL, [x]
_, [x]
_) = ([x], StepState s a, [x], [x])
l
                 in Int -> a -> Step (TeeState s s x a a) a
forall s b. Int -> b -> Step s b
Done Int
n a
rL
            Res
Skp -> Int -> TeeState s s x a a -> Step (TeeState s s x a a) a
forall s b. Int -> s -> Step s b
Continue Int
0 TeeState s s x a a
next
            Err String
err -> String -> Step (TeeState s s x a a) a
forall s b. String -> Step s b
Error String
err

    step (TeePair l :: ([x], StepState s a, [x], [x])
l@([x]
_, StepResult a
_, [x]
_, [x]
_)
                    ([x]
bufR, StepState s
sR, [x]
inpR1, [x]
inpR2)) x
x = do
        (([x], StepState s a, [x], [x])
r, Res
stR) <- [x]
-> [x]
-> [x]
-> (s -> x -> m (Step s a))
-> s
-> x
-> m (([x], StepState s a, [x], [x]), Res)
forall (m :: * -> *) a t s a.
Monad m =>
[a]
-> [a]
-> [a]
-> (t -> a -> m (Step s a))
-> t
-> a
-> m (([a], StepState s a, [a], [a]), Res)
useStream [x]
bufR [x]
inpR1 [x]
inpR2 s -> x -> m (Step s a)
stepR s
sR x
x
        let next :: TeeState s s x a a
next = ([x], StepState s a, [x], [x])
-> ([x], StepState s a, [x], [x]) -> TeeState s s x a a
forall sL sR x a b.
([x], StepState sL a, [x], [x])
-> ([x], StepState sR b, [x], [x]) -> TeeState sL sR x a b
TeePair ([x], StepState s a, [x], [x])
l ([x], StepState s a, [x], [x])
r
        Step (TeeState s s x a a) a -> m (Step (TeeState s s x a a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (TeeState s s x a a) a -> m (Step (TeeState s s x a a) a))
-> Step (TeeState s s x a a) a -> m (Step (TeeState s s x a a) a)
forall a b. (a -> b) -> a -> b
$ case Res
stR of
            Yld Int
n -> Int -> TeeState s s x a a -> Step (TeeState s s x a a) a
forall s b. Int -> s -> Step s b
Partial Int
n TeeState s s x a a
next
            Stp Int
n ->
                let ([x]
_, StepResult a
rR, [x]
_, [x]
_) = ([x], StepState s a, [x], [x])
r
                 in Int -> a -> Step (TeeState s s x a a) a
forall s b. Int -> b -> Step s b
Done Int
n a
rR
            Res
Skp -> Int -> TeeState s s x a a -> Step (TeeState s s x a a) a
forall s b. Int -> s -> Step s b
Continue Int
0 TeeState s s x a a
next
            Err String
err -> String -> Step (TeeState s s x a a) a
forall s b. String -> Step s b
Error String
err

    step TeeState s s x a a
_ x
_ = m (Step (TeeState s s x a a) a)
forall a. (?callStack::CallStack) => a
undefined

    {-# INLINE_LATE extract #-}
    extract :: TeeState s s x a a -> m a
extract TeeState s s x a a
st =
        -- XXX When results are partial we may not be able to precisely compare
        -- which parser has made more progress till now.  One way to do that is
        -- to figure out the actually consumed input up to the last yield.
        --
        case TeeState s s x a a
st of
            TeePair ([x]
_, StepState s
sL, [x]
_, [x]
_) ([x]
_, StepState s
sR, [x]
_, [x]
_) -> do
                Either ParseError a
r <- m a -> m (Either ParseError a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (m a -> m (Either ParseError a)) -> m a -> m (Either ParseError a)
forall a b. (a -> b) -> a -> b
$ s -> m a
extractL s
sL
                case Either ParseError a
r of
                    Left (ParseError
_ :: ParseError) -> s -> m a
extractR s
sR
                    Right a
b -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
b
            TeePair ([x]
_, StepState s
sL, [x]
_, [x]
_) ([x]
_, StepResult a
rR, [x]
_, [x]
_) -> do
                Either ParseError a
r <- m a -> m (Either ParseError a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (m a -> m (Either ParseError a)) -> m a -> m (Either ParseError a)
forall a b. (a -> b) -> a -> b
$ s -> m a
extractL s
sL
                case Either ParseError a
r of
                    Left (ParseError
_ :: ParseError) -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
rR
                    Right a
b -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
b
            TeePair ([x]
_, StepResult a
rL, [x]
_, [x]
_) ([x]
_, StepState s
sR, [x]
_, [x]
_) -> do
                Either ParseError a
r <- m a -> m (Either ParseError a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (m a -> m (Either ParseError a)) -> m a -> m (Either ParseError a)
forall a b. (a -> b) -> a -> b
$ s -> m a
extractR s
sR
                case Either ParseError a
r of
                    Left (ParseError
_ :: ParseError) -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
rL
                    Right a
b -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
b
            TeePair ([x]
_, StepResult a
_, [x]
_, [x]
_) ([x]
_, StepResult a
_, [x]
_, [x]
_) ->
                String -> m a
forall a. (?callStack::CallStack) => String -> a
error String
"unreachable"