Merge pull request #106 from narrative/haskell-updates

Update haskell examples.

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`:

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

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)

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)

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

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,7 +19,7 @@ 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
@@ -20,5 +27,5 @@ main = do
      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

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 '.'

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

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

haskell/send.hs

@@ -1,6 +1,13 @@
-{-# 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
 
 main :: IO ()
@@ -13,8 +20,8 @@ main = do
                                queueDurable    = False}
 
      publishMsg ch "" "hello"
-                (newMsg {msgBody         = (BL.pack "Hello World!"),
+                (newMsg {msgBody         = "Hello World!",
                          msgDeliveryMode = Just NonPersistent})
 
-     putStrLn " [x] Sent 'Hello World!'"
+     BL.putStrLn " [x] Sent 'Hello World!'"
      closeConnection conn

haskell/worker.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           Control.Concurrent (threadDelay)
+import qualified Data.ByteString.Lazy.Char8 as BL
+import           Data.Monoid ((<>))
 
 main :: IO ()
 main = do
@@ -14,9 +21,9 @@ main = do
                                queueAutoDelete = False,
                                queueDurable    = True}
 
-     qos ch 0 1
+     qos ch 0 1 False
 
-     putStrLn " [*] Waiting for messages. to Exit press CTRL+C"
+     BL.putStrLn " [*] Waiting for messages. To exit press CTRL+C"
      consumeMsgs ch "task_queue" Ack deliveryHandler
 
      -- waits for keypresses
@@ -25,15 +32,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 '.'