Created
March 24, 2012 20:42
-
-
Save HeinrichApfelmus/2187593 to your computer and use it in GitHub Desktop.
BIjection between Twan van Laarhoven's Pipe and the data types from Conduit
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- 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 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment