Create a gist now

Instantly share code, notes, and snippets.

anonymous /SinkFork.hs
Created Mar 4, 2012

Sink that forks input to two other sinks
{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}
{-# OPTIONS -Wall #-}
import Data.Conduit
import qualified Data.Conduit.List as CL
import qualified Data.Conduit.Binary as CB
sinkFork::Resource m => Sink a m b -> Sink a m c -> Sink a m (b,c)
sinkFork mlsink0 mrsink0 = do
SinkData (push0 Nothing) (close0 Nothing)
where push0 st input = do
newst <- case st of
Nothing -> do
lsink <- sinkPush mlsink0 input
rsink <- sinkPush mrsink0 input
return $ Just (lsink, rsink)
Just (Processing lpush lclose, Processing rpush rclose) -> do
lsink <- lpush input
rsink <- rpush input
return $ Just (lsink, rsink)
Just (Processing lpush lclose, rsink@(Done rr ro)) -> do
lsink <- lpush input
return $ Just (lsink, rsink)
Just (lsink@(Done ll lo), Processing rpush rclose) -> do
rsink <- rpush input
return $ Just (lsink, rsink)
Just (lsink@(Done ll lo), rsink@(Done rr ro)) -> do
return $ Just (lsink, rsink)
case newst of
Just (Processing lpush lclose, Processing rpush rclose) -> do
return $ Processing (push0 newst) (close0 newst)
Just (Processing lpush lclose, Done rr !ro) -> do
return $ Processing (push0 newst) (close0 newst)
Just (Done ll !lo, Processing rpush rclose) -> do
return $ Processing (push0 newst) (close0 newst)
Just (Done ll !lo, Done rr !ro) -> do
return $ Done Nothing (lo,ro) -- what gets returned here?
Nothing -> error "newst Nothing should not happen"
close0 (Just (Processing lpush lclose, Processing rpush rclose)) = do
l <- lclose
r <- rclose
return (l,r)
close0 (Just (Processing lpush lclose, Done rr !r)) = do
l <- lclose
return (l,r)
close0 (Just (Done ll !l, Processing rpush rclose)) = do
r <- rclose
return (l,r)
close0 (Just (Done ll !l, Done rr !r)) = do
return (l,r)
close0 Nothing = do
l <- sinkClose mlsink0
r <- sinkClose mrsink0
return (l,r)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment