Skip to content

Commit e12001f

Browse files
michaelklishinmichaelklishin
authored
Merge pull request rabbitmq#106 from narrative/haskell-updates
Update haskell examples.
2 parents 1c7574d + 3b6a5e9 commit e12001f

File tree

11 files changed

+171
-94
lines changed

11 files changed

+171
-94
lines changed

‎haskell/README.md‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,11 @@ Here you can find Haskell code examples from
77

88
To run this code you need [Network.AMQP](http://hackage.haskell.org/package/amqp).
99

10+
### Running the examples with `stack`
11+
12+
1. Install [`stack`](https://docs.haskellstack.org/en/stable/README/).
13+
2. Run the scripts via ```stack FILE ARGS``` instead of `runhaskell FILE ARGS`. (This installs `ghc`, plus `amqp` and other required packages for you.)
14+
1015
## Code
1116

1217
Code examples are executed via `runhaskell`:

‎haskell/emitLog.hs‎

Lines changed: 15 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,15 @@
1-
{-# OPTIONS -XOverloadedStrings #-}
1+
#!/usr/bin/env stack
2+
{- stack --install-ghc
3+
runghc
4+
--package amqp
5+
--package bytestring
6+
-}
7+
{-# LANGUAGE OverloadedStrings #-}
28

39
import Network.AMQP
410
import qualified Data.ByteString.Lazy.Char8 as BL
11+
import Data.Monoid ((<>))
512
import System.Environment (getArgs)
6-
import Text.Printf
713

814
logsExchange = "logs"
915

@@ -14,15 +20,16 @@ main = do
1420
conn <- openConnection "127.0.0.1" "/" "guest" "guest"
1521
ch <- openChannel conn
1622

17-
declareExchange ch newExchange {exchangeName = logsExchange, exchangeType = "fanout", exchangeDurable = False}
23+
declareExchange ch newExchange {exchangeName = logsExchange,
24+
exchangeType = "fanout",
25+
exchangeDurable = False}
1826
publishMsg ch logsExchange ""
19-
(newMsg {msgBody = (BL.pack body),
27+
(newMsg {msgBody = body,
2028
msgDeliveryMode = Just NonPersistent})
2129

22-
putStrLn $ printf " [x] Sent '%s'" (body)
30+
BL.putStrLn $ " [x] Sent " <> body
2331
closeConnection conn
2432

25-
26-
bodyFor :: [String] -> String
33+
bodyFor :: [String] -> BL.ByteString
2734
bodyFor [] = "Hello, world!"
28-
bodyFor xs = unwords xs
35+
bodyFor xs = BL.pack . unwords $ xs

‎haskell/emitLogDirect.hs‎

Lines changed: 21 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,21 @@
1-
{-# OPTIONS -XOverloadedStrings #-}
1+
#!/usr/bin/env stack
2+
{- stack --install-ghc
3+
runghc
4+
--package amqp
5+
--package bytestring
6+
--package safe
7+
--package text
8+
-}
9+
{-# LANGUAGE OverloadedStrings #-}
210

311
import Network.AMQP
12+
413
import qualified Data.ByteString.Lazy.Char8 as BL
14+
import Data.Maybe (fromMaybe)
15+
import Data.Monoid ((<>))
516
import qualified Data.Text as DT
6-
import System.Environment (getArgs)
7-
import Text.Printf
17+
import Safe (atMay)
18+
import System.Environment (getArgs)
819

920
logsExchange = "direct_logs"
1021

@@ -19,19 +30,15 @@ main = do
1930
declareExchange ch newExchange {exchangeName = logsExchange,
2031
exchangeType = "direct",
2132
exchangeDurable = False}
22-
publishMsg ch logsExchange (DT.pack severity)
23-
(newMsg {msgBody = (BL.pack body),
33+
publishMsg ch logsExchange severity
34+
(newMsg {msgBody = body,
2435
msgDeliveryMode = Just NonPersistent})
2536

26-
putStrLn $ printf " [x] Sent '%s'" (body)
37+
BL.putStrLn $ " [x] Sent " <> body
2738
closeConnection conn
2839

40+
bodyFor :: [String] -> BL.ByteString
41+
bodyFor xs = maybe "Hello world" BL.pack (atMay xs 1)
2942

30-
bodyFor :: [String] -> String
31-
bodyFor [] = "Hello, world!"
32-
bodyFor xs = unwords $ tail xs
33-
34-
35-
severityFor :: [String] -> String
36-
severityFor [] = "info"
37-
severityFor xs = head xs
43+
severityFor :: [String] -> DT.Text
44+
severityFor xs = maybe "info" DT.pack (atMay xs 0)

‎haskell/emitLogTopic.hs‎

Lines changed: 21 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,21 @@
1-
{-# OPTIONS -XOverloadedStrings #-}
1+
#!/usr/bin/env stack
2+
{- stack --install-ghc
3+
runghc
4+
--package amqp
5+
--package bytestring
6+
--package safe
7+
--package text
8+
-}
9+
{-# LANGUAGE OverloadedStrings #-}
210

311
import Network.AMQP
12+
413
import qualified Data.ByteString.Lazy.Char8 as BL
14+
import Data.Maybe (fromMaybe)
15+
import Data.Monoid ((<>))
516
import qualified Data.Text as DT
6-
import System.Environment (getArgs)
7-
import Text.Printf
17+
import Safe (atMay)
18+
import System.Environment (getArgs)
819

920
logsExchange = "topic_logs"
1021

@@ -19,19 +30,15 @@ main = do
1930
declareExchange ch newExchange {exchangeName = logsExchange,
2031
exchangeType = "topic",
2132
exchangeDurable = False}
22-
publishMsg ch logsExchange (DT.pack severity)
23-
(newMsg {msgBody = (BL.pack body),
33+
publishMsg ch logsExchange severity
34+
(newMsg {msgBody = body,
2435
msgDeliveryMode = Just NonPersistent})
2536

26-
putStrLn $ printf " [x] Sent '%s'" (body)
37+
BL.putStrLn $ " [x] Sent " <> body
2738
closeConnection conn
2839

40+
bodyFor :: [String] -> BL.ByteString
41+
bodyFor xs = maybe "Hello world" BL.pack (atMay xs 1)
2942

30-
bodyFor :: [String] -> String
31-
bodyFor [] = "Hello, world!"
32-
bodyFor xs = unwords $ tail xs
33-
34-
35-
severityFor :: [String] -> String
36-
severityFor [] = "anonymous.info"
37-
severityFor xs = head xs
43+
severityFor :: [String] -> DT.Text
44+
severityFor xs = maybe "anonymous.info" DT.pack (atMay xs 0)

‎haskell/newTask.hs‎

Lines changed: 15 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,24 +1,31 @@
1-
{-# OPTIONS -XOverloadedStrings #-}
1+
#!/usr/bin/env stack
2+
{- stack --install-ghc
3+
runghc
4+
--package amqp
5+
--package bytestring
6+
-}
7+
{-# LANGUAGE OverloadedStrings #-}
28

39
import Network.AMQP
10+
411
import qualified Data.ByteString.Lazy.Char8 as BL
5-
import System.Environment (getArgs)
6-
import Text.Printf
12+
import Data.Monoid ((<>))
13+
import System.Environment (getArgs)
714

815
main :: IO ()
916
main = do
1017
args <- getArgs
11-
let body = bodyFor args
18+
let body = bodyFor args
1219
conn <- openConnection "127.0.0.1" "/" "guest" "guest"
1320
ch <- openChannel conn
1421

1522
publishMsg ch "" "task_queue"
16-
(newMsg {msgBody = (BL.pack body),
23+
(newMsg {msgBody = body,
1724
msgDeliveryMode = Just Persistent})
1825

19-
putStrLn $ printf " [x] Sent '%s'" (body)
26+
BL.putStrLn $ " [x] Sent " <> body
2027
closeConnection conn
2128

22-
bodyFor :: [String] -> String
29+
bodyFor :: [String] -> BL.ByteString
2330
bodyFor [] = "Hello, world!"
24-
bodyFor xs = unwords xs
31+
bodyFor xs = BL.pack . unwords $ xs

‎haskell/receive.hs‎

Lines changed: 11 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,14 @@
1-
{-# OPTIONS -XOverloadedStrings #-}
1+
#!/usr/bin/env stack
2+
{- stack --install-ghc
3+
runghc
4+
--package amqp
5+
-}
6+
{-# LANGUAGE OverloadedStrings #-}
27

38
import Network.AMQP
9+
410
import qualified Data.ByteString.Lazy.Char8 as BL
11+
import Data.Monoid ((<>))
512

613
main :: IO ()
714
main = do
@@ -12,13 +19,13 @@ main = do
1219
queueAutoDelete = False,
1320
queueDurable = False}
1421

15-
putStrLn " [*] Waiting for messages. to Exit press CTRL+C"
22+
putStrLn " [*] Waiting for messages. To exit press CTRL+C"
1623
consumeMsgs ch "hello" NoAck deliveryHandler
1724

1825
-- waits for keypresses
1926
getLine
2027
closeConnection conn
2128

2229
deliveryHandler :: (Message, Envelope) -> IO ()
23-
deliveryHandler (msg, metadata) = do
24-
putStrLn $ " [x] Received " ++ (BL.unpack $ msgBody msg)
30+
deliveryHandler (msg, metadata) =
31+
BL.putStrLn $ " [x] Received " <> msgBody msg

‎haskell/receiveLogs.hs‎

Lines changed: 17 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,16 @@
1-
{-# OPTIONS -XOverloadedStrings #-}
1+
#!/usr/bin/env stack
2+
{- stack --install-ghc
3+
runghc
4+
--package amqp
5+
--package bytestring
6+
-}
7+
{-# LANGUAGE OverloadedStrings #-}
28

39
import Network.AMQP
4-
import qualified Data.ByteString.Lazy.Char8 as BL
510

6-
import Control.Concurrent (threadDelay)
11+
import qualified Data.ByteString.Lazy.Char8 as BL
12+
import Data.Monoid ((<>))
13+
import Control.Concurrent (threadDelay)
714

815
logsExchange = "logs"
916

@@ -20,7 +27,7 @@ main = do
2027
queueDurable = False}
2128
bindQueue ch q logsExchange ""
2229

23-
putStrLn " [*] Waiting for messages. to Exit press CTRL+C"
30+
BL.putStrLn " [*] Waiting for messages. To exit press CTRL+C"
2431
consumeMsgs ch q Ack deliveryHandler
2532

2633
-- waits for keypresses
@@ -29,15 +36,13 @@ main = do
2936

3037
deliveryHandler :: (Message, Envelope) -> IO ()
3138
deliveryHandler (msg, metadata) = do
32-
putStrLn $ " [x] Received " ++ body
33-
threadDelay (1000 * n)
34-
putStrLn $ " [x] Done"
39+
BL.putStrLn $ " [x] Received " <> body
40+
threadDelay (1000000 * n)
41+
BL.putStrLn " [x] Done"
3542
ackEnv metadata
3643
where
37-
body = (BL.unpack $ msgBody msg)
44+
body = msgBody msg
3845
n = countDots body
3946

40-
41-
42-
countDots :: [Char] -> Int
43-
countDots s = length $ filter (\c -> c == '.') s
47+
countDots :: BL.ByteString -> Int
48+
countDots = fromIntegral . BL.count '.'

‎haskell/receiveLogsDirect.hs‎

Lines changed: 19 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,20 @@
1-
{-# OPTIONS -XOverloadedStrings #-}
1+
#!/usr/bin/env stack
2+
{- stack --install-ghc
3+
runghc
4+
--package amqp
5+
--package bytestring
6+
--package text
7+
-}
8+
{-# LANGUAGE OverloadedStrings #-}
29

310
import Network.AMQP
11+
12+
import Control.Monad (forM_)
413
import qualified Data.ByteString.Lazy.Char8 as BL
14+
import Data.Monoid ((<>))
515
import qualified Data.Text as DT
6-
import System.Environment (getArgs)
7-
import Text.Printf (printf)
8-
import Control.Monad (forM)
16+
import qualified Data.Text.Encoding as DT
17+
import System.Environment (getArgs)
918

1019
logsExchange = "direct_logs"
1120

@@ -21,9 +30,9 @@ main = do
2130
(q, _, _) <- declareQueue ch newQueue {queueName = "",
2231
queueAutoDelete = True,
2332
queueDurable = False}
24-
forM severities (\s -> bindQueue ch q logsExchange (DT.pack s))
33+
forM_ severities (bindQueue ch q logsExchange . DT.pack)
2534

26-
putStrLn " [*] Waiting for messages. to Exit press CTRL+C"
35+
BL.putStrLn " [*] Waiting for messages. To exit press CTRL+C"
2736
consumeMsgs ch q Ack deliveryHandler
2837

2938
-- waits for keypresses
@@ -32,8 +41,9 @@ main = do
3241

3342
deliveryHandler :: (Message, Envelope) -> IO ()
3443
deliveryHandler (msg, metadata) = do
35-
putStrLn $ printf " [x] %s:%s" (DT.unpack $ envRoutingKey metadata) body
36-
putStrLn $ " [x] Done"
44+
BL.putStrLn $ " [x] " <> key <> ":" <> body
45+
BL.putStrLn " [x] Done"
3746
ackEnv metadata
3847
where
39-
body = (BL.unpack $ msgBody msg)
48+
body = msgBody msg
49+
key = BL.fromStrict . DT.encodeUtf8 $ envRoutingKey metadata

‎haskell/receiveLogsTopic.hs‎

Lines changed: 19 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,20 @@
1-
{-# OPTIONS -XOverloadedStrings #-}
1+
#!/usr/bin/env stack
2+
{- stack --install-ghc
3+
runghc
4+
--package amqp
5+
--package bytestring
6+
--package text
7+
-}
8+
{-# LANGUAGE OverloadedStrings #-}
29

310
import Network.AMQP
11+
12+
import Control.Monad (forM_)
413
import qualified Data.ByteString.Lazy.Char8 as BL
14+
import Data.Monoid ((<>))
515
import qualified Data.Text as DT
6-
import System.Environment (getArgs)
7-
import Text.Printf (printf)
8-
import Control.Monad (forM)
16+
import qualified Data.Text.Encoding as DT
17+
import System.Environment (getArgs)
918

1019
logsExchange = "topic_logs"
1120

@@ -21,9 +30,9 @@ main = do
2130
(q, _, _) <- declareQueue ch newQueue {queueName = "",
2231
queueAutoDelete = True,
2332
queueDurable = False}
24-
forM severities (\s -> bindQueue ch q logsExchange (DT.pack s))
33+
forM_ severities (bindQueue ch q logsExchange . DT.pack)
2534

26-
putStrLn " [*] Waiting for messages. to Exit press CTRL+C"
35+
BL.putStrLn " [*] Waiting for messages. To exit press CTRL+C"
2736
consumeMsgs ch q Ack deliveryHandler
2837

2938
-- waits for keypresses
@@ -32,8 +41,9 @@ main = do
3241

3342
deliveryHandler :: (Message, Envelope) -> IO ()
3443
deliveryHandler (msg, metadata) = do
35-
putStrLn $ printf " [x] %s:%s" (DT.unpack $ envRoutingKey metadata) body
36-
putStrLn $ " [x] Done"
44+
BL.putStrLn $ " [x] " <> key <> ":" <> body
45+
BL.putStrLn " [x] Done"
3746
ackEnv metadata
3847
where
39-
body = (BL.unpack $ msgBody msg)
48+
body = msgBody msg
49+
key = BL.fromStrict . DT.encodeUtf8 $ envRoutingKey metadata

0 commit comments

Comments
 (0)