public
Created

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

  • Download Gist
gistfile1.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 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
-- http://www.reddit.com/r/haskell/comments/rbgvz/conduits_vs_pipes_using_void_as_an_input_or/
 
import Control.Monad
 
data Pipe m i o r =
NeedInput (i -> Pipe m i o r) (Pipe m () o r)
| HaveOutput (Pipe m i o r) (m ()) o
| Finished (Maybe i) r
| PipeM (m (Pipe m i o r)) (m r)
 
data Void
 
unused = error "unused"
absurd = error "Cannot happen because of Void"
 
{-----------------------------------------------------------------------------
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
 
toSinkClose :: Monad m => Pipe m () Void r -> SinkClose m r
toSinkClose (NeedInput _ _) = unused
toSinkClose (HaveOutput _ _ _) = absurd
toSinkClose (Finished _ _) = unused
toSinkClose (PipeM _ a) = a
 
toSink :: Monad m => Pipe m i Void r -> Sink i m r
toSink (NeedInput a b) = Processing (toSink . a) (toSinkClose b)
toSink (HaveOutput _ _ _) = absurd
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 unused b)
fromSink (Done a b) = Finished a b
fromSink (SinkM a) = PipeM (fromSink `liftM` a) unused
 
{-----------------------------------------------------------------------------
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 () a () -> Source m a
toSource (NeedInput f m) = unused
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 () a ()
fromSource (Open a b c) = HaveOutput (fromSource a) b c
fromSource Closed = Finished unused unused
fromSource (SourceM a b) = PipeM (fromSource `liftM` a) b

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.