[Haskell] RabbitMQ Conduit source

Main.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes  #-}

module Main where

import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.ByteString.Char8 as BL (pack, unpack)
import Data.Conduit
import Data.Conduit.Binary (sinkHandle)
import Data.Conduit.List as CL
import Data.Text (Text)
import Debug.Trace
import Network.AMQP
import Network.AMQP.Conduit
import System.IO

main :: IO ()
main = do
  putStrLn $ show (amqpUri config)
  conn  <- createConnectionChannel config
  messagesSource conn Ack "test-queue"
    $= CL.map (BL.pack . show . fst)
    $$ sinkHandle stdout

messagesSource :: MonadIO m => AmqpConn -> Ack -> Text -> Producer m (Message, Envelope)
messagesSource conn ack q = loop
  where
    loop = do
      mmsg <- liftIO $ getMsg chan ack q
      case mmsg of
        Just (m, e) -> do
          yield (m, e)
          liftIO $ ackMsg chan (envDeliveryTag e) False
          loop
        Nothing     -> loop
    chan = fst $ amqpChan conn


config :: AmqpConf
config = AmqpConf "amqp://guest:guest@192.168.99.100:5672/" queue exchange "*"
    where
        exchange = newExchange {exchangeName = "myExchange", exchangeType = "direct"}
        queue = newQueue {queueName = "test-queue"}