#include "inline.hs"
module Streamly.Internal.Data.Pipe.Type
( Step (..)
, Pipe (..)
, PipeState (..)
, zipWith
, tee
, map
, compose
)
where
import Control.Arrow (Arrow(..))
import Control.Category (Category(..))
import Data.Maybe (isJust)
#if __GLASGOW_HASKELL__ < 808
import Data.Semigroup (Semigroup(..))
#endif
import Prelude hiding (zipWith, map, id, unzip, null)
import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))
import qualified Prelude
data Step s a =
Yield a s
| Continue s
data PipeState s1 s2 = Consume s1 | Produce s2
isProduce :: PipeState s1 s2 -> Bool
isProduce :: forall s1 s2. PipeState s1 s2 -> Bool
isProduce PipeState s1 s2
s =
case PipeState s1 s2
s of
Produce s2
_ -> Bool
True
Consume s1
_ -> Bool
False
data Pipe m a b =
forall s1 s2. Pipe (s1 -> a -> m (Step (PipeState s1 s2) b))
(s2 -> m (Step (PipeState s1 s2) b)) s1
instance Monad m => Functor (Pipe m a) where
{-# INLINE_NORMAL fmap #-}
fmap :: forall a b. (a -> b) -> Pipe m a a -> Pipe m a b
fmap a -> b
f (Pipe s1 -> a -> m (Step (PipeState s1 s2) a)
consume s2 -> m (Step (PipeState s1 s2) a)
produce s1
initial) = forall (m :: * -> *) a b s1 s2.
(s1 -> a -> m (Step (PipeState s1 s2) b))
-> (s2 -> m (Step (PipeState s1 s2) b)) -> s1 -> Pipe m a b
Pipe s1 -> a -> m (Step (PipeState s1 s2) b)
consume' s2 -> m (Step (PipeState s1 s2) b)
produce' s1
initial
where
{-# INLINE_LATE consume' #-}
consume' :: s1 -> a -> m (Step (PipeState s1 s2) b)
consume' s1
st a
a = do
Step (PipeState s1 s2) a
r <- s1 -> a -> m (Step (PipeState s1 s2) a)
consume s1
st a
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step (PipeState s1 s2) a
r of
Yield a
x PipeState s1 s2
s -> forall s a. a -> s -> Step s a
Yield (a -> b
f a
x) PipeState s1 s2
s
Continue PipeState s1 s2
s -> forall s a. s -> Step s a
Continue PipeState s1 s2
s
{-# INLINE_LATE produce' #-}
produce' :: s2 -> m (Step (PipeState s1 s2) b)
produce' s2
st = do
Step (PipeState s1 s2) a
r <- s2 -> m (Step (PipeState s1 s2) a)
produce s2
st
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step (PipeState s1 s2) a
r of
Yield a
x PipeState s1 s2
s -> forall s a. a -> s -> Step s a
Yield (a -> b
f a
x) PipeState s1 s2
s
Continue PipeState s1 s2
s -> forall s a. s -> Step s a
Continue PipeState s1 s2
s
data Deque a = Deque [a] [a]
{-# INLINE null #-}
null :: Deque a -> Bool
null :: forall a. Deque a -> Bool
null (Deque [] []) = Bool
True
null Deque a
_ = Bool
False
{-# INLINE snoc #-}
snoc :: a -> Deque a -> Deque a
snoc :: forall a. a -> Deque a -> Deque a
snoc a
a (Deque [a]
snocList [a]
consList) = forall a. [a] -> [a] -> Deque a
Deque (a
a forall a. a -> [a] -> [a]
: [a]
snocList) [a]
consList
{-# INLINE uncons #-}
uncons :: Deque a -> Maybe (a, Deque a)
uncons :: forall a. Deque a -> Maybe (a, Deque a)
uncons (Deque [a]
snocList [a]
consList) =
case [a]
consList of
a
h : [a]
t -> forall a. a -> Maybe a
Just (a
h, forall a. [a] -> [a] -> Deque a
Deque [a]
snocList [a]
t)
[a]
_ ->
case forall a. [a] -> [a]
Prelude.reverse [a]
snocList of
a
h : [a]
t -> forall a. a -> Maybe a
Just (a
h, forall a. [a] -> [a] -> Deque a
Deque [] [a]
t)
[a]
_ -> forall a. Maybe a
Nothing
{-# INLINE_NORMAL zipWith #-}
zipWith :: Monad m => (a -> b -> c) -> Pipe m i a -> Pipe m i b -> Pipe m i c
zipWith :: forall (m :: * -> *) a b c i.
Monad m =>
(a -> b -> c) -> Pipe m i a -> Pipe m i b -> Pipe m i c
zipWith a -> b -> c
f (Pipe s1 -> i -> m (Step (PipeState s1 s2) a)
consumeL s2 -> m (Step (PipeState s1 s2) a)
produceL s1
stateL) (Pipe s1 -> i -> m (Step (PipeState s1 s2) b)
consumeR s2 -> m (Step (PipeState s1 s2) b)
produceR s1
stateR) =
forall (m :: * -> *) a b s1 s2.
(s1 -> a -> m (Step (PipeState s1 s2) b))
-> (s2 -> m (Step (PipeState s1 s2) b)) -> s1 -> Pipe m a b
Pipe Tuple'
(PipeState s1 s2, Maybe a, Maybe (Deque i))
(PipeState s1 s2, Maybe b, Maybe (Deque i))
-> i
-> m (Step
(PipeState
(Tuple'
(PipeState s1 s2, Maybe a, Maybe (Deque i))
(PipeState s1 s2, Maybe b, Maybe (Deque i)))
(Tuple'
(PipeState s1 s2, Maybe a, Maybe (Deque i))
(PipeState s1 s2, Maybe b, Maybe (Deque i))))
c)
consume Tuple'
(PipeState s1 s2, Maybe a, Maybe (Deque i))
(PipeState s1 s2, Maybe b, Maybe (Deque i))
-> m (Step
(PipeState
(Tuple'
(PipeState s1 s2, Maybe a, Maybe (Deque i))
(PipeState s1 s2, Maybe b, Maybe (Deque i)))
(Tuple'
(PipeState s1 s2, Maybe a, Maybe (Deque i))
(PipeState s1 s2, Maybe b, Maybe (Deque i))))
c)
produce forall {s2} {a} {a} {s2} {a} {a}.
Tuple'
(PipeState s1 s2, Maybe a, Maybe a)
(PipeState s1 s2, Maybe a, Maybe a)
state
where
state :: Tuple'
(PipeState s1 s2, Maybe a, Maybe a)
(PipeState s1 s2, Maybe a, Maybe a)
state = forall a b. a -> b -> Tuple' a b
Tuple' (forall s1 s2. s1 -> PipeState s1 s2
Consume s1
stateL, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall s1 s2. s1 -> PipeState s1 s2
Consume s1
stateR, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
{-# INLINE_LATE consume #-}
consume :: Tuple'
(PipeState s1 s2, Maybe a, Maybe (Deque i))
(PipeState s1 s2, Maybe b, Maybe (Deque i))
-> i
-> m (Step
(PipeState
(Tuple'
(PipeState s1 s2, Maybe a, Maybe (Deque i))
(PipeState s1 s2, Maybe b, Maybe (Deque i)))
(Tuple'
(PipeState s1 s2, Maybe a, Maybe (Deque i))
(PipeState s1 s2, Maybe b, Maybe (Deque i))))
c)
consume (Tuple' (PipeState s1 s2
sL, Maybe a
resL, Maybe (Deque i)
lq) (PipeState s1 s2
sR, Maybe b
resR, Maybe (Deque i)
rq)) i
a = do
(PipeState s1 s2, Maybe a, Maybe (Deque i))
s1 <- forall {m :: * -> *} {t} {t} {a} {t}.
Monad m =>
PipeState t t
-> Maybe a
-> Maybe (Deque t)
-> (t -> t -> m (Step (PipeState t t) a))
-> (t -> m (Step (PipeState t t) a))
-> t
-> m (PipeState t t, Maybe a, Maybe (Deque t))
drive PipeState s1 s2
sL Maybe a
resL Maybe (Deque i)
lq s1 -> i -> m (Step (PipeState s1 s2) a)
consumeL s2 -> m (Step (PipeState s1 s2) a)
produceL i
a
(PipeState s1 s2, Maybe b, Maybe (Deque i))
s2 <- forall {m :: * -> *} {t} {t} {a} {t}.
Monad m =>
PipeState t t
-> Maybe a
-> Maybe (Deque t)
-> (t -> t -> m (Step (PipeState t t) a))
-> (t -> m (Step (PipeState t t) a))
-> t
-> m (PipeState t t, Maybe a, Maybe (Deque t))
drive PipeState s1 s2
sR Maybe b
resR Maybe (Deque i)
rq s1 -> i -> m (Step (PipeState s1 s2) b)
consumeR s2 -> m (Step (PipeState s1 s2) b)
produceR i
a
forall {m :: * -> *} {s1} {s2} {a} {s1} {s2} {a}.
Monad m =>
(PipeState s1 s2, Maybe a, Maybe a)
-> (PipeState s1 s2, Maybe b, Maybe a)
-> m (Step
(PipeState
(Tuple'
(PipeState s1 s2, Maybe a, Maybe a)
(PipeState s1 s2, Maybe b, Maybe a))
(Tuple'
(PipeState s1 s2, Maybe a, Maybe a)
(PipeState s1 s2, Maybe b, Maybe a)))
c)
yieldOutput (PipeState s1 s2, Maybe a, Maybe (Deque i))
s1 (PipeState s1 s2, Maybe b, Maybe (Deque i))
s2
where
{-# INLINE drive #-}
drive :: PipeState t t
-> Maybe a
-> Maybe (Deque t)
-> (t -> t -> m (Step (PipeState t t) a))
-> (t -> m (Step (PipeState t t) a))
-> t
-> m (PipeState t t, Maybe a, Maybe (Deque t))
drive PipeState t t
st Maybe a
res Maybe (Deque t)
queue t -> t -> m (Step (PipeState t t) a)
fConsume t -> m (Step (PipeState t t) a)
fProduce t
val =
case Maybe a
res of
Maybe a
Nothing -> forall {m :: * -> *} {t} {t} {t} {a} {a}.
Monad m =>
PipeState t t
-> Maybe (Deque t)
-> t
-> (t -> t -> m (Step a a))
-> (t -> m (Step a a))
-> m (a, Maybe a, Maybe (Deque t))
goConsume PipeState t t
st Maybe (Deque t)
queue t
val t -> t -> m (Step (PipeState t t) a)
fConsume t -> m (Step (PipeState t t) a)
fProduce
Just a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
case Maybe (Deque t)
queue of
Maybe (Deque t)
Nothing -> (PipeState t t
st, forall a. a -> Maybe a
Just a
x, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a] -> Deque a
Deque [t
val] [])
Just Deque t
q -> (PipeState t t
st, forall a. a -> Maybe a
Just a
x, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Deque a -> Deque a
snoc t
val Deque t
q)
{-# INLINE goConsume #-}
goConsume :: PipeState t t
-> Maybe (Deque t)
-> t
-> (t -> t -> m (Step a a))
-> (t -> m (Step a a))
-> m (a, Maybe a, Maybe (Deque t))
goConsume PipeState t t
stt Maybe (Deque t)
queue t
val t -> t -> m (Step a a)
fConsume t -> m (Step a a)
stp2 =
case PipeState t t
stt of
Consume t
st ->
case Maybe (Deque t)
queue of
Maybe (Deque t)
Nothing -> do
Step a a
r <- t -> t -> m (Step a a)
fConsume t
st t
val
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step a a
r of
Yield a
x a
s -> (a
s, forall a. a -> Maybe a
Just a
x, forall a. Maybe a
Nothing)
Continue a
s -> (a
s, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
Just Deque t
queue' ->
case forall a. Deque a -> Maybe (a, Deque a)
uncons Deque t
queue' of
Just (t
v, Deque t
q) -> do
Step a a
r <- t -> t -> m (Step a a)
fConsume t
st t
v
let q' :: Deque t
q' = forall a. a -> Deque a -> Deque a
snoc t
val Deque t
q
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step a a
r of
Yield a
x a
s -> (a
s, forall a. a -> Maybe a
Just a
x, forall a. a -> Maybe a
Just Deque t
q')
Continue a
s -> (a
s, forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just Deque t
q')
Maybe (t, Deque t)
Nothing -> forall a. HasCallStack => a
undefined
Produce t
st -> do
Step a a
r <- t -> m (Step a a)
stp2 t
st
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step a a
r of
Yield a
x a
s -> (a
s, forall a. a -> Maybe a
Just a
x, Maybe (Deque t)
queue)
Continue a
s -> (a
s, forall a. Maybe a
Nothing, Maybe (Deque t)
queue)
{-# INLINE_LATE produce #-}
produce :: Tuple'
(PipeState s1 s2, Maybe a, Maybe (Deque i))
(PipeState s1 s2, Maybe b, Maybe (Deque i))
-> m (Step
(PipeState
(Tuple'
(PipeState s1 s2, Maybe a, Maybe (Deque i))
(PipeState s1 s2, Maybe b, Maybe (Deque i)))
(Tuple'
(PipeState s1 s2, Maybe a, Maybe (Deque i))
(PipeState s1 s2, Maybe b, Maybe (Deque i))))
c)
produce (Tuple' (PipeState s1 s2
sL, Maybe a
resL, Maybe (Deque i)
lq) (PipeState s1 s2
sR, Maybe b
resR, Maybe (Deque i)
rq)) = do
(PipeState s1 s2, Maybe a, Maybe (Deque i))
s1 <- forall {m :: * -> *} {t} {t} {a} {t}.
Monad m =>
PipeState t t
-> Maybe a
-> Maybe (Deque t)
-> (t -> t -> m (Step (PipeState t t) a))
-> (t -> m (Step (PipeState t t) a))
-> m (PipeState t t, Maybe a, Maybe (Deque t))
drive PipeState s1 s2
sL Maybe a
resL Maybe (Deque i)
lq s1 -> i -> m (Step (PipeState s1 s2) a)
consumeL s2 -> m (Step (PipeState s1 s2) a)
produceL
(PipeState s1 s2, Maybe b, Maybe (Deque i))
s2 <- forall {m :: * -> *} {t} {t} {a} {t}.
Monad m =>
PipeState t t
-> Maybe a
-> Maybe (Deque t)
-> (t -> t -> m (Step (PipeState t t) a))
-> (t -> m (Step (PipeState t t) a))
-> m (PipeState t t, Maybe a, Maybe (Deque t))
drive PipeState s1 s2
sR Maybe b
resR Maybe (Deque i)
rq s1 -> i -> m (Step (PipeState s1 s2) b)
consumeR s2 -> m (Step (PipeState s1 s2) b)
produceR
forall {m :: * -> *} {s1} {s2} {a} {s1} {s2} {a}.
Monad m =>
(PipeState s1 s2, Maybe a, Maybe a)
-> (PipeState s1 s2, Maybe b, Maybe a)
-> m (Step
(PipeState
(Tuple'
(PipeState s1 s2, Maybe a, Maybe a)
(PipeState s1 s2, Maybe b, Maybe a))
(Tuple'
(PipeState s1 s2, Maybe a, Maybe a)
(PipeState s1 s2, Maybe b, Maybe a)))
c)
yieldOutput (PipeState s1 s2, Maybe a, Maybe (Deque i))
s1 (PipeState s1 s2, Maybe b, Maybe (Deque i))
s2
where
{-# INLINE drive #-}
drive :: PipeState t t
-> Maybe a
-> Maybe (Deque t)
-> (t -> t -> m (Step (PipeState t t) a))
-> (t -> m (Step (PipeState t t) a))
-> m (PipeState t t, Maybe a, Maybe (Deque t))
drive PipeState t t
stt Maybe a
res Maybe (Deque t)
q t -> t -> m (Step (PipeState t t) a)
fConsume t -> m (Step (PipeState t t) a)
fProduce =
case Maybe a
res of
Maybe a
Nothing -> forall {m :: * -> *} {t} {t} {t} {a}.
Monad m =>
PipeState t t
-> Maybe (Deque t)
-> (t -> t -> m (Step (PipeState t t) a))
-> (t -> m (Step (PipeState t t) a))
-> m (PipeState t t, Maybe a, Maybe (Deque t))
goProduce PipeState t t
stt Maybe (Deque t)
q t -> t -> m (Step (PipeState t t) a)
fConsume t -> m (Step (PipeState t t) a)
fProduce
Just a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (PipeState t t
stt, forall a. a -> Maybe a
Just a
x, Maybe (Deque t)
q)
{-# INLINE goProduce #-}
goProduce :: PipeState t t
-> Maybe (Deque t)
-> (t -> t -> m (Step (PipeState t t) a))
-> (t -> m (Step (PipeState t t) a))
-> m (PipeState t t, Maybe a, Maybe (Deque t))
goProduce PipeState t t
stt Maybe (Deque t)
queue t -> t -> m (Step (PipeState t t) a)
fConsume t -> m (Step (PipeState t t) a)
fProduce =
case PipeState t t
stt of
Consume t
st ->
case Maybe (Deque t)
queue of
Maybe (Deque t)
Nothing -> forall a. HasCallStack => a
undefined
Just Deque t
queue' ->
case forall a. Deque a -> Maybe (a, Deque a)
uncons Deque t
queue' of
Just (t
v, Deque t
q) -> do
Step (PipeState t t) a
r <- t -> t -> m (Step (PipeState t t) a)
fConsume t
st t
v
let q' :: Maybe (Deque t)
q' = if forall a. Deque a -> Bool
null Deque t
q
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just Deque t
q
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step (PipeState t t) a
r of
Yield a
x PipeState t t
s -> (PipeState t t
s, forall a. a -> Maybe a
Just a
x, Maybe (Deque t)
q')
Continue PipeState t t
s -> (PipeState t t
s, forall a. Maybe a
Nothing, Maybe (Deque t)
q')
Maybe (t, Deque t)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (PipeState t t
stt, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
Produce t
st -> do
Step (PipeState t t) a
r <- t -> m (Step (PipeState t t) a)
fProduce t
st
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step (PipeState t t) a
r of
Yield a
x PipeState t t
s -> (PipeState t t
s, forall a. a -> Maybe a
Just a
x, Maybe (Deque t)
queue)
Continue PipeState t t
s -> (PipeState t t
s, forall a. Maybe a
Nothing, Maybe (Deque t)
queue)
{-# INLINE yieldOutput #-}
yieldOutput :: (PipeState s1 s2, Maybe a, Maybe a)
-> (PipeState s1 s2, Maybe b, Maybe a)
-> m (Step
(PipeState
(Tuple'
(PipeState s1 s2, Maybe a, Maybe a)
(PipeState s1 s2, Maybe b, Maybe a))
(Tuple'
(PipeState s1 s2, Maybe a, Maybe a)
(PipeState s1 s2, Maybe b, Maybe a)))
c)
yieldOutput s1 :: (PipeState s1 s2, Maybe a, Maybe a)
s1@(PipeState s1 s2
sL', Maybe a
resL', Maybe a
lq') s2 :: (PipeState s1 s2, Maybe b, Maybe a)
s2@(PipeState s1 s2
sR', Maybe b
resR', Maybe a
rq') = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
if (forall s1 s2. PipeState s1 s2 -> Bool
isProduce PipeState s1 s2
sL' Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe a
lq') Bool -> Bool -> Bool
&& (forall s1 s2. PipeState s1 s2 -> Bool
isProduce PipeState s1 s2
sR' Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe a
rq')
then
case (Maybe a
resL', Maybe b
resR') of
(Just a
xL, Just b
xR) ->
forall s a. a -> s -> Step s a
Yield (a -> b -> c
f a
xL b
xR) (forall s1 s2. s2 -> PipeState s1 s2
Produce (forall a b. a -> b -> Tuple' a b
Tuple' (forall {a} {b} {c} {a}. (a, b, c) -> (a, Maybe a, c)
clear (PipeState s1 s2, Maybe a, Maybe a)
s1) (forall {a} {b} {c} {a}. (a, b, c) -> (a, Maybe a, c)
clear (PipeState s1 s2, Maybe b, Maybe a)
s2)))
(Maybe a, Maybe b)
_ -> forall s a. s -> Step s a
Continue (forall s1 s2. s2 -> PipeState s1 s2
Produce (forall a b. a -> b -> Tuple' a b
Tuple' (PipeState s1 s2, Maybe a, Maybe a)
s1 (PipeState s1 s2, Maybe b, Maybe a)
s2))
else
case (Maybe a
resL', Maybe b
resR') of
(Just a
xL, Just b
xR) ->
forall s a. a -> s -> Step s a
Yield (a -> b -> c
f a
xL b
xR) (forall s1 s2. s1 -> PipeState s1 s2
Consume (forall a b. a -> b -> Tuple' a b
Tuple' (forall {a} {b} {c} {a}. (a, b, c) -> (a, Maybe a, c)
clear (PipeState s1 s2, Maybe a, Maybe a)
s1) (forall {a} {b} {c} {a}. (a, b, c) -> (a, Maybe a, c)
clear (PipeState s1 s2, Maybe b, Maybe a)
s2)))
(Maybe a, Maybe b)
_ -> forall s a. s -> Step s a
Continue (forall s1 s2. s1 -> PipeState s1 s2
Consume (forall a b. a -> b -> Tuple' a b
Tuple' (PipeState s1 s2, Maybe a, Maybe a)
s1 (PipeState s1 s2, Maybe b, Maybe a)
s2))
where clear :: (a, b, c) -> (a, Maybe a, c)
clear (a
s, b
_, c
q) = (a
s, forall a. Maybe a
Nothing, c
q)
instance Monad m => Applicative (Pipe m a) where
{-# INLINE pure #-}
pure :: forall a. a -> Pipe m a a
pure a
b = forall (m :: * -> *) a b s1 s2.
(s1 -> a -> m (Step (PipeState s1 s2) b))
-> (s2 -> m (Step (PipeState s1 s2) b)) -> s1 -> Pipe m a b
Pipe (\()
_ a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall s a. a -> s -> Step s a
Yield a
b (forall s1 s2. s1 -> PipeState s1 s2
Consume ())) forall a. HasCallStack => a
undefined ()
<*> :: forall a b. Pipe m a (a -> b) -> Pipe m a a -> Pipe m a b
(<*>) = forall (m :: * -> *) a b c i.
Monad m =>
(a -> b -> c) -> Pipe m i a -> Pipe m i b -> Pipe m i c
zipWith forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
{-# INLINE_NORMAL tee #-}
tee :: Monad m => Pipe m a b -> Pipe m a b -> Pipe m a b
tee :: forall (m :: * -> *) a b.
Monad m =>
Pipe m a b -> Pipe m a b -> Pipe m a b
tee (Pipe s1 -> a -> m (Step (PipeState s1 s2) b)
consumeL s2 -> m (Step (PipeState s1 s2) b)
produceL s1
stateL) (Pipe s1 -> a -> m (Step (PipeState s1 s2) b)
consumeR s2 -> m (Step (PipeState s1 s2) b)
produceR s1
stateR) =
forall (m :: * -> *) a b s1 s2.
(s1 -> a -> m (Step (PipeState s1 s2) b))
-> (s2 -> m (Step (PipeState s1 s2) b)) -> s1 -> Pipe m a b
Pipe forall {s2} {c} {s1}.
Tuple' (PipeState s1 s2) c
-> a
-> m (Step
(PipeState s1 (Tuple3' (Maybe a) (PipeState s1 s2) c)) b)
consume Tuple3' (Maybe a) (PipeState s1 s2) (PipeState s1 s2)
-> m (Step
(PipeState
(Tuple' (PipeState s1 s2) (PipeState s1 s2))
(Tuple3' (Maybe a) (PipeState s1 s2) (PipeState s1 s2)))
b)
produce forall {s2} {s2}. Tuple' (PipeState s1 s2) (PipeState s1 s2)
state
where
state :: Tuple' (PipeState s1 s2) (PipeState s1 s2)
state = forall a b. a -> b -> Tuple' a b
Tuple' (forall s1 s2. s1 -> PipeState s1 s2
Consume s1
stateL) (forall s1 s2. s1 -> PipeState s1 s2
Consume s1
stateR)
consume :: Tuple' (PipeState s1 s2) c
-> a
-> m (Step
(PipeState s1 (Tuple3' (Maybe a) (PipeState s1 s2) c)) b)
consume (Tuple' PipeState s1 s2
sL c
sR) a
a =
case PipeState s1 s2
sL of
Consume s1
st -> do
Step (PipeState s1 s2) b
r <- s1 -> a -> m (Step (PipeState s1 s2) b)
consumeL s1
st a
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step (PipeState s1 s2) b
r of
Yield b
x PipeState s1 s2
s -> forall s a. a -> s -> Step s a
Yield b
x (forall s1 s2. s2 -> PipeState s1 s2
Produce (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' (forall a. a -> Maybe a
Just a
a) PipeState s1 s2
s c
sR))
Continue PipeState s1 s2
s -> forall s a. s -> Step s a
Continue (forall s1 s2. s2 -> PipeState s1 s2
Produce (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' (forall a. a -> Maybe a
Just a
a) PipeState s1 s2
s c
sR))
Produce s2
_st -> forall a. HasCallStack => a
undefined
produce :: Tuple3' (Maybe a) (PipeState s1 s2) (PipeState s1 s2)
-> m (Step
(PipeState
(Tuple' (PipeState s1 s2) (PipeState s1 s2))
(Tuple3' (Maybe a) (PipeState s1 s2) (PipeState s1 s2)))
b)
produce (Tuple3' (Just a
a) PipeState s1 s2
sL PipeState s1 s2
sR) =
case PipeState s1 s2
sL of
Consume s1
_ ->
case PipeState s1 s2
sR of
Consume s1
st -> do
Step (PipeState s1 s2) b
r <- s1 -> a -> m (Step (PipeState s1 s2) b)
consumeR s1
st a
a
let nextL :: b -> PipeState (Tuple' (PipeState s1 s2) b) s2
nextL b
s = forall s1 s2. s1 -> PipeState s1 s2
Consume (forall a b. a -> b -> Tuple' a b
Tuple' PipeState s1 s2
sL b
s)
let nextR :: c -> PipeState s1 (Tuple3' (Maybe a) (PipeState s1 s2) c)
nextR c
s = forall s1 s2. s2 -> PipeState s1 s2
Produce (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' forall a. Maybe a
Nothing PipeState s1 s2
sL c
s)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step (PipeState s1 s2) b
r of
Yield b
x s :: PipeState s1 s2
s@(Consume s1
_) -> forall s a. a -> s -> Step s a
Yield b
x (forall {b} {s2}. b -> PipeState (Tuple' (PipeState s1 s2) b) s2
nextL PipeState s1 s2
s)
Yield b
x s :: PipeState s1 s2
s@(Produce s2
_) -> forall s a. a -> s -> Step s a
Yield b
x (forall {c} {s1} {a}.
c -> PipeState s1 (Tuple3' (Maybe a) (PipeState s1 s2) c)
nextR PipeState s1 s2
s)
Continue s :: PipeState s1 s2
s@(Consume s1
_) -> forall s a. s -> Step s a
Continue (forall {b} {s2}. b -> PipeState (Tuple' (PipeState s1 s2) b) s2
nextL PipeState s1 s2
s)
Continue s :: PipeState s1 s2
s@(Produce s2
_) -> forall s a. s -> Step s a
Continue (forall {c} {s1} {a}.
c -> PipeState s1 (Tuple3' (Maybe a) (PipeState s1 s2) c)
nextR PipeState s1 s2
s)
Produce s2
_ -> forall a. HasCallStack => a
undefined
Produce s2
st -> do
Step (PipeState s1 s2) b
r <- s2 -> m (Step (PipeState s1 s2) b)
produceL s2
st
let next :: b -> PipeState s1 (Tuple3' (Maybe a) b (PipeState s1 s2))
next b
s = forall s1 s2. s2 -> PipeState s1 s2
Produce (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' (forall a. a -> Maybe a
Just a
a) b
s PipeState s1 s2
sR)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step (PipeState s1 s2) b
r of
Yield b
x PipeState s1 s2
s -> forall s a. a -> s -> Step s a
Yield b
x (forall {b} {s1}.
b -> PipeState s1 (Tuple3' (Maybe a) b (PipeState s1 s2))
next PipeState s1 s2
s)
Continue PipeState s1 s2
s -> forall s a. s -> Step s a
Continue (forall {b} {s1}.
b -> PipeState s1 (Tuple3' (Maybe a) b (PipeState s1 s2))
next PipeState s1 s2
s)
produce (Tuple3' Maybe a
Nothing PipeState s1 s2
sL PipeState s1 s2
sR) =
case PipeState s1 s2
sR of
Consume s1
_ -> forall a. HasCallStack => a
undefined
Produce s2
st -> do
Step (PipeState s1 s2) b
r <- s2 -> m (Step (PipeState s1 s2) b)
produceR s2
st
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step (PipeState s1 s2) b
r of
Yield b
x s :: PipeState s1 s2
s@(Consume s1
_) ->
forall s a. a -> s -> Step s a
Yield b
x (forall s1 s2. s1 -> PipeState s1 s2
Consume (forall a b. a -> b -> Tuple' a b
Tuple' PipeState s1 s2
sL PipeState s1 s2
s))
Yield b
x s :: PipeState s1 s2
s@(Produce s2
_) ->
forall s a. a -> s -> Step s a
Yield b
x (forall s1 s2. s2 -> PipeState s1 s2
Produce (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' forall a. Maybe a
Nothing PipeState s1 s2
sL PipeState s1 s2
s))
Continue s :: PipeState s1 s2
s@(Consume s1
_) ->
forall s a. s -> Step s a
Continue (forall s1 s2. s1 -> PipeState s1 s2
Consume (forall a b. a -> b -> Tuple' a b
Tuple' PipeState s1 s2
sL PipeState s1 s2
s))
Continue s :: PipeState s1 s2
s@(Produce s2
_) ->
forall s a. s -> Step s a
Continue (forall s1 s2. s2 -> PipeState s1 s2
Produce (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' forall a. Maybe a
Nothing PipeState s1 s2
sL PipeState s1 s2
s))
instance Monad m => Semigroup (Pipe m a b) where
{-# INLINE (<>) #-}
<> :: Pipe m a b -> Pipe m a b -> Pipe m a b
(<>) = forall (m :: * -> *) a b.
Monad m =>
Pipe m a b -> Pipe m a b -> Pipe m a b
tee
{-# INLINE map #-}
map :: Monad m => (a -> b) -> Pipe m a b
map :: forall (m :: * -> *) a b. Monad m => (a -> b) -> Pipe m a b
map a -> b
f = forall (m :: * -> *) a b s1 s2.
(s1 -> a -> m (Step (PipeState s1 s2) b))
-> (s2 -> m (Step (PipeState s1 s2) b)) -> s1 -> Pipe m a b
Pipe forall {m :: * -> *} {p} {s2}.
Monad m =>
p -> a -> m (Step (PipeState () s2) b)
consume forall a. HasCallStack => a
undefined ()
where
consume :: p -> a -> m (Step (PipeState () s2) b)
consume p
_ a
a = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. a -> s -> Step s a
Yield (a -> b
f a
a) (forall s1 s2. s1 -> PipeState s1 s2
Consume ())
{-# INLINE_NORMAL compose #-}
compose :: Monad m => Pipe m b c -> Pipe m a b -> Pipe m a c
compose :: forall (m :: * -> *) b c a.
Monad m =>
Pipe m b c -> Pipe m a b -> Pipe m a c
compose (Pipe s1 -> b -> m (Step (PipeState s1 s2) c)
consumeL s2 -> m (Step (PipeState s1 s2) c)
produceL s1
stateL) (Pipe s1 -> a -> m (Step (PipeState s1 s2) b)
consumeR s2 -> m (Step (PipeState s1 s2) b)
produceR s1
stateR) =
forall (m :: * -> *) a b s1 s2.
(s1 -> a -> m (Step (PipeState s1 s2) b))
-> (s2 -> m (Step (PipeState s1 s2) b)) -> s1 -> Pipe m a b
Pipe forall {s2}.
Tuple' (PipeState s1 s2) (PipeState s1 s2)
-> a
-> m (Step
(PipeState
(Tuple' (PipeState s1 s2) (PipeState s1 s2))
(Tuple' (PipeState s1 s2) (PipeState s1 s2)))
c)
consume Tuple' (PipeState s1 s2) (PipeState s1 s2)
-> m (Step
(PipeState
(Tuple' (PipeState s1 s2) (PipeState s1 s2))
(Tuple' (PipeState s1 s2) (PipeState s1 s2)))
c)
produce forall {s2} {s2}. Tuple' (PipeState s1 s2) (PipeState s1 s2)
state
where
state :: Tuple' (PipeState s1 s2) (PipeState s1 s2)
state = forall a b. a -> b -> Tuple' a b
Tuple' (forall s1 s2. s1 -> PipeState s1 s2
Consume s1
stateL) (forall s1 s2. s1 -> PipeState s1 s2
Consume s1
stateR)
consume :: Tuple' (PipeState s1 s2) (PipeState s1 s2)
-> a
-> m (Step
(PipeState
(Tuple' (PipeState s1 s2) (PipeState s1 s2))
(Tuple' (PipeState s1 s2) (PipeState s1 s2)))
c)
consume (Tuple' PipeState s1 s2
sL PipeState s1 s2
sR) a
a =
case PipeState s1 s2
sL of
Consume s1
stt ->
case PipeState s1 s2
sR of
Consume s1
st -> do
Step (PipeState s1 s2) b
rres <- s1 -> a -> m (Step (PipeState s1 s2) b)
consumeR s1
st a
a
case Step (PipeState s1 s2) b
rres of
Yield b
x PipeState s1 s2
sR' -> do
let next :: s1 -> PipeState s1 s1
next s1
s =
if forall s1 s2. PipeState s1 s2 -> Bool
isProduce PipeState s1 s2
sR'
then forall s1 s2. s2 -> PipeState s1 s2
Produce s1
s
else forall s1 s2. s1 -> PipeState s1 s2
Consume s1
s
Step (PipeState s1 s2) c
lres <- s1 -> b -> m (Step (PipeState s1 s2) c)
consumeL s1
stt b
x
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step (PipeState s1 s2) c
lres of
Yield c
y s1 :: PipeState s1 s2
s1@(Consume s1
_) ->
forall s a. a -> s -> Step s a
Yield c
y (forall {s1}. s1 -> PipeState s1 s1
next forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' PipeState s1 s2
s1 PipeState s1 s2
sR')
Yield c
y s1 :: PipeState s1 s2
s1@(Produce s2
_) ->
forall s a. a -> s -> Step s a
Yield c
y (forall s1 s2. s2 -> PipeState s1 s2
Produce forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' PipeState s1 s2
s1 PipeState s1 s2
sR')
Continue s1 :: PipeState s1 s2
s1@(Consume s1
_) ->
forall s a. s -> Step s a
Continue (forall {s1}. s1 -> PipeState s1 s1
next forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' PipeState s1 s2
s1 PipeState s1 s2
sR')
Continue s1 :: PipeState s1 s2
s1@(Produce s2
_) ->
forall s a. s -> Step s a
Continue (forall s1 s2. s2 -> PipeState s1 s2
Produce forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' PipeState s1 s2
s1 PipeState s1 s2
sR')
Continue s1 :: PipeState s1 s2
s1@(Consume s1
_) ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. s -> Step s a
Continue (forall s1 s2. s1 -> PipeState s1 s2
Consume forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' PipeState s1 s2
sL PipeState s1 s2
s1)
Continue s1 :: PipeState s1 s2
s1@(Produce s2
_) ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. s -> Step s a
Continue (forall s1 s2. s2 -> PipeState s1 s2
Produce forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' PipeState s1 s2
sL PipeState s1 s2
s1)
Produce s2
_ -> forall a. HasCallStack => a
undefined
Produce s2
_ -> forall a. HasCallStack => a
undefined
produce :: Tuple' (PipeState s1 s2) (PipeState s1 s2)
-> m (Step
(PipeState
(Tuple' (PipeState s1 s2) (PipeState s1 s2))
(Tuple' (PipeState s1 s2) (PipeState s1 s2)))
c)
produce (Tuple' PipeState s1 s2
sL PipeState s1 s2
sR) =
case PipeState s1 s2
sL of
Produce s2
st -> do
Step (PipeState s1 s2) c
r <- s2 -> m (Step (PipeState s1 s2) c)
produceL s2
st
let next :: s1 -> PipeState s1 s1
next s1
s = if forall s1 s2. PipeState s1 s2 -> Bool
isProduce PipeState s1 s2
sR then forall s1 s2. s2 -> PipeState s1 s2
Produce s1
s else forall s1 s2. s1 -> PipeState s1 s2
Consume s1
s
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step (PipeState s1 s2) c
r of
Yield c
x s :: PipeState s1 s2
s@(Consume s1
_) -> forall s a. a -> s -> Step s a
Yield c
x (forall {s1}. s1 -> PipeState s1 s1
next forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' PipeState s1 s2
s PipeState s1 s2
sR)
Yield c
x s :: PipeState s1 s2
s@(Produce s2
_) -> forall s a. a -> s -> Step s a
Yield c
x (forall s1 s2. s2 -> PipeState s1 s2
Produce forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' PipeState s1 s2
s PipeState s1 s2
sR)
Continue s :: PipeState s1 s2
s@(Consume s1
_) -> forall s a. s -> Step s a
Continue (forall {s1}. s1 -> PipeState s1 s1
next forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' PipeState s1 s2
s PipeState s1 s2
sR)
Continue s :: PipeState s1 s2
s@(Produce s2
_) -> forall s a. s -> Step s a
Continue (forall s1 s2. s2 -> PipeState s1 s2
Produce forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' PipeState s1 s2
s PipeState s1 s2
sR)
Consume s1
stt ->
case PipeState s1 s2
sR of
Produce s2
st -> do
Step (PipeState s1 s2) b
rR <- s2 -> m (Step (PipeState s1 s2) b)
produceR s2
st
case Step (PipeState s1 s2) b
rR of
Yield b
x PipeState s1 s2
sR' -> do
let next :: s1 -> PipeState s1 s1
next s1
s =
if forall s1 s2. PipeState s1 s2 -> Bool
isProduce PipeState s1 s2
sR'
then forall s1 s2. s2 -> PipeState s1 s2
Produce s1
s
else forall s1 s2. s1 -> PipeState s1 s2
Consume s1
s
Step (PipeState s1 s2) c
rL <- s1 -> b -> m (Step (PipeState s1 s2) c)
consumeL s1
stt b
x
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step (PipeState s1 s2) c
rL of
Yield c
y s1 :: PipeState s1 s2
s1@(Consume s1
_) ->
forall s a. a -> s -> Step s a
Yield c
y (forall {s1}. s1 -> PipeState s1 s1
next forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' PipeState s1 s2
s1 PipeState s1 s2
sR')
Yield c
y s1 :: PipeState s1 s2
s1@(Produce s2
_) ->
forall s a. a -> s -> Step s a
Yield c
y (forall s1 s2. s2 -> PipeState s1 s2
Produce forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' PipeState s1 s2
s1 PipeState s1 s2
sR')
Continue s1 :: PipeState s1 s2
s1@(Consume s1
_) ->
forall s a. s -> Step s a
Continue (forall {s1}. s1 -> PipeState s1 s1
next forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' PipeState s1 s2
s1 PipeState s1 s2
sR')
Continue s1 :: PipeState s1 s2
s1@(Produce s2
_) ->
forall s a. s -> Step s a
Continue (forall s1 s2. s2 -> PipeState s1 s2
Produce forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' PipeState s1 s2
s1 PipeState s1 s2
sR')
Continue s1 :: PipeState s1 s2
s1@(Consume s1
_) ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. s -> Step s a
Continue (forall s1 s2. s1 -> PipeState s1 s2
Consume forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' PipeState s1 s2
sL PipeState s1 s2
s1)
Continue s1 :: PipeState s1 s2
s1@(Produce s2
_) ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. s -> Step s a
Continue (forall s1 s2. s2 -> PipeState s1 s2
Produce forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' PipeState s1 s2
sL PipeState s1 s2
s1)
Consume s1
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. s -> Step s a
Continue (forall s1 s2. s1 -> PipeState s1 s2
Consume forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' PipeState s1 s2
sL PipeState s1 s2
sR)
instance Monad m => Category (Pipe m) where
{-# INLINE id #-}
id :: forall a. Pipe m a a
id = forall (m :: * -> *) a b. Monad m => (a -> b) -> Pipe m a b
map forall a. a -> a
Prelude.id
{-# INLINE (.) #-}
. :: forall b c a. Pipe m b c -> Pipe m a b -> Pipe m a c
(.) = forall (m :: * -> *) b c a.
Monad m =>
Pipe m b c -> Pipe m a b -> Pipe m a c
compose
unzip :: Pipe m a x -> Pipe m b y -> Pipe m (a, b) (x, y)
unzip :: forall (m :: * -> *) a x b y.
Pipe m a x -> Pipe m b y -> Pipe m (a, b) (x, y)
unzip = forall a. HasCallStack => a
undefined
instance Monad m => Arrow (Pipe m) where
{-# INLINE arr #-}
arr :: forall b c. (b -> c) -> Pipe m b c
arr = forall (m :: * -> *) a b. Monad m => (a -> b) -> Pipe m a b
map
{-# INLINE (***) #-}
*** :: forall b c b' c'.
Pipe m b c -> Pipe m b' c' -> Pipe m (b, b') (c, c')
(***) = forall (m :: * -> *) a x b y.
Pipe m a x -> Pipe m b y -> Pipe m (a, b) (x, y)
unzip
{-# INLINE (&&&) #-}
&&& :: forall b c c'. Pipe m b c -> Pipe m b c' -> Pipe m b (c, c')
(&&&) = forall (m :: * -> *) a b c i.
Monad m =>
(a -> b -> c) -> Pipe m i a -> Pipe m i b -> Pipe m i c
zipWith (,)