Skip to content

Instantly share code, notes, and snippets.

@rrichardson
Created May 19, 2010 15:22
Show Gist options
  • Save rrichardson/406413 to your computer and use it in GitHub Desktop.
Save rrichardson/406413 to your computer and use it in GitHub Desktop.
syncRequests :: BsonDoc -> [Peer] -> IO [BsonDoc]
syncRequests doc prs = do
sem <- newQSem (length prs)
c <- newChan
forM_ prs $ \p -> do
(mid, msg) <- initMessage p MsgTypeCall 0 doc
registerSync p c sem mid
putMessage (pConn p) msg
waitQSem sem
collect (length prs) c []
where collect 0 _ acc = return acc
collect count chan acc = do !i <- readChan chan; print i; collect (count - 1) chan (i:acc)
registerSync :: Peer -> Chan BsonDoc -> QSem -> Int64 -> IO ()
registerSync p chan sem mid = do
let cb = ServiceCallback (\doc -> writeChan chan doc >> signalQSem sem >> return Nothing)
addCallback (pPending p) mid cb
call doc (Faction prs) = syncRequests doc prs
{- client -}
main = do
let msg = [(L8.fromString "test1", toBson (12345 :: Int64))]
ports <- liftM (map read) getArgs
friends <- forM ports (connectPeer "127.0.0.1")
--asyncCall msg (ServiceCallback handleResponse) (Faction friends)
call msg (Faction friends)
putStrLn "done"
handleResponse :: BsonDoc -> IO (Maybe (BsonDoc, ServiceCallback))
handleResponse doc = do
putStrLn $ "received response from peer" ++ show doc
return Nothing
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment