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:

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

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…

equals…

equals…

equals…

equals…

equals…

equals…

equals…

equals…

equals…

equals…

equals…

equals…

equals…

equals…

equals…

equals…

equals…

equals…

equals…

equals…

equals…

equals…

equals…

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…

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…

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…

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…

equals…

equals…

equals…