-
-
Save cschneid/3862b33c29a803be7848 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 | |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
➜ 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) ✗ |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment