wip: explore removing delays(5)
This commit is contained in:
parent
67ae171532
commit
dfdca9f5e9
@ -27,8 +27,12 @@ traverse :: forall a b m. MonadRec m => (b -> a -> m b) -> b -> Producer a m Uni
|
|||||||
traverse f b0 p0 =
|
traverse f b0 p0 =
|
||||||
flip tailRecM (p0 /\ b0) \(p /\ b) ->
|
flip tailRecM (p0 /\ b0) \(p /\ b) ->
|
||||||
case p of
|
case p of
|
||||||
Respond a m -> Loop <$> (m unit /\ _) <$> f b a
|
Respond a m -> do
|
||||||
M m -> Loop <$> (_ /\ b) <$> m
|
b' <- f b a
|
||||||
|
pure $ Loop $ m unit /\ b'
|
||||||
|
M m -> do
|
||||||
|
n <- m
|
||||||
|
pure $ Loop $ (n /\ b)
|
||||||
Request _ _ -> pure $ Done b
|
Request _ _ -> pure $ Done b
|
||||||
Pure _ -> pure $ Done b
|
Pure _ -> pure $ Done b
|
||||||
|
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
module Pipes.Node.Stream where
|
module Pipes.Node.Stream where
|
||||||
|
|
||||||
import Prelude
|
import Prelude hiding (join)
|
||||||
|
|
||||||
import Control.Monad.Error.Class (class MonadThrow, throwError)
|
import Control.Monad.Error.Class (class MonadThrow, throwError)
|
||||||
import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)
|
import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)
|
||||||
@ -90,15 +90,20 @@ fromTransform t =
|
|||||||
liftEffect $ removeErrorListener
|
liftEffect $ removeErrorListener
|
||||||
fromReadable t
|
fromReadable t
|
||||||
pure $ Done unit
|
pure $ Done unit
|
||||||
yieldFromReadableHalf =
|
|
||||||
flip tailRecM unit $ const do
|
yieldWhileReadable = do
|
||||||
res <- liftEffect (O.read t)
|
flip tailRecM unit \_ -> do
|
||||||
|
res <- liftEffect $ O.read t
|
||||||
case res of
|
case res of
|
||||||
O.ReadJust a -> do
|
O.ReadJust a -> yield (Just a) $> Loop unit
|
||||||
yield $ Just a
|
_ -> pure $ Done unit
|
||||||
pure $ Loop unit
|
|
||||||
O.ReadWouldBlock -> pure $ Done unit
|
maybeYield1 = do
|
||||||
O.ReadClosed -> yield Nothing $> Done unit
|
res <- liftEffect $ O.read t
|
||||||
|
case res of
|
||||||
|
O.ReadJust a -> yield $ Just a
|
||||||
|
_ -> pure unit
|
||||||
|
|
||||||
go { error, cancel } = do
|
go { error, cancel } = do
|
||||||
err <- liftEffect $ liftST $ STRef.read error
|
err <- liftEffect $ liftST $ STRef.read error
|
||||||
for_ err throwError
|
for_ err throwError
|
||||||
@ -108,12 +113,13 @@ fromTransform t =
|
|||||||
Nothing -> cleanup cancel
|
Nothing -> cleanup cancel
|
||||||
Just a' -> do
|
Just a' -> do
|
||||||
res <- liftEffect $ O.write t a'
|
res <- liftEffect $ O.write t a'
|
||||||
yieldFromReadableHalf
|
|
||||||
case res of
|
case res of
|
||||||
O.WriteClosed -> cleanup cancel
|
O.WriteClosed -> cleanup cancel
|
||||||
O.WriteOk -> pure $ Loop { error, cancel }
|
O.WriteOk -> do
|
||||||
|
maybeYield1
|
||||||
|
pure $ Loop { error, cancel }
|
||||||
O.WriteWouldBlock -> do
|
O.WriteWouldBlock -> do
|
||||||
yieldFromReadableHalf
|
yieldWhileReadable
|
||||||
liftAff $ O.awaitWritableOrClosed t
|
liftAff $ O.awaitWritableOrClosed t
|
||||||
pure $ Loop { error, cancel }
|
pure $ Loop { error, cancel }
|
||||||
in
|
in
|
||||||
|
Loading…
Reference in New Issue
Block a user