Update haskell examples.

- Add support for running examples easily with `stack`. - Fix calls made to `threadDelay` that were using milliseconds intead of nanoseconds. - amqp-0.9 added a Bool parameter to the `qos` that was causing worker.hs to not compile. - Removed almost all use of String in favor of Lazy ByteString.
rabbitmq · Dec 16, 2016 · 3b6a5e9 · 3b6a5e9
1 parent 1c7574d
commit 3b6a5e9
Show file tree

Hide file tree

Showing 11 changed files with 171 additions and 94 deletions.
diff --git a/haskell/README.md b/haskell/README.md
@@ -7,6 +7,11 @@ Here you can find Haskell code examples from
 
 To run this code you need [Network.AMQP](http://hackage.haskell.org/package/amqp).
 
+### Running the examples with `stack`
+
+1. Install [`stack`](https://docs.haskellstack.org/en/stable/README/).
+2. Run the scripts via ```stack FILE ARGS``` instead of `runhaskell FILE ARGS`. (This installs `ghc`, plus `amqp` and other required packages for you.)
+
 ## Code
 
 Code examples are executed via `runhaskell`:

diff --git a/haskell/emitLog.hs b/haskell/emitLog.hs
@@ -1,9 +1,15 @@
-{-# OPTIONS -XOverloadedStrings #-}
+#!/usr/bin/env stack
+{- stack --install-ghc
+    runghc
+    --package amqp
+    --package bytestring
+-}
+{-# LANGUAGE OverloadedStrings #-}
 
 import Network.AMQP
 import qualified Data.ByteString.Lazy.Char8 as BL
+import Data.Monoid ((<>))
 import System.Environment (getArgs)
-import Text.Printf
 
 logsExchange = "logs"
 
@@ -14,15 +20,16 @@ main = do
      conn  <- openConnection "127.0.0.1" "/" "guest" "guest"
      ch    <- openChannel conn
 
-     declareExchange ch newExchange {exchangeName = logsExchange, exchangeType = "fanout", exchangeDurable = False}
+     declareExchange ch newExchange {exchangeName    = logsExchange,
+                                     exchangeType    = "fanout",
+                                     exchangeDurable = False}
      publishMsg ch logsExchange ""
-                (newMsg {msgBody = (BL.pack body),
+                (newMsg {msgBody = body,
                          msgDeliveryMode = Just NonPersistent})
 
-     putStrLn $ printf " [x] Sent '%s'" (body)
+     BL.putStrLn $ " [x] Sent " <> body
      closeConnection conn
 
-
-bodyFor :: [String] -> String
+bodyFor :: [String] -> BL.ByteString
 bodyFor [] = "Hello, world!"
-bodyFor xs = unwords xs
+bodyFor xs = BL.pack . unwords $ xs
diff --git a/haskell/emitLogDirect.hs b/haskell/emitLogDirect.hs
@@ -1,10 +1,21 @@
-{-# OPTIONS -XOverloadedStrings #-}
+#!/usr/bin/env stack
+{- stack --install-ghc
+    runghc
+    --package amqp
+    --package bytestring
+    --package safe
+    --package text
+-}
+{-# LANGUAGE OverloadedStrings #-}
 
 import Network.AMQP
+
 import qualified Data.ByteString.Lazy.Char8 as BL
+import           Data.Maybe (fromMaybe)
+import           Data.Monoid ((<>))
 import qualified Data.Text as DT
-import System.Environment (getArgs)
-import Text.Printf
+import           Safe (atMay)
+import           System.Environment (getArgs)
 
 logsExchange = "direct_logs"
 
@@ -19,19 +30,15 @@ main = do
      declareExchange ch newExchange {exchangeName    = logsExchange,
                                      exchangeType    = "direct",
                                      exchangeDurable = False}
-     publishMsg ch logsExchange (DT.pack severity)
-                (newMsg {msgBody = (BL.pack body),
+     publishMsg ch logsExchange severity
+                (newMsg {msgBody = body,
                          msgDeliveryMode = Just NonPersistent})
 
-     putStrLn $ printf " [x] Sent '%s'" (body)
+     BL.putStrLn $ " [x] Sent " <> body
      closeConnection conn
 
+bodyFor :: [String] -> BL.ByteString
+bodyFor xs = maybe "Hello world" BL.pack (atMay xs 1)
 
-bodyFor :: [String] -> String
-bodyFor [] = "Hello, world!"
-bodyFor xs = unwords $ tail xs
-
-
-severityFor :: [String] -> String
-severityFor [] = "info"
-severityFor xs = head xs
+severityFor :: [String] -> DT.Text
+severityFor xs = maybe "info" DT.pack (atMay xs 0)
diff --git a/haskell/emitLogTopic.hs b/haskell/emitLogTopic.hs
@@ -1,10 +1,21 @@
-{-# OPTIONS -XOverloadedStrings #-}
+#!/usr/bin/env stack
+{- stack --install-ghc
+    runghc
+    --package amqp
+    --package bytestring
+    --package safe
+    --package text
+-}
+{-# LANGUAGE OverloadedStrings #-}
 
 import Network.AMQP
+
 import qualified Data.ByteString.Lazy.Char8 as BL
+import           Data.Maybe (fromMaybe)
+import           Data.Monoid ((<>))
 import qualified Data.Text as DT
-import System.Environment (getArgs)
-import Text.Printf
+import           Safe (atMay)
+import           System.Environment (getArgs)
 
 logsExchange = "topic_logs"
 
@@ -19,19 +30,15 @@ main = do
      declareExchange ch newExchange {exchangeName    = logsExchange,
                                      exchangeType    = "topic",
                                      exchangeDurable = False}
-     publishMsg ch logsExchange (DT.pack severity)
-                (newMsg {msgBody = (BL.pack body),
+     publishMsg ch logsExchange severity
+                (newMsg {msgBody = body,
                          msgDeliveryMode = Just NonPersistent})
 
-     putStrLn $ printf " [x] Sent '%s'" (body)
+     BL.putStrLn $ " [x] Sent " <> body
      closeConnection conn
 
+bodyFor :: [String] -> BL.ByteString
+bodyFor xs = maybe "Hello world" BL.pack (atMay xs 1)
 
-bodyFor :: [String] -> String
-bodyFor [] = "Hello, world!"
-bodyFor xs = unwords $ tail xs
-
-
-severityFor :: [String] -> String
-severityFor [] = "anonymous.info"
-severityFor xs = head xs
+severityFor :: [String] -> DT.Text
+severityFor xs = maybe "anonymous.info" DT.pack (atMay xs 0)
diff --git a/haskell/newTask.hs b/haskell/newTask.hs
@@ -1,24 +1,31 @@
-{-# OPTIONS -XOverloadedStrings #-}
+#!/usr/bin/env stack
+{- stack --install-ghc
+    runghc
+    --package amqp
+    --package bytestring
+-}
+{-# LANGUAGE OverloadedStrings #-}
 
 import Network.AMQP
+
 import qualified Data.ByteString.Lazy.Char8 as BL
-import System.Environment (getArgs)
-import Text.Printf
+import           Data.Monoid ((<>))
+import           System.Environment (getArgs)
 
 main :: IO ()
 main = do
      args  <- getArgs
-     let body  = bodyFor args
+     let body = bodyFor args
      conn  <- openConnection "127.0.0.1" "/" "guest" "guest"
      ch    <- openChannel conn
 
      publishMsg ch "" "task_queue"
-                (newMsg {msgBody         = (BL.pack body),
+                (newMsg {msgBody         = body,
                          msgDeliveryMode = Just Persistent})
 
-     putStrLn $ printf " [x] Sent '%s'" (body)
+     BL.putStrLn $ " [x] Sent " <> body
      closeConnection conn
 
-bodyFor :: [String] -> String
+bodyFor :: [String] -> BL.ByteString
 bodyFor [] = "Hello, world!"
-bodyFor xs = unwords xs
+bodyFor xs = BL.pack . unwords $ xs
diff --git a/haskell/receive.hs b/haskell/receive.hs
@@ -1,7 +1,14 @@
-{-# OPTIONS -XOverloadedStrings #-}
+#!/usr/bin/env stack
+{- stack --install-ghc
+    runghc
+    --package amqp
+-}
+{-# LANGUAGE OverloadedStrings #-}
 
 import Network.AMQP
+
 import qualified Data.ByteString.Lazy.Char8 as BL
+import           Data.Monoid ((<>))
 
 main :: IO ()
 main = do
@@ -12,13 +19,13 @@ main = do
                                queueAutoDelete = False,
                                queueDurable    = False}
 
-     putStrLn " [*] Waiting for messages. to Exit press CTRL+C"
+     putStrLn " [*] Waiting for messages. To exit press CTRL+C"
      consumeMsgs ch "hello" NoAck deliveryHandler
 
      -- waits for keypresses
      getLine
      closeConnection conn
 
 deliveryHandler :: (Message, Envelope) -> IO ()
-deliveryHandler (msg, metadata) = do
-  putStrLn $ " [x] Received " ++ (BL.unpack $ msgBody msg)
+deliveryHandler (msg, metadata) =
+  BL.putStrLn $ " [x] Received " <> msgBody msg
diff --git a/haskell/receiveLogs.hs b/haskell/receiveLogs.hs
@@ -1,9 +1,16 @@
-{-# OPTIONS -XOverloadedStrings #-}
+#!/usr/bin/env stack
+{- stack --install-ghc
+    runghc
+    --package amqp
+    --package bytestring
+-}
+{-# LANGUAGE OverloadedStrings #-}
 
 import Network.AMQP
-import qualified Data.ByteString.Lazy.Char8 as BL
 
-import Control.Concurrent (threadDelay)
+import qualified Data.ByteString.Lazy.Char8 as BL
+import           Data.Monoid ((<>))
+import           Control.Concurrent (threadDelay)
 
 logsExchange = "logs"
 
@@ -20,7 +27,7 @@ main = do
                                             queueDurable    = False}
      bindQueue ch q logsExchange ""
 
-     putStrLn " [*] Waiting for messages. to Exit press CTRL+C"
+     BL.putStrLn " [*] Waiting for messages. To exit press CTRL+C"
      consumeMsgs ch q Ack deliveryHandler
 
      -- waits for keypresses
@@ -29,15 +36,13 @@ main = do
 
 deliveryHandler :: (Message, Envelope) -> IO ()
 deliveryHandler (msg, metadata) = do
-  putStrLn $ " [x] Received " ++ body
-  threadDelay (1000 * n)
-  putStrLn $ " [x] Done"
+  BL.putStrLn $ " [x] Received " <> body
+  threadDelay (1000000 * n)
+  BL.putStrLn " [x] Done"
   ackEnv metadata
   where
-    body = (BL.unpack $ msgBody msg)
+    body = msgBody msg
     n    = countDots body
 
-
-
-countDots :: [Char] -> Int
-countDots s = length $ filter (\c -> c == '.') s
+countDots :: BL.ByteString -> Int
+countDots = fromIntegral . BL.count '.'
diff --git a/haskell/receiveLogsDirect.hs b/haskell/receiveLogsDirect.hs
@@ -1,11 +1,20 @@
-{-# OPTIONS -XOverloadedStrings #-}
+#!/usr/bin/env stack
+{- stack --install-ghc
+    runghc
+    --package amqp
+    --package bytestring
+    --package text
+-}
+{-# LANGUAGE OverloadedStrings #-}
 
 import Network.AMQP
+
+import           Control.Monad (forM_)
 import qualified Data.ByteString.Lazy.Char8 as BL
+import           Data.Monoid ((<>))
 import qualified Data.Text as DT
-import System.Environment (getArgs)
-import Text.Printf (printf)
-import Control.Monad (forM)
+import qualified Data.Text.Encoding as DT
+import           System.Environment (getArgs)
 
 logsExchange = "direct_logs"
 
@@ -21,9 +30,9 @@ main = do
      (q, _, _) <- declareQueue ch newQueue {queueName       = "",
                                             queueAutoDelete = True,
                                             queueDurable    = False}
-     forM severities (\s -> bindQueue ch q logsExchange (DT.pack s))
+     forM_ severities (bindQueue ch q logsExchange . DT.pack)
 
-     putStrLn " [*] Waiting for messages. to Exit press CTRL+C"
+     BL.putStrLn " [*] Waiting for messages. To exit press CTRL+C"
      consumeMsgs ch q Ack deliveryHandler
 
      -- waits for keypresses
@@ -32,8 +41,9 @@ main = do
 
 deliveryHandler :: (Message, Envelope) -> IO ()
 deliveryHandler (msg, metadata) = do
-  putStrLn $ printf " [x] %s:%s" (DT.unpack $ envRoutingKey metadata) body
-  putStrLn $ " [x] Done"
+  BL.putStrLn $ " [x] " <> key <> ":" <> body
+  BL.putStrLn " [x] Done"
   ackEnv metadata
   where
-    body = (BL.unpack $ msgBody msg)
+    body = msgBody msg
+    key  = BL.fromStrict . DT.encodeUtf8 $ envRoutingKey metadata
diff --git a/haskell/receiveLogsTopic.hs b/haskell/receiveLogsTopic.hs
@@ -1,11 +1,20 @@
-{-# OPTIONS -XOverloadedStrings #-}
+#!/usr/bin/env stack
+{- stack --install-ghc
+    runghc
+    --package amqp
+    --package bytestring
+    --package text
+-}
+{-# LANGUAGE OverloadedStrings #-}
 
 import Network.AMQP
+
+import           Control.Monad (forM_)
 import qualified Data.ByteString.Lazy.Char8 as BL
+import           Data.Monoid ((<>))
 import qualified Data.Text as DT
-import System.Environment (getArgs)
-import Text.Printf (printf)
-import Control.Monad (forM)
+import qualified Data.Text.Encoding as DT
+import           System.Environment (getArgs)
 
 logsExchange = "topic_logs"
 
@@ -21,9 +30,9 @@ main = do
      (q, _, _) <- declareQueue ch newQueue {queueName       = "",
                                             queueAutoDelete = True,
                                             queueDurable    = False}
-     forM severities (\s -> bindQueue ch q logsExchange (DT.pack s))
+     forM_ severities (bindQueue ch q logsExchange . DT.pack)
 
-     putStrLn " [*] Waiting for messages. to Exit press CTRL+C"
+     BL.putStrLn " [*] Waiting for messages. To exit press CTRL+C"
      consumeMsgs ch q Ack deliveryHandler
 
      -- waits for keypresses
@@ -32,8 +41,9 @@ main = do
 
 deliveryHandler :: (Message, Envelope) -> IO ()
 deliveryHandler (msg, metadata) = do
-  putStrLn $ printf " [x] %s:%s" (DT.unpack $ envRoutingKey metadata) body
-  putStrLn $ " [x] Done"
+  BL.putStrLn $ " [x] " <> key <> ":" <> body
+  BL.putStrLn " [x] Done"
   ackEnv metadata
   where
-    body = (BL.unpack $ msgBody msg)
+    body = msgBody msg
+    key  = BL.fromStrict . DT.encodeUtf8 $ envRoutingKey metadata