Bijection between Twan van Laarhoven's Pipe and the data types from Conduit

conduits_pipes.hs

-- http://www.reddit.com/r/haskell/comments/rbgvz/conduits_vs_pipes_using_void_as_an_input_or/

import Control.Monad
import Data.Void

data Pipe m i o r =
    NeedInput (i -> Pipe m i o r) (Pipe m Void o r)
  | HaveOutput (Pipe m i o r) (m r) o
  | Finished (Maybe i) r
  | PipeM (m (Pipe m i o r)) (m r)

close :: Monad m => Pipe m i o r -> m r
close (NeedInput _ a)    = close a
close (HaveOutput _ a _) = a
close (Finished _ a)     = return a
close (PipeM _ a)        = a

convert :: Monad m => Pipe m i o r -> Pipe m Void o r
convert (NeedInput _ pipe)     = pipe
convert (HaveOutput pipe mr o) = HaveOutput (convert pipe) mr o
convert (Finished _ r)         = Finished Nothing r
convert (PipeM mc mr)          = PipeM (liftM convert mc) mr

instance Monad m => Monad (Pipe m i o) where
  return = Finished Nothing
  m >>= f = case m of
    Finished _ r         -> f r
    PipeM mc mr          -> PipeM (liftM (>>= f) mc) (mr >>= close . f) 
    NeedInput fc pipe    -> NeedInput ((>>= f) . fc) (pipe >>= convert . f)
    HaveOutput pipe mr o -> HaveOutput (pipe >>= f) (mr >>= close . f) o


{-----------------------------------------------------------------------------
    Sink
------------------------------------------------------------------------------}
data Sink i m o =
    Processing (i -> Sink i m o) (SinkClose m o)
  | Done (Maybe i) o
  | SinkM (m (Sink i m o))
type SinkClose m o = m o

toSink :: Monad m => Pipe m i Void r -> Sink i m r
toSink (NeedInput a b)    = Processing (toSink . a) (close b)
toSink (HaveOutput _ _ v) = absurd v
toSink (Finished a b)     = Done a b
toSink (PipeM a _)        = SinkM (toSink `liftM` a)

fromSink :: Monad m => Sink i m r -> Pipe m i Void r
fromSink (Processing a b) = NeedInput (fromSink . a) (PipeM (Finished Nothing `liftM` b) b)
fromSink (Done a b)       = Finished a b
fromSink (SinkM a)        = PipeM (fromSink `liftM` a) (close . fromSink =<< a)

{-----------------------------------------------------------------------------
    Conduit
------------------------------------------------------------------------------}
data Conduit i m o =
    NeedInput' (i -> Conduit i m o) (ConduitClose m o)
  | HaveOutput' (Conduit i m o) (m ()) o
  | Finished' (Maybe i)
  | ConduitM (m (Conduit i m o)) (m ())
type ConduitClose m o = Source m o

toConduit :: Monad m => Pipe m i o () -> Conduit i m o 
toConduit (NeedInput a b)    = NeedInput' (toConduit . a) (toSource b)
toConduit (HaveOutput a b c) = HaveOutput' (toConduit a) b c
toConduit (Finished a ())    = Finished' a
toConduit (PipeM a b)        = ConduitM (toConduit `liftM` a) b

fromConduit :: Monad m => Conduit i m o -> Pipe m i o ()
fromConduit (NeedInput' a b)    = NeedInput (fromConduit . a) (fromSource b)
fromConduit (HaveOutput' a b c) = HaveOutput (fromConduit a) b c
fromConduit (Finished' a)       = Finished a ()
fromConduit (ConduitM a b)      = PipeM (fromConduit `liftM` a) b

{-----------------------------------------------------------------------------
    Source
------------------------------------------------------------------------------}
data Source m a =
    Open (Source m a) (m ()) a
  | Closed
  | SourceM (m (Source m a)) (m ())

toSource :: Monad m => Pipe m Void a () -> Source m a
toSource (NeedInput _ a)    = toSource a
toSource (HaveOutput a b c) = Open (toSource a) b c
toSource (Finished _ _)     = Closed
toSource (PipeM a b)        = SourceM (toSource `liftM` a) b

fromSource :: Monad m => Source m a -> Pipe m Void a ()
fromSource (Open a b c)  = HaveOutput (fromSource a) b c
fromSource Closed        = Finished Nothing ()
fromSource (SourceM a b) = PipeM (fromSource `liftM` a) b