From d9ffc13cef1f4a7d8f8f9dd4eae517b7d3c00ac3 Mon Sep 17 00:00:00 2001
From: Michael Klishin <michael@clojurewerkz.org>
Date: Tue, 15 Oct 2013 01:49:45 +0400
Subject: [PATCH] Port tutorial 5 to Haskell

---
 haskell/emitLogTopic.hs     | 37 +++++++++++++++++++++++++++++++++++
 haskell/receiveLogsTopic.hs | 39 +++++++++++++++++++++++++++++++++++++
 2 files changed, 76 insertions(+)
 create mode 100644 haskell/emitLogTopic.hs
 create mode 100644 haskell/receiveLogsTopic.hs

diff --git a/haskell/emitLogTopic.hs b/haskell/emitLogTopic.hs
new file mode 100644
index 0000000..a00118d
--- /dev/null
+++ b/haskell/emitLogTopic.hs
@@ -0,0 +1,37 @@
+{-# OPTIONS -XOverloadedStrings #-}
+
+import Network.AMQP
+import qualified Data.ByteString.Lazy.Char8 as BL
+import qualified Data.Text as DT
+import System.Environment (getArgs)
+import Text.Printf
+
+logsExchange = "topic_logs"
+
+main :: IO ()
+main = do
+     args  <- getArgs
+     let body     = bodyFor args
+         severity = severityFor args
+     conn  <- openConnection "127.0.0.1" "/" "guest" "guest"
+     ch    <- openChannel conn
+
+     declareExchange ch newExchange {exchangeName    = logsExchange,
+                                     exchangeType    = "topic",
+                                     exchangeDurable = False}
+     publishMsg ch logsExchange (DT.pack severity)
+                (newMsg {msgBody = (BL.pack body),
+                         msgDeliveryMode = Just NonPersistent})
+
+     putStrLn $ printf " [x] Sent '%s'" (body)
+     closeConnection conn
+
+
+bodyFor :: [String] -> String
+bodyFor [] = "Hello, world!"
+bodyFor xs = unwords $ tail xs
+
+
+severityFor :: [String] -> String
+severityFor [] = "anonymous.info"
+severityFor xs = head xs
diff --git a/haskell/receiveLogsTopic.hs b/haskell/receiveLogsTopic.hs
new file mode 100644
index 0000000..87f352f
--- /dev/null
+++ b/haskell/receiveLogsTopic.hs
@@ -0,0 +1,39 @@
+{-# OPTIONS -XOverloadedStrings #-}
+
+import Network.AMQP
+import qualified Data.ByteString.Lazy.Char8 as BL
+import qualified Data.Text as DT
+import System.Environment (getArgs)
+import Text.Printf (printf)
+import Control.Monad (forM)
+
+logsExchange = "topic_logs"
+
+main :: IO ()
+main = do
+     conn       <- openConnection "127.0.0.1" "/" "guest" "guest"
+     ch         <- openChannel conn
+     severities <- getArgs
+
+     declareExchange ch newExchange {exchangeName    = logsExchange,
+                                     exchangeType    = "topic",
+                                     exchangeDurable = False}
+     (q, _, _) <- declareQueue ch newQueue {queueName       = "",
+                                            queueAutoDelete = True,
+                                            queueDurable    = False}
+     forM severities (\s -> bindQueue ch q logsExchange (DT.pack s))
+
+     putStrLn " [*] Waiting for messages. to Exit press CTRL+C"
+     consumeMsgs ch q Ack deliveryHandler
+
+     -- waits for keypresses
+     getLine
+     closeConnection conn
+
+deliveryHandler :: (Message, Envelope) -> IO ()
+deliveryHandler (msg, metadata) = do
+  putStrLn $ printf " [x] %s:%s" (DT.unpack $ envRoutingKey metadata) body
+  putStrLn $ " [x] Done"
+  ackEnv metadata
+  where
+    body = (BL.unpack $ msgBody msg)