- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
- 33
- 34
- 35
- 36
- 37
- 38
- 39
- 40
- 41
- 42
- 43
- 44
- 45
- 46
- 47
data IdPState a r = IdPEnd r | IdPNeedInput | IdPHaveInput a
{-# INLINE_STREAM idP #-}
idP :: (Monad m) => Stream l a a r m r
idP = Stream next IdPNeedInput where
{-# INLINE_INNER next #-}
next (IdPEnd r) = Done r
next IdPNeedInput = NeedInput IdPHaveInput IdPEnd
next (IdPHaveInput a) = HaveOutput IdPNeedInput (return ()) a
{-# INLINE_STREAM pipe #-}
pipe :: Monad m => Stream l a b r0 m r1 -> Stream Void b c r1 m r2 -> Stream l a c r0 m r2
pipe (Stream nextL sL) (Stream nextR sR) = Stream next (Right (return (), sL, Right sR)) where
{-# INLINE_INNER next #-}
next (Left r) = Done r
next (Right (final, sL, Right sR)) = case nextR sR of
Skip sR' -> Skip (Right (final, sL, Right sR'))
HaveOutput sR' c o -> HaveOutput (Right (final, sL, Right sR')) (c >> final) o
NeedInput p c -> Skip (Right (final, sL, Left (p, c)))
Done r -> PipeM (final >> return (Left r))
PipeM ms -> PipeM (liftM (Right . (final, sL,) . Right) ms)
Leftover _ i -> absurd i
next (Right (final, sL, Left (p, c))) = case nextL sL of
Skip sL' -> Skip (Right (final, sL', Left (p, c)))
HaveOutput sL' final' o -> Skip (Right (final', sL', Right (p o)))
NeedInput pL cL -> NeedInput (Right . (final,, Left (p, c)) . pL) (Right . (final,, Left (p, c)) . cL)
Done r -> Skip (Right (return (), sL, Right (c r)))
PipeM ms -> PipeM (liftM (Right . (final,, Left (p, c))) ms)
Leftover sL' i -> Leftover (Right (final, sL', Left (p, c))) i
{-# INLINE_STREAM purePipe #-}
purePipe :: (forall m . Monad m => Stream l a b r0 m r1) -> (forall m . Monad m => Stream Void b c r1 m r2) -> (forall m . Monad m => Stream l a c r0 m r2)
purePipe (Stream nextL sL) (Stream nextR sR) = Stream next (sL, Right sR) where
{-# INLINE_INNER next #-}
next (sL, Right sR) = case nextR sR of
Skip sR' -> Skip (sL, Right sR')
HaveOutput sR' _ o -> HaveOutput (sL, Right sR') (return ()) o
NeedInput p c -> Skip (sL, Left (p, c))
Done r -> Done r
PipeM ms -> Skip (sL, Right (runIdentity ms))
Leftover _ i -> absurd i
next (sL, Left (p, c)) = case nextL sL of
Skip sL' -> Skip (sL', Left (p, c))
HaveOutput sL' _ o -> Skip (sL', Right (p o))
NeedInput pL cL -> NeedInput ((, Left (p, c)) . pL) ((, Left (p, c)) . cL)
Done r -> Skip (sL, Right (c r))
PipeM ms -> Skip (runIdentity ms, Left (p, c))
Leftover sL' i -> Leftover (sL', Left (p, c)) i