Skip to content

Instantly share code, notes, and snippets.

@mgsloan

mgsloan/blah.hs

Created April 7, 2012 19:35
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save mgsloan/2331565 to your computer and use it in GitHub Desktop.
Save mgsloan/2331565 to your computer and use it in GitHub Desktop.
Download ZIP
Lined up variant
Raw
blah.hs
zipProducers :: Producer a m r -> Producer b m r -> Producer (a, b) m r
zipProducers (Pure r) _ = return r
zipProducers _ (Pure r) = return r
zipProducers (M m1) (M m2) = lift m1 >>= \p1 -> lift m2 >>= \p2 -> zipProducers p1 p2
zipProducers (M m1) p2 = lift m1 >>= \p1 -> zipProducers p1 p2
zipProducers p1 (M m2) = lift m2 >>= \p2 -> zipProducers p1 p2
zipProducers (Await f1) (Await f2) = zipProducers (f1 ()) (f2 ())
zipProducers (Await f1) p2 = zipProducers (f1 ()) p2
zipProducers p1 (Await f2) = zipProducers p1 (f2 ())
zipProducers (Yield (x1, p1)) (Yield (x2, p2)) = yield (x1, x2) >> zipProducers p1 p2
interleavePipes :: Pipe a b m r1 -> Pipe a b m r2 -> Pipe a b m (r1, r2)
interleavePipes (Pure r1) p2 = p2 >>= \r2 -> return (r1, r2)
interleavePipes p1 (Pure r2) = p1 >>= \r1 -> return (r1, r2)
interleavePipes (Yield (x1, p1)) (Yield (x2, p2)) = yield x1 >> yield x2 >> interleavePipes p1 p2
interleavePipes (Yield (x1, p1)) p2 = yield x1 >> interleavePipes p1 p2
interleavePipes p1 (Yield (x2, p2)) = yield x2 >> interleavePipes p1 p2
interleavePipes (M m1) (M m2) = lift m1 >>= \p1 -> lift m2 >>= \p2 -> interleavePipes p1 p2
interleavePipes (M m1) p2 = lift m1 >>= \p1 -> interleavePipes p1 p2
interleavePipes p1 (M m2) = lift m2 >>= \p2 -> interleavePipes p1 p2
interleavePipes (Await f1) (Await f2) = await >>= \x -> interleavePipes (f1 x) (f2 x)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment