Published: February 21, 2018
by Tobias Pleyer
Tags: haskell

Haskell Pipes Walkthrough

Intro

Lately I discovered Haskell’s pipes package. It’s a really nice package, but not to grasp so easily. The author, Gabriel Gonzalez, has an execellent knowledge of Haskell. I had a quick look at his other stuff and he always writes crystall clear, well documented and he loves category theory…

I’d like to understand more of the code of the pipes package and how it works. As usual you best learn something when you work with it, so what follows is a complete evaluation of a simple program using pipes.

Note: I have verified that each step does in fact lead to the same results.

Note 2: Simply installing the pipes package and other package dependencies is not enough to run the code snippets below, because functions like _bind and data types like Proxy are not exported by the pipes package (not public). So what I did is download the package sources and then created my own stack project on top of it in which I explicitly export these definitions.

Evaluation in 32 steps

module Main where

import Pipes
import qualified Pipes.Prelude as PP


my_producer :: Producer Int IO ()
my_producer = do
  yield 1
  yield 2


my_consumer :: Consumer Int IO ()
my_consumer = loop
  where
    loop = do
      i <- await
      lift $ print (i+1)
      loop

main :: IO ()
main = runEffect $ my_producer >-> my_consumer

equals…

module Main where

import Pipes
import qualified Pipes.Prelude as PP


my_producer :: Proxy X () () Int IO ()
my_producer = do
  yield 1
  yield 2


my_consumer :: Proxy () Int () X IO ()
my_consumer = loop
  where
    loop = do
      i <- await
      lift $ print (i+1)
      loop

main :: IO ()
main = runEffect $ my_producer >-> my_consumer

equals…

module Main where

import Pipes
import Pipes.Internal
import qualified Pipes.Prelude as PP


my_producer :: Proxy X () () Int IO ()
my_producer = (yield 1) `_bind` (\_ -> yield 2)


my_consumer :: Proxy () Int () X IO ()
my_consumer = loop
  where
    loop = await `_bind` (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop)))

main :: IO ()
main = runEffect $ my_producer >-> my_consumer

equals…

module Main where

import Pipes
import Pipes.Internal
import qualified Pipes.Prelude as PP


my_producer :: Proxy X () () Int IO ()
my_producer = (Respond 1 Pure) `_bind` (\_ -> Respond 2 Pure)


my_consumer :: Proxy () Int () X IO ()
my_consumer = loop
  where
    loop = (Request () Pure) `_bind` (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop)))

main :: IO ()
main = runEffect $ my_producer >-> my_consumer

equals…

module Main where

import Pipes
import Pipes.Internal
import qualified Pipes.Prelude as PP


my_producer :: Proxy X () () Int IO ()
my_producer = (Respond 1 (\r -> Pure r)) `_bind` (\_ -> Respond 2 (\r -> Pure r))


my_consumer :: Proxy () Int () X IO ()
my_consumer = loop
  where
    loop = (Request () (\r -> Pure r)) `_bind` (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop)))

main :: IO ()
main = runEffect $ my_producer >-> my_consumer

equals…

module Main where

import Pipes
import Pipes.Internal
import qualified Pipes.Prelude as PP


my_producer :: Proxy X () () Int IO ()
my_producer = Respond 1 (\b' -> go ((\r -> Pure r) b'))
  where
    go p = case p of
        Request a' fa  -> Request a' (\a  -> go (fa  a ))
        Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
        M          m   -> M (m >>= \p' -> return (go p'))
        Pure    r      -> (\_ -> Respond 2 (\r -> Pure r)) r


my_consumer :: Proxy () Int () X IO ()
my_consumer = loop
  where
    loop = (Request () (\r -> Pure r)) `_bind` (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop)))

main :: IO ()
main = runEffect $ my_producer >-> my_consumer

equals…

module Main where

import Pipes
import Pipes.Internal
import qualified Pipes.Prelude as PP


my_producer :: Proxy X () () Int IO ()
my_producer = Respond 1 (\b' -> go (Pure b'))
  where
    go p = case p of
        Request a' fa  -> Request a' (\a  -> go (fa  a ))
        Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
        M          m   -> M (m >>= \p' -> return (go p'))
        Pure    r      -> Respond 2 (\r -> Pure r)


my_consumer :: Proxy () Int () X IO ()
my_consumer = loop
  where
    loop = Request () (\a -> go (Pure a))
      where
        go p = case p of
            Request a' fa  -> Request a' (\a  -> go (fa  a ))
            Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
            M          m   -> M (m >>= \p' -> return (go p'))
            Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r

main :: IO ()
main = runEffect $ my_producer >-> my_consumer

equals…

module Main where

import Pipes
import Pipes.Internal
import qualified Pipes.Prelude as PP


main :: IO ()
main = runEffect (Respond 1 (\b' -> go (Pure b')) >-> loop)
  where
    go p = case p of
        Request a' fa  -> Request a' (\a  -> go (fa  a ))
        Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
        M          m   -> M (m >>= \p' -> return (go p'))
        Pure    r      -> Respond 2 (\r -> Pure r)
    go' p = case p of
        Request a' fa  -> Request a' (\a  -> go' (fa  a ))
        Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
        M          m   -> M (m >>= \p' -> return (go' p'))
        Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
    loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


main :: IO ()
main = runEffect ((\() -> Respond 1 (\b' -> go (Pure b'))) +>> Request () (\a -> go' (Pure a)))
  where
    go p = case p of
        Request a' fa  -> Request a' (\a  -> go (fa  a ))
        Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
        M          m   -> M (m >>= \p' -> return (go p'))
        Pure    r      -> Respond 2 (\r -> Pure r)
    go' p = case p of
        Request a' fa  -> Request a' (\a  -> go' (fa  a ))
        Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
        M          m   -> M (m >>= \p' -> return (go' p'))
        Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
    loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


main :: IO ()
main = runEffect (Respond 1 (\b' -> go (Pure b')) >>~ (\a -> go' (Pure a)))
  where
    go p = case p of
        Request a' fa  -> Request a' (\a  -> go (fa  a ))
        Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
        M          m   -> M (m >>= \p' -> return (go p'))
        Pure    r      -> Respond 2 (\r -> Pure r)
    go' p = case p of
        Request a' fa  -> Request a' (\a  -> go' (fa  a ))
        Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
        M          m   -> M (m >>= \p' -> return (go' p'))
        Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
    loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


main :: IO ()
main = runEffect ((\b' -> go (Pure b')) +>> ((\a -> go' (Pure a)) 1))
  where
    go p = case p of
        Request a' fa  -> Request a' (\a  -> go (fa  a ))
        Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
        M          m   -> M (m >>= \p' -> return (go p'))
        Pure    r      -> Respond 2 (\r -> Pure r)
    go' p = case p of
        Request a' fa  -> Request a' (\a  -> go' (fa  a ))
        Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
        M          m   -> M (m >>= \p' -> return (go' p'))
        Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
    loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


main :: IO ()
main = runEffect ((\b' -> go (Pure b')) +>> ((lift (print (1+1))) `_bind` (\_ -> loop)))
  where
    go p = case p of
        Request a' fa  -> Request a' (\a  -> go (fa  a ))
        Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
        M          m   -> M (m >>= \p' -> return (go p'))
        Pure    r      -> Respond 2 (\r -> Pure r)
    go' p = case p of
        Request a' fa  -> Request a' (\a  -> go' (fa  a ))
        Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
        M          m   -> M (m >>= \p' -> return (go' p'))
        Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
    loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


main :: IO ()
main = runEffect ((\b' -> go (Pure b')) +>> (M (print 2 >>= \r -> return (Pure r)) `_bind` (\_ -> loop)))
  where
    go p = case p of
        Request a' fa  -> Request a' (\a  -> go (fa  a ))
        Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
        M          m   -> M (m >>= \p' -> return (go p'))
        Pure    r      -> Respond 2 (\r -> Pure r)
    go' p = case p of
        Request a' fa  -> Request a' (\a  -> go' (fa  a ))
        Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
        M          m   -> M (m >>= \p' -> return (go' p'))
        Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
    loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


main :: IO ()
main = runEffect ((\b' -> go (Pure b')) +>> M ((print 2 >>= \r -> return (Pure r)) >>= \p' -> return (go'' p')))
  where
    go p = case p of
        Request a' fa  -> Request a' (\a  -> go (fa  a ))
        Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
        M          m   -> M (m >>= \p' -> return (go p'))
        Pure    r      -> Respond 2 (\r -> Pure r)
    go' p = case p of
        Request a' fa  -> Request a' (\a  -> go' (fa  a ))
        Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
        M          m   -> M (m >>= \p' -> return (go' p'))
        Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
    go'' p = case p of
        Request a' fa  -> Request a' (\a  -> go'' (fa  a ))
        Respond b  fb' -> Respond b  (\b' -> go'' (fb' b'))
        M          m   -> M (m >>= \p' -> return (go'' p'))
        Pure    r      -> (\_ -> Request () (\a -> go' (Pure a))) r
    loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


main :: IO ()
main = runEffect (M (((print 2 >>= \r -> return (Pure r)) >>= \p' -> return (go'' p')) >>= \p'' -> return ((\b' -> go (Pure b')) +>> p'')))
  where
    go p = case p of
        Request a' fa  -> Request a' (\a  -> go (fa  a ))
        Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
        M          m   -> M (m >>= \p' -> return (go p'))
        Pure    r      -> Respond 2 (\r -> Pure r)
    go' p = case p of
        Request a' fa  -> Request a' (\a  -> go' (fa  a ))
        Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
        M          m   -> M (m >>= \p' -> return (go' p'))
        Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
    go'' p = case p of
        Request a' fa  -> Request a' (\a  -> go'' (fa  a ))
        Respond b  fb' -> Respond b  (\b' -> go'' (fb' b'))
        M          m   -> M (m >>= \p' -> return (go'' p'))
        Pure    r      -> (\_ -> Request () (\a -> go' (Pure a))) r
    loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


main :: IO ()
main = (((print 2 >>= \r -> return (Pure r)) >>= \p' -> return (go'' p')) >>= \p'' -> return ((\b' -> go (Pure b')) +>> p'')) >>= driver
  where
    go p = case p of
        Request a' fa  -> Request a' (\a  -> go (fa  a ))
        Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
        M          m   -> M (m >>= \p' -> return (go p'))
        Pure    r      -> Respond 2 (\r -> Pure r)
    go' p = case p of
        Request a' fa  -> Request a' (\a  -> go' (fa  a ))
        Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
        M          m   -> M (m >>= \p' -> return (go' p'))
        Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
    go'' p = case p of
        Request a' fa  -> Request a' (\a  -> go'' (fa  a ))
        Respond b  fb' -> Respond b  (\b' -> go'' (fb' b'))
        M          m   -> M (m >>= \p' -> return (go'' p'))
        Pure    r      -> (\_ -> Request () (\a -> go' (Pure a))) r
    driver p = case p of
        Request v _ -> closed v
        Respond v _ -> closed v
        M       m   -> m >>= driver
        Pure    r   -> return r
    loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


main :: IO ()
main = do
  r <- print 2
  p' <- return (Pure r)
  p'' <- return (go'' p')
  more <- return ((\b' -> go (Pure b')) +>> p'')
  driver more
    where
      go p = case p of
          Request a' fa  -> Request a' (\a  -> go (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
          M          m   -> M (m >>= \p' -> return (go p'))
          Pure    r      -> Respond 2 (\r -> Pure r)
      go' p = case p of
          Request a' fa  -> Request a' (\a  -> go' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go' p'))
          Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
      go'' p = case p of
          Request a' fa  -> Request a' (\a  -> go'' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go'' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go'' p'))
          Pure    r      -> (\_ -> Request () (\a -> go' (Pure a))) r
      driver p = case p of
          Request v _ -> closed v
          Respond v _ -> closed v
          M       m   -> m >>= driver
          Pure    r   -> return r
      loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


main :: IO ()
main = do
  print 2
  driver ((\b' -> go (Pure b')) +>> (go'' (Pure ())))
    where
      go p = case p of
          Request a' fa  -> Request a' (\a  -> go (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
          M          m   -> M (m >>= \p' -> return (go p'))
          Pure    r      -> Respond 2 (\r -> Pure r)
      go' p = case p of
          Request a' fa  -> Request a' (\a  -> go' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go' p'))
          Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
      go'' p = case p of
          Request a' fa  -> Request a' (\a  -> go'' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go'' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go'' p'))
          Pure    r      -> (\_ -> Request () (\a -> go' (Pure a))) r
      driver p = case p of
          Request v _ -> closed v
          Respond v _ -> closed v
          M       m   -> m >>= driver
          Pure    r   -> return r
      loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


main :: IO ()
main = do
  print 2
  driver ((\b' -> go (Pure b')) +>> (Request () (\a -> go' (Pure a))))
    where
      go p = case p of
          Request a' fa  -> Request a' (\a  -> go (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
          M          m   -> M (m >>= \p' -> return (go p'))
          Pure    r      -> Respond 2 (\r -> Pure r)
      go' p = case p of
          Request a' fa  -> Request a' (\a  -> go' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go' p'))
          Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
      go'' p = case p of
          Request a' fa  -> Request a' (\a  -> go'' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go'' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go'' p'))
          Pure    r      -> (\_ -> Request () (\a -> go' (Pure a))) r
      driver p = case p of
          Request v _ -> closed v
          Respond v _ -> closed v
          M       m   -> m >>= driver
          Pure    r   -> return r
      loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


main :: IO ()
main = do
  print 2
  driver (go (Pure ()) >>~ (\a -> go' (Pure a)))
    where
      go p = case p of
          Request a' fa  -> Request a' (\a  -> go (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
          M          m   -> M (m >>= \p' -> return (go p'))
          Pure    r      -> Respond 2 (\r -> Pure r)
      go' p = case p of
          Request a' fa  -> Request a' (\a  -> go' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go' p'))
          Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
      go'' p = case p of
          Request a' fa  -> Request a' (\a  -> go'' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go'' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go'' p'))
          Pure    r      -> (\_ -> Request () (\a -> go' (Pure a))) r
      driver p = case p of
          Request v _ -> closed v
          Respond v _ -> closed v
          M       m   -> m >>= driver
          Pure    r   -> return r
      loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


main :: IO ()
main = do
  print 2
  driver ((Respond 2 (\r -> Pure r)) >>~ (\a -> go' (Pure a)))
    where
      go p = case p of
          Request a' fa  -> Request a' (\a  -> go (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
          M          m   -> M (m >>= \p' -> return (go p'))
          Pure    r      -> Respond 2 (\r -> Pure r)
      go' p = case p of
          Request a' fa  -> Request a' (\a  -> go' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go' p'))
          Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
      go'' p = case p of
          Request a' fa  -> Request a' (\a  -> go'' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go'' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go'' p'))
          Pure    r      -> (\_ -> Request () (\a -> go' (Pure a))) r
      driver p = case p of
          Request v _ -> closed v
          Respond v _ -> closed v
          M       m   -> m >>= driver
          Pure    r   -> return r
      loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


main :: IO ()
main = do
  print 2
  driver (((\r -> Pure r)) +>> (go' (Pure 2)))
    where
      go p = case p of
          Request a' fa  -> Request a' (\a  -> go (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
          M          m   -> M (m >>= \p' -> return (go p'))
          Pure    r      -> Respond 2 (\r -> Pure r)
      go' p = case p of
          Request a' fa  -> Request a' (\a  -> go' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go' p'))
          Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
      go'' p = case p of
          Request a' fa  -> Request a' (\a  -> go'' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go'' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go'' p'))
          Pure    r      -> (\_ -> Request () (\a -> go' (Pure a))) r
      driver p = case p of
          Request v _ -> closed v
          Respond v _ -> closed v
          M       m   -> m >>= driver
          Pure    r   -> return r
      loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


main :: IO ()
main = do
  print 2
  driver (((\r -> Pure r)) +>> ((lift (print (2+1))) `_bind` (\_ -> loop)))
    where
      go p = case p of
          Request a' fa  -> Request a' (\a  -> go (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
          M          m   -> M (m >>= \p' -> return (go p'))
          Pure    r      -> Respond 2 (\r -> Pure r)
      go' p = case p of
          Request a' fa  -> Request a' (\a  -> go' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go' p'))
          Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
      go'' p = case p of
          Request a' fa  -> Request a' (\a  -> go'' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go'' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go'' p'))
          Pure    r      -> (\_ -> Request () (\a -> go' (Pure a))) r
      driver p = case p of
          Request v _ -> closed v
          Respond v _ -> closed v
          M       m   -> m >>= driver
          Pure    r   -> return r
      loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


main :: IO ()
main = do
  print 2
  driver (((\r -> Pure r)) +>> (M (((print 3) >>= \r -> return (Pure r)) >>= \p' -> return (go''' p'))))
    where
      go p = case p of
          Request a' fa  -> Request a' (\a  -> go (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
          M          m   -> M (m >>= \p' -> return (go p'))
          Pure    r      -> Respond 2 (\r -> Pure r)
      go' p = case p of
          Request a' fa  -> Request a' (\a  -> go' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go' p'))
          Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
      go'' p = case p of
          Request a' fa  -> Request a' (\a  -> go'' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go'' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go'' p'))
          Pure    r      -> (\_ -> Request () (\a -> go' (Pure a))) r
      go''' p = case p of
          Request a' fa  -> Request a' (\a  -> go''' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go''' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go''' p'))
          Pure    r      -> (\_ -> loop) r
      driver p = case p of
          Request v _ -> closed v
          Respond v _ -> closed v
          M       m   -> m >>= driver
          Pure    r   -> return r
      loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


main :: IO ()
main = do
  print 2
  driver (M ((((print 3) >>= \r -> return (Pure r)) >>= \p' -> return (go''' p')) >>= \p'' -> return ((\r -> Pure r) +>> p'')))
    where
      go p = case p of
          Request a' fa  -> Request a' (\a  -> go (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
          M          m   -> M (m >>= \p' -> return (go p'))
          Pure    r      -> Respond 2 (\r -> Pure r)
      go' p = case p of
          Request a' fa  -> Request a' (\a  -> go' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go' p'))
          Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
      go'' p = case p of
          Request a' fa  -> Request a' (\a  -> go'' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go'' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go'' p'))
          Pure    r      -> (\_ -> Request () (\a -> go' (Pure a))) r
      go''' p = case p of
          Request a' fa  -> Request a' (\a  -> go''' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go''' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go''' p'))
          Pure    r      -> (\_ -> loop) r
      driver p = case p of
          Request v _ -> closed v
          Respond v _ -> closed v
          M       m   -> m >>= driver
          Pure    r   -> return r
      loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


main :: IO ()
main = do
  print 2
  ((((print 3) >>= \r -> return (Pure r)) >>= \p' -> return (go''' p')) >>= \p'' -> return ((\r -> Pure r) +>> p'')) >>= driver
    where
      go p = case p of
          Request a' fa  -> Request a' (\a  -> go (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
          M          m   -> M (m >>= \p' -> return (go p'))
          Pure    r      -> Respond 2 (\r -> Pure r)
      go' p = case p of
          Request a' fa  -> Request a' (\a  -> go' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go' p'))
          Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
      go'' p = case p of
          Request a' fa  -> Request a' (\a  -> go'' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go'' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go'' p'))
          Pure    r      -> (\_ -> Request () (\a -> go' (Pure a))) r
      go''' p = case p of
          Request a' fa  -> Request a' (\a  -> go''' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go''' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go''' p'))
          Pure    r      -> (\_ -> loop) r
      driver p = case p of
          Request v _ -> closed v
          Respond v _ -> closed v
          M       m   -> m >>= driver
          Pure    r   -> return r
      loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


main :: IO ()
main = do
  print 2
  r <- print 3
  p' <- return (Pure r)
  p'' <- return (go''' p')
  next <- return ((\r -> Pure r) +>> p'')
  driver next
    where
      go p = case p of
          Request a' fa  -> Request a' (\a  -> go (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
          M          m   -> M (m >>= \p' -> return (go p'))
          Pure    r      -> Respond 2 (\r -> Pure r)
      go' p = case p of
          Request a' fa  -> Request a' (\a  -> go' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go' p'))
          Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
      go'' p = case p of
          Request a' fa  -> Request a' (\a  -> go'' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go'' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go'' p'))
          Pure    r      -> (\_ -> Request () (\a -> go' (Pure a))) r
      go''' p = case p of
          Request a' fa  -> Request a' (\a  -> go''' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go''' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go''' p'))
          Pure    r      -> (\_ -> loop) r
      driver p = case p of
          Request v _ -> closed v
          Respond v _ -> closed v
          M       m   -> m >>= driver
          Pure    r   -> return r
      loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


main :: IO ()
main = do
  print 2
  print 3
  driver ((\r -> Pure r) +>> go''' (Pure ()))
    where
      go p = case p of
          Request a' fa  -> Request a' (\a  -> go (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
          M          m   -> M (m >>= \p' -> return (go p'))
          Pure    r      -> Respond 2 (\r -> Pure r)
      go' p = case p of
          Request a' fa  -> Request a' (\a  -> go' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go' p'))
          Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
      go'' p = case p of
          Request a' fa  -> Request a' (\a  -> go'' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go'' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go'' p'))
          Pure    r      -> (\_ -> Request () (\a -> go' (Pure a))) r
      go''' p = case p of
          Request a' fa  -> Request a' (\a  -> go''' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go''' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go''' p'))
          Pure    r      -> (\_ -> loop) r
      driver p = case p of
          Request v _ -> closed v
          Respond v _ -> closed v
          M       m   -> m >>= driver
          Pure    r   -> return r
      loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


main :: IO ()
main = do
  print 2
  print 3
  driver ((\r -> Pure r) +>> (Request () (\a -> go' (Pure a))))
    where
      go p = case p of
          Request a' fa  -> Request a' (\a  -> go (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
          M          m   -> M (m >>= \p' -> return (go p'))
          Pure    r      -> Respond 2 (\r -> Pure r)
      go' p = case p of
          Request a' fa  -> Request a' (\a  -> go' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go' p'))
          Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
      go'' p = case p of
          Request a' fa  -> Request a' (\a  -> go'' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go'' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go'' p'))
          Pure    r      -> (\_ -> Request () (\a -> go' (Pure a))) r
      go''' p = case p of
          Request a' fa  -> Request a' (\a  -> go''' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go''' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go''' p'))
          Pure    r      -> (\_ -> loop) r
      driver p = case p of
          Request v _ -> closed v
          Respond v _ -> closed v
          M       m   -> m >>= driver
          Pure    r   -> return r
      loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


main :: IO ()
main = do
  print 2
  print 3
  driver ((Pure ()) >>~ (\a -> go' (Pure a)))
    where
      go p = case p of
          Request a' fa  -> Request a' (\a  -> go (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
          M          m   -> M (m >>= \p' -> return (go p'))
          Pure    r      -> Respond 2 (\r -> Pure r)
      go' p = case p of
          Request a' fa  -> Request a' (\a  -> go' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go' p'))
          Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
      go'' p = case p of
          Request a' fa  -> Request a' (\a  -> go'' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go'' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go'' p'))
          Pure    r      -> (\_ -> Request () (\a -> go' (Pure a))) r
      go''' p = case p of
          Request a' fa  -> Request a' (\a  -> go''' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go''' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go''' p'))
          Pure    r      -> (\_ -> loop) r
      driver p = case p of
          Request v _ -> closed v
          Respond v _ -> closed v
          M       m   -> m >>= driver
          Pure    r   -> return r
      loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


main :: IO ()
main = do
  print 2
  print 3
  driver (Pure ())
    where
      go p = case p of
          Request a' fa  -> Request a' (\a  -> go (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
          M          m   -> M (m >>= \p' -> return (go p'))
          Pure    r      -> Respond 2 (\r -> Pure r)
      go' p = case p of
          Request a' fa  -> Request a' (\a  -> go' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go' p'))
          Pure    r      -> (\i -> ((lift (print (i+1))) `_bind` (\_ -> loop))) r
      go'' p = case p of
          Request a' fa  -> Request a' (\a  -> go'' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go'' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go'' p'))
          Pure    r      -> (\_ -> Request () (\a -> go' (Pure a))) r
      go''' p = case p of
          Request a' fa  -> Request a' (\a  -> go''' (fa  a ))
          Respond b  fb' -> Respond b  (\b' -> go''' (fb' b'))
          M          m   -> M (m >>= \p' -> return (go''' p'))
          Pure    r      -> (\_ -> loop) r
      driver p = case p of
          Request v _ -> closed v
          Respond v _ -> closed v
          M       m   -> m >>= driver
          Pure    r   -> return r
      loop = Request () (\a -> go' (Pure a))

equals…

module Main where

import Pipes
import Pipes.Internal
import Pipes.Core
import qualified Pipes.Prelude as PP


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