gistfile1.hs

import System.ZMQ3
import Data.ByteString.Char8 (unpack, pack)
import Control.Monad (unless, forever)
import Control.Concurrent (threadDelay, forkOS, forkIO, yield)
import Data.List (intercalate)
import Data.Maybe (fromJust)

import ZmqConfig

main :: IO ()
main = do
  putStrLn "====== Starting Up Metronome ======"
  forkOS $ startMetronome 1
  forkOS $ startMetronome 3

  putStrLn "And now to sleep while they run"
  -- And sleep for a while
  threadDelay $ secondsToMicroseconds 30

startMetronome :: Int -> IO ()
startMetronome seconds = do
  putStrLn $ "Building " ++ (show seconds)
  withContext $ \context -> do
    buildSocket context $ \socket ->
      forever $ do
        putStrLn $ "Running a " ++ (show seconds)
        responses <- sendReceiveLoop socket
        mapM_ (putStrLn . unpack) responses
        putStrLn $ "Sent and received from " ++ (show seconds)
        threadDelay $ secondsToMicroseconds seconds
        yield
  return ()
    where
      sendReceiveLoop socket = mapM (\msg -> do
              putStrLn $ "Just before sending message " ++ unpack msg
              send socket [] msg
              putStrLn $ "Just after sending message " ++ unpack msg
              receive socket
            ) (messages (show seconds))


messages note = map pack [
  publish "output" "hi from: " ++ note
  {- ,publish "output" "ohh, yes" -}
  ]

publish channel message = intercalate " " ["pub", channel, message]

-- The configuration
defaultRouterURL = "tcp://localhost:7000"
defaultSocketName = "Haskell"

data Configuration = Configuration {
                      socketName :: String,
                      routerUrl :: String
                     }

buildSocket context f = withSocket context Req $ \req -> do
    config <- readConfiguration "development"
    setIdentity (restrict $ pack (socketName config)) req
    connect req (routerUrl config)
    f req

readConfiguration env = do
  config <- parseConfig "test.yml"
  let devConfig = fromJust $ descend env config
  let socket = configWithDefault "name" defaultSocketName devConfig
  let router = configWithDefault "routerUrl" defaultRouterURL devConfig
  return Configuration { socketName = socket, routerUrl = router }

-- Convert a given number of seconds to the equivalent amount of time in
-- microseconds
secondsToMicroseconds :: Int -> Int
secondsToMicroseconds i = i * 10 ^ 6

output

➜  zmq_haskell git:(master) ✗ ./zmq +RTS -N2
====== Starting Up Metronome ======
Building 1
Building 3
Running a 1
Just before sending message pub output hi from: 1
Running a 3
And now to sleep while they run
Just after sending message pub output hi from: 1
Just before sending message pub output hi from: 3
Just after sending message pub output hi from: 3
ok
Sent and received from 1
Running a 1
Just before sending message pub output hi from: 1
Just after sending message pub output hi from: 1
ok
Sent and received from 1
Running a 1
Just before sending message pub output hi from: 1
Just after sending message pub output hi from: 1
ok
Sent and received from 1
Running a 1
Just before sending message pub output hi from: 1
Just after sending message pub output hi from: 1
ok
Sent and received from 1
^C
➜  zmq_haskell git:(master) ✗