Permalink
Browse files

Fix PipeL implementation.

liftPipe for PipeL now lifts each constructor individually, and threads
the unawait state. Now a lifted pipe containing awaits will correctly
start to use queued unawaits.
  • Loading branch information...
pcapriotti committed Jun 24, 2012
1 parent 4d677db commit 302e6d0726161761376454e8348634e5a02211b5
Showing with 30 additions and 5 deletions.
  1. +27 −5 Control/Pipe/Class.hs
  2. +3 −0 tests/Tests.hs
View
@@ -164,16 +164,38 @@ handleUnawaits = go
go x (Yield b p w) = Yield b (go x p) w
go x (M s m h) = M s (liftM (go x) m) (go x . h)
+liftPipeL :: Monad m => Pipe m a b u r -> StateT [a] (Pipe m a b u) r
+liftPipeL (Pure r w) = lift (Pure r w)
+liftPipeL (Throw e p w) = do
+ lift $ Throw e (return ()) w
+ liftPipeL p
+liftPipeL (Yield x p w) = do
+ lift $ Yield x (return ()) w
+ liftPipeL p
+liftPipeL (Await k j h w) = get >>= \xs -> case xs of
+ [] -> do
+ x <- lift $ Await (return . Right . Right)
+ (return . Right . Left)
+ (return . Left) w
+ case x of
+ Right (Right a) -> liftPipeL (k a)
+ Right (Left u) -> liftPipeL (j u)
+ Left e -> liftPipeL (h e)
+ (x:xs') -> put xs' >> liftPipeL (k x)
+liftPipeL (M s m h) = do
+ x <- lift $ M s (liftM (return . Right) m) (return . Left)
+ case x of
+ Left e -> liftPipeL (h e)
+ Right p' -> liftPipeL p'
instance Monad m => MonadStream (PipeL m) where
type BaseMonad (PipeL m) = m
- awaitE = PipeL $ get >>= \stack -> case stack of
- [] -> lift awaitE
- (x : xs) -> put xs >> return (Right x)
-
+ awaitE = liftPipe awaitE
yield = liftPipe . yield
- liftPipe = PipeL . lift
+
+ liftPipe = PipeL . liftPipeL
+
compose (PipeL p1) p2 = PipeL $ do
let p1' = runStateT p1 []
(r, xs) <- lift $ compose p1' (handleUnawaits [] p2)
View
@@ -77,6 +77,9 @@ prop_filter :: [Int] -> (Int -> Bool) -> Bool
prop_filter xs p =
run (P.fromList xs >+> P.filter p >+> P.consume) == filter p xs
+prop_feed :: Int -> [Int] -> Bool
+prop_feed x ys = run (P.fromList ys >+> P.feed x P.consume) == x:ys
+
prop_finalizer :: Int -> Int -> Int -> Bool
prop_finalizer x y z = runWriter (runPurePipe_ (p1 >+> p2)) == (True, [z, x, y])
where

0 comments on commit 302e6d0

Please sign in to comment.