public
anonymous / SinkFork.hs
Created

Sink that forks input to two other sinks

  • Download Gist
SinkFork.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56
{-# 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)

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.