Haskell Conduit Walkthrough

In a previous post I provided a complete series of transformations of a simple streaming application using the pipes package.

In the Haskell library eco system exists another competing streaming library: conduit authored by Michael Snoyman. Since Michael has created an absurd amount of libraries, using conduit in most of them, conduit has an impressive user base and provides solid and carefully engineered code with a lot of high level combinators for ease of use.

In this post I want to provide a walkthrough of code very similar to the original post. The following code snippet is identical in look and behavior of the original:

module Main where

import Conduit


my_producer :: ConduitT i Int IO ()
my_producer = do
  yield 1
  yield 2


my_consumer :: ConduitT Int o IO ()
my_consumer = loop
  where
    loop = do
      mi <- await
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

main :: IO ()
main = runConduit $ my_producer .| my_consumer

This piece of code will serve as the basis of the following transformations.

Note: The above code uses conduit’s primitives in order to be as close to the original post as possible. However, even though correct, this is not really idiomatic conduit code. A more terse and readable version would be

module Main where

import Conduit

main :: IO ()
main = runConduit $ yieldMany [1,2] .| mapC (+1) .| printC

Note 2: As was the case with the pipes code the following conduit code requires slight modifications to the original package for all the imports to be available. This is the case because we use functions and data type constructors which are not exported by the internal package code. The way I achieve this is by creating an empty stack project, copying the conduit package into the project as a library, modify the package.yaml file and then export everything I need in the respective modules. The actual code can be found on my github.

Evaluation in 45 steps

The code above equals…

module Main where

import Conduit


my_producer :: ConduitT i Int IO ()
my_producer = yield 1 >>= (\_ -> yield 2)


my_consumer :: ConduitT Int o IO ()
my_consumer = loop
  where
    loop = do
      mi <- await
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

main :: IO ()
main = runConduit $ my_producer .| my_consumer

equals…

module Main where

import Conduit


my_producer :: ConduitT i Int IO ()
my_producer = yield 1 >>= (\_ -> yield 2)


my_consumer :: ConduitT Int o IO ()
my_consumer = loop
  where
    loop = await >>= (\mi -> handle mi)
    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

main :: IO ()
main = runConduit $ my_producer .| my_consumer

equals…

module Main where

import Conduit
import Data.Conduit
import qualified Data.Conduit.Internal.Conduit as C
import qualified Data.Conduit.Internal.Pipe as P


my_producer :: ConduitT i Int IO ()
my_producer = ConduitT (\rest  -> P.HaveOutput (rest  ()) 1) >>= (\_ ->
              ConduitT (\rest2 -> P.HaveOutput (rest2 ()) 2))


my_consumer :: ConduitT Int o IO ()
my_consumer = loop
  where
    loop = await >>= (\mi -> handle mi)
    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

main :: IO ()
main = runConduit $ my_producer .| my_consumer

equals…

module Main where

import Conduit
import Data.Conduit
import qualified Data.Conduit.Internal.Conduit as C
import qualified Data.Conduit.Internal.Pipe as P


my_producer :: ConduitT i Int IO ()
my_producer = ConduitT (\rest  -> P.HaveOutput (rest  ()) 1) >>= (\_ ->
              ConduitT (\rest2 -> P.HaveOutput (rest2 ()) 2))


my_consumer :: ConduitT Int o IO ()
my_consumer = loop
  where
    loop = ConduitT (\f -> P.NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi)
    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

main :: IO ()
main = runConduit $ my_producer .| my_consumer

equals…

module Main where

import Conduit
import Data.Conduit
import Data.Conduit.Internal.Pipe (Pipe(..))
import qualified Data.Conduit.Internal.Conduit as C
import qualified Data.Conduit.Internal.Pipe as P


my_producer :: ConduitT i Int IO ()
my_producer = ConduitT (\h -> f (\a -> unConduitT (g a) h))
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))


my_consumer :: ConduitT Int o IO ()
my_consumer = loop
  where
    loop = ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi)
    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

main :: IO ()
main = runConduit $ my_producer .| my_consumer

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Pipe (Pipe(..))
import qualified Data.Conduit.Internal.Conduit as C
import qualified Data.Conduit.Internal.Pipe as P


main :: IO ()
main = runConduit $ (ConduitT h) .| loop
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    loop = (ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi))

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Pipe (Pipe(..))
import qualified Data.Conduit.Internal.Conduit as C
import qualified Data.Conduit.Internal.Pipe as P


main :: IO ()
main = runConduit $ ConduitT h .| ConduitT (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    loop = (ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi))

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Pipe (Pipe(..))
import qualified Data.Conduit.Internal.Conduit as C
import qualified Data.Conduit.Internal.Pipe as P


main :: IO ()
main = runConduit $ ConduitT h .| ConduitT g2
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = (ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi))

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..))


main :: IO ()
main = runConduit $ (=$=) (ConduitT h) (ConduitT g2)
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = (ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi))

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..))


main :: IO ()
main = runConduit $ ConduitT (\rest ->
    let
      goRight left right =
            case right of
                HaveOutput p o    -> HaveOutput (recurse p) o
                NeedInput rp rc   -> goLeft rp rc left
                Done r2           -> rest r2
                PipeM mp          -> PipeM (liftM recurse mp)
                Leftover right' i -> goRight (HaveOutput left i) right'
          where
            recurse = goRight left

      goLeft rp rc left =
          case left of
              HaveOutput left' o        -> goRight left' (rp o)
              NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
              Done r1                   -> goRight (Done r1) (rc r1)
              PipeM mp                  -> PipeM (liftM recurse mp)
              Leftover left' i          -> Leftover (recurse left') i
        where
          recurse = goLeft rp rc
    in goRight (h Done) (g2 Done))
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = (ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi))

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = runPipe $ injectLeftovers $ (\rest ->
    let
      goRight left right =
            case right of
                HaveOutput p o    -> HaveOutput (recurse p) o
                NeedInput rp rc   -> goLeft rp rc left
                Done r2           -> rest r2
                PipeM mp          -> PipeM (liftM recurse mp)
                Leftover right' i -> goRight (HaveOutput left i) right'
          where
            recurse = goRight left

      goLeft rp rc left =
          case left of
              HaveOutput left' o        -> goRight left' (rp o)
              NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
              Done r1                   -> goRight (Done r1) (rc r1)
              PipeM mp                  -> PipeM (liftM recurse mp)
              Leftover left' i          -> Leftover (recurse left') i
        where
          recurse = goLeft rp rc
    in goRight (h Done) (g2 Done)) Done
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = (ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi))

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = runPipe $ injectLeftovers $ goRight (h Done) (g2 Done)
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = (ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi))

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = runPipe $ injectLeftovers $ goRight (h Done) (NeedInput ((\a2 -> unConduitT (handle a2) Done) . Just) (const $ (\a2 -> unConduitT (handle a2) Done) Nothing))
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = (ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi))

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = runPipe $ injectLeftovers $ goLeft ((\a2 -> unConduitT (handle a2) Done) . Just) (const $ (\a2 -> unConduitT (handle a2) Done) Nothing) (h Done)
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = (ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi))

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = runPipe $ injectLeftovers (
          goLeft ((\a2 -> unConduitT (handle a2) Done) . Just)
                 (const $ (\a2 -> unConduitT (handle a2) Done) Nothing)
                 (HaveOutput (unConduitT (g ()) Done) 1))
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = (ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi))

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = runPipe $ injectLeftovers (
          goLeft ((\a2 -> unConduitT (handle a2) Done) . Just)
                 (const $ (\a2 -> unConduitT (handle a2) Done) Nothing)
                 (HaveOutput (HaveOutput (Done ()) 2) 1))
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = (ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi))

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = runPipe $ injectLeftovers (
          goRight (HaveOutput (Done ()) 2)
                  (((\a2 -> unConduitT (handle a2) Done) . Just) 1))
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = (ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi))

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = runPipe $ injectLeftovers (
          goRight (HaveOutput (Done ()) 2)
                  (unConduitT (handle (Just 1)) Done))
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = (ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi))

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = runPipe $ injectLeftovers (
          goRight (HaveOutput (Done ()) 2)
                  (unConduitT ((liftIO (print(1+1))) >>= (\_ -> loop)) Done))
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = (ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi))

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = runPipe $ injectLeftovers (
          goRight (HaveOutput (Done ()) 2)
                  (unConduitT ((ConduitT (\rest -> PipeM (liftM rest (print(1+1))))) >>= (\_ -> loop)) Done))
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = (ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi))

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = runPipe $ injectLeftovers (
          goRight (HaveOutput (Done ()) 2)
                  (unConduitT (ConduitT (\h3 -> (\rest -> PipeM (liftM rest (print(1+1)))) (\a -> unConduitT ((\_ -> loop) a) h3))) Done))
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = (ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi))

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = runPipe $ injectLeftovers (
          goRight (HaveOutput (Done ()) 2)
                  (PipeM (liftM (\a -> unConduitT ((\_ -> loop) a) Done) (print(1+1)))))
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi)

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = runPipe $ injectLeftovers (
          goRight (HaveOutput (Done ()) 2)
                  (PipeM (print 2 >> return (unConduitT loop Done))))
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi)

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = runPipe $ injectLeftovers (PipeM (liftM (goRight (HaveOutput (Done ()) 2)) (print 2 >> return (unConduitT loop Done))))
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi)

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = runPipe $ PipeM (liftM (go []) (liftM (goRight (HaveOutput (Done ()) 2))
                                             (print 2 >> return (unConduitT loop Done))))
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi)

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

    go ls (HaveOutput p o) = HaveOutput (go ls p) o
    go (l:ls) (NeedInput p _) = go ls $ p l
    go [] (NeedInput p c) = NeedInput (go [] . p) (go [] . c)
    go _ (Done r) = Done r
    go ls (PipeM mp) = PipeM (liftM (go ls) mp)
    go ls (Leftover p l) = go (l:ls) p

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = runPipe $ PipeM (do
                          print 2
                          a <- return $ unConduitT loop Done
                          a2 <- return $ goRight (HaveOutput (Done ()) 2) a
                          return $ go [] a2)
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi)

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

    go ls (HaveOutput p o) = HaveOutput (go ls p) o
    go (l:ls) (NeedInput p _) = go ls $ p l
    go [] (NeedInput p c) = NeedInput (go [] . p) (go [] . c)
    go _ (Done r) = Done r
    go ls (PipeM mp) = PipeM (liftM (go ls) mp)
    go ls (Leftover p l) = go (l:ls) p

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = do
         print 2
         a <- return $ unConduitT loop Done
         a2 <- return $ goRight (HaveOutput (Done ()) 2) a
         a3 <- return $ go [] a2
         runPipe a3
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= (\mi -> handle mi)

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

    go ls (HaveOutput p o) = HaveOutput (go ls p) o
    go (l:ls) (NeedInput p _) = go ls $ p l
    go [] (NeedInput p c) = NeedInput (go [] . p) (go [] . c)
    go _ (Done r) = Done r
    go ls (PipeM mp) = PipeM (liftM (go ls) mp)
    go ls (Leftover p l) = go (l:ls) p

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = do
         print 2
         runPipe $ go [] $ goRight (HaveOutput (Done ()) 2) $ unConduitT loop Done
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= handle

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

    go ls (HaveOutput p o) = HaveOutput (go ls p) o
    go (l:ls) (NeedInput p _) = go ls $ p l
    go [] (NeedInput p c) = NeedInput (go [] . p) (go [] . c)
    go _ (Done r) = Done r
    go ls (PipeM mp) = PipeM (liftM (go ls) mp)
    go ls (Leftover p l) = go (l:ls) p

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = do
         print 2
         runPipe $ go [] $ goRight (HaveOutput (Done ()) 2)
                                   (NeedInput ((\a -> unConduitT (handle a) Done) . Just)
                                              (const $ (\a -> unConduitT (handle a) Done) Nothing))
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= handle

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

    go ls (HaveOutput p o) = HaveOutput (go ls p) o
    go (l:ls) (NeedInput p _) = go ls $ p l
    go [] (NeedInput p c) = NeedInput (go [] . p) (go [] . c)
    go _ (Done r) = Done r
    go ls (PipeM mp) = PipeM (liftM (go ls) mp)
    go ls (Leftover p l) = go (l:ls) p

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = do
         print 2
         runPipe $ go [] $ goLeft ((\a -> unConduitT (handle a) Done) . Just)
                                  (const $ (\a -> unConduitT (handle a) Done) Nothing)
                                  (HaveOutput (Done ()) 2)
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= handle

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

    go ls (HaveOutput p o) = HaveOutput (go ls p) o
    go (l:ls) (NeedInput p _) = go ls $ p l
    go [] (NeedInput p c) = NeedInput (go [] . p) (go [] . c)
    go _ (Done r) = Done r
    go ls (PipeM mp) = PipeM (liftM (go ls) mp)
    go ls (Leftover p l) = go (l:ls) p

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = do
         print 2
         runPipe $ go [] $ goRight (Done ())
                                   (unConduitT (handle (Just 2)) Done)
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= handle

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

    go ls (HaveOutput p o) = HaveOutput (go ls p) o
    go (l:ls) (NeedInput p _) = go ls $ p l
    go [] (NeedInput p c) = NeedInput (go [] . p) (go [] . c)
    go _ (Done r) = Done r
    go ls (PipeM mp) = PipeM (liftM (go ls) mp)
    go ls (Leftover p l) = go (l:ls) p

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = do
         print 2
         runPipe $ go [] $ goRight (Done ())
                                   (unConduitT (ConduitT (\rest -> PipeM (liftM rest (print (2+1)))) >> loop) Done)
    
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= handle

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

    go ls (HaveOutput p o) = HaveOutput (go ls p) o
    go (l:ls) (NeedInput p _) = go ls $ p l
    go [] (NeedInput p c) = NeedInput (go [] . p) (go [] . c)
    go _ (Done r) = Done r
    go ls (PipeM mp) = PipeM (liftM (go ls) mp)
    go ls (Leftover p l) = go (l:ls) p

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = do
         print 2
         runPipe $ go [] $ goRight (Done ())
                                   (unConduitT (ConduitT $ \h -> (\rest -> PipeM (liftM rest (print (2+1)))) $ \a -> unConduitT loop h) Done)
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= handle

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

    go ls (HaveOutput p o) = HaveOutput (go ls p) o
    go (l:ls) (NeedInput p _) = go ls $ p l
    go [] (NeedInput p c) = NeedInput (go [] . p) (go [] . c)
    go _ (Done r) = Done r
    go ls (PipeM mp) = PipeM (liftM (go ls) mp)
    go ls (Leftover p l) = go (l:ls) p

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = do
         print 2
         runPipe $ go [] $ goRight (Done ())
                                   (PipeM (liftM (\a -> unConduitT loop Done) (print (2+1))))
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= handle

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

    go ls (HaveOutput p o) = HaveOutput (go ls p) o
    go (l:ls) (NeedInput p _) = go ls $ p l
    go [] (NeedInput p c) = NeedInput (go [] . p) (go [] . c)
    go _ (Done r) = Done r
    go ls (PipeM mp) = PipeM (liftM (go ls) mp)
    go ls (Leftover p l) = go (l:ls) p

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = do
         print 2
         runPipe $ go [] $ goRight (Done ())
                                   (PipeM (print 3 >> return (unConduitT loop Done)))
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= handle

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

    go ls (HaveOutput p o) = HaveOutput (go ls p) o
    go (l:ls) (NeedInput p _) = go ls $ p l
    go [] (NeedInput p c) = NeedInput (go [] . p) (go [] . c)
    go _ (Done r) = Done r
    go ls (PipeM mp) = PipeM (liftM (go ls) mp)
    go ls (Leftover p l) = go (l:ls) p

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = do
         print 2
         runPipe $ go [] $ PipeM (do
                                    print 3
                                    a <- return $ unConduitT loop Done
                                    return $ goRight (Done ()) a)
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= handle

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

    go ls (HaveOutput p o) = HaveOutput (go ls p) o
    go (l:ls) (NeedInput p _) = go ls $ p l
    go [] (NeedInput p c) = NeedInput (go [] . p) (go [] . c)
    go _ (Done r) = Done r
    go ls (PipeM mp) = PipeM (liftM (go ls) mp)
    go ls (Leftover p l) = go (l:ls) p

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = do
         print 2
         runPipe $ PipeM (do
                            print 3
                            a <- return $ unConduitT loop Done
                            a2 <- return $ goRight (Done ()) a
                            return $ go [] a2)
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= handle

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

    go ls (HaveOutput p o) = HaveOutput (go ls p) o
    go (l:ls) (NeedInput p _) = go ls $ p l
    go [] (NeedInput p c) = NeedInput (go [] . p) (go [] . c)
    go _ (Done r) = Done r
    go ls (PipeM mp) = PipeM (liftM (go ls) mp)
    go ls (Leftover p l) = go (l:ls) p

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = do
         print 2
         print 3
         a <- return $ unConduitT loop Done
         a2 <- return $ goRight (Done ()) a
         a3 <- return $ go [] a2
         runPipe a3
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= handle

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

    go ls (HaveOutput p o) = HaveOutput (go ls p) o
    go (l:ls) (NeedInput p _) = go ls $ p l
    go [] (NeedInput p c) = NeedInput (go [] . p) (go [] . c)
    go _ (Done r) = Done r
    go ls (PipeM mp) = PipeM (liftM (go ls) mp)
    go ls (Leftover p l) = go (l:ls) p

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = do
         print 2
         print 3
         runPipe $ go [] $ goRight (Done ()) $ unConduitT loop Done
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= handle

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

    go ls (HaveOutput p o) = HaveOutput (go ls p) o
    go (l:ls) (NeedInput p _) = go ls $ p l
    go [] (NeedInput p c) = NeedInput (go [] . p) (go [] . c)
    go _ (Done r) = Done r
    go ls (PipeM mp) = PipeM (liftM (go ls) mp)
    go ls (Leftover p l) = go (l:ls) p

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = do
         print 2
         print 3
         runPipe $ go [] $ goRight (Done ()) $ NeedInput ((\a -> unConduitT (handle a) Done) . Just)
                                                         (const $ (\a -> unConduitT (handle a) Done) Nothing)
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= handle

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

    go ls (HaveOutput p o) = HaveOutput (go ls p) o
    go (l:ls) (NeedInput p _) = go ls $ p l
    go [] (NeedInput p c) = NeedInput (go [] . p) (go [] . c)
    go _ (Done r) = Done r
    go ls (PipeM mp) = PipeM (liftM (go ls) mp)
    go ls (Leftover p l) = go (l:ls) p

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = do
         print 2
         print 3
         runPipe $ go [] $ goLeft ((\a -> unConduitT (handle a) Done) . Just)
                                  (const $ (\a -> unConduitT (handle a) Done) Nothing)
                                  (Done ())
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= handle

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

    go ls (HaveOutput p o) = HaveOutput (go ls p) o
    go (l:ls) (NeedInput p _) = go ls $ p l
    go [] (NeedInput p c) = NeedInput (go [] . p) (go [] . c)
    go _ (Done r) = Done r
    go ls (PipeM mp) = PipeM (liftM (go ls) mp)
    go ls (Leftover p l) = go (l:ls) p

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = do
         print 2
         print 3
         runPipe $ go [] $ goRight (Done ()) (unConduitT (handle Nothing) Done)
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= handle

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

    go ls (HaveOutput p o) = HaveOutput (go ls p) o
    go (l:ls) (NeedInput p _) = go ls $ p l
    go [] (NeedInput p c) = NeedInput (go [] . p) (go [] . c)
    go _ (Done r) = Done r
    go ls (PipeM mp) = PipeM (liftM (go ls) mp)
    go ls (Leftover p l) = go (l:ls) p

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = do
         print 2
         print 3
         runPipe $ go [] $ goRight (Done ()) (Done())
  where
    f = \rest  -> HaveOutput (rest  ()) 1
    g = (\_ -> ConduitT (\rest2 -> HaveOutput (rest2 ()) 2))
    h = \r -> f (\a -> unConduitT (g a) r)
    f2 = (\f -> NeedInput (f . Just) (const $ f Nothing))
    g2 = (\h2 -> f2 (\a2 -> unConduitT (handle a2) h2))
    loop = ConduitT (\f -> NeedInput (f . Just) (const $ f Nothing)) >>= handle

    handle mi =
      case mi of
        Just i -> do
          liftIO $ print(i+1)
          loop
        Nothing -> return ()

    goRight left right =
          case right of
              HaveOutput p o    -> HaveOutput (recurse p) o
              NeedInput rp rc   -> goLeft rp rc left
              Done r2           -> Done r2
              PipeM mp          -> PipeM (liftM recurse mp)
              Leftover right' i -> goRight (HaveOutput left i) right'
        where
          recurse = goRight left

    goLeft rp rc left =
        case left of
            HaveOutput left' o        -> goRight left' (rp o)
            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)
            Done r1                   -> goRight (Done r1) (rc r1)
            PipeM mp                  -> PipeM (liftM recurse mp)
            Leftover left' i          -> Leftover (recurse left') i
      where
        recurse = goLeft rp rc

    go ls (HaveOutput p o) = HaveOutput (go ls p) o
    go (l:ls) (NeedInput p _) = go ls $ p l
    go [] (NeedInput p c) = NeedInput (go [] . p) (go [] . c)
    go _ (Done r) = Done r
    go ls (PipeM mp) = PipeM (liftM (go ls) mp)
    go ls (Leftover p l) = go (l:ls) p

equals…

module Main where

import Control.Monad
import Conduit
import Data.Conduit
import Data.Conduit.Internal.Conduit ((=$=))
import Data.Conduit.Internal.Pipe (Pipe(..), runPipe, injectLeftovers)


main :: IO ()
main = do
         print 2
         print 3
         runPipe $ go [] $ Done()
  where

    go ls (HaveOutput p o) = HaveOutput (go ls p) o
    go (l:ls) (NeedInput p _) = go ls $ p l
    go [] (NeedInput p c) = NeedInput (go [] . p) (go [] . c)
    go _ (Done r) = Done r
    go ls (PipeM mp) = PipeM (liftM (go ls) mp)
    go ls (Leftover p l) = go (l:ls) p

equals…

module Main where


main :: IO ()
main = do
         print 2
         print 3
         return ()