Thanks Dan, some useful pointers there.
Looking at the Pipes level, there's
ConduitM i o m r = forall b. (r -> Pipe i i o () m b) -> Pipe i i o () m b
= forall b. ContT b (Pipe i i o () m) r
(not sure if the comparison with ContT is helpful yet...)
I see what you mean about the upstream return type u always being () with ConduitM, although it's the r I want to get my hands on, not the u. I think that means a combinator like awaitE can't work in ConduitM as it can't depend on the return type of the upstream ConduitM.
Looking at how (=$=) is defined, I tried this:
fuseEither :: Monad m => ConduitM a b m u -> ConduitM b c m d -> ConduitM a c m (Either u d)
fuseEither (ConduitM left0) (ConduitM right0) = ConduitM $ \rest ->
let goRight final left right =
case right of
HaveOutput p c o -> HaveOutput (recurse p) (c >> final) o
NeedInput rp rc -> goLeft rp rc final left
Done r2 -> PipeM (final >> return (rest (Right r2)))
PipeM mp -> PipeM (liftM recurse mp)
Leftover right' i -> goRight final (HaveOutput left final i) right'
where
recurse = goRight final left
goLeft rp rc final left =
case left of
HaveOutput left' final' o -> goRight final' left' (rp o)
NeedInput left' lc -> NeedInput (recurse . left') (recurse . lc)
Done r1 -> PipeM (final >> return (rest (Left r1)))
PipeM mp -> PipeM (liftM recurse mp)
Leftover left' i -> Leftover (recurse left') i
where
recurse = goLeft rp rc final
in goRight (return ()) (left0 Done) (right0 Done)
The only difference from (=$=) is the two Done cases: the one in goRight now passes Right r2 back to rest instead of r2 itself, and the one in goLeft passes Left r1 back instead of continuing with another call to goRight. Much to my surprise, this actually compiled! But I've no idea whether there are any bad consequences of this - indeed, I've no real idea what's going on here at all, I just took a punt.
Is this horribly broken or is this exactly what I want?
Cheers,