Permalink
Browse files

Fix poll, add test example.

  • Loading branch information...
1 parent 50ce3e1 commit 3c41094a77d961c3f0998ecdc081c0bcca59b264 Toralf Wittner committed Jan 22, 2010
Showing with 53 additions and 15 deletions.
  1. +19 −13 src/System/ZMQ.hs
  2. +3 −2 src/System/ZMQ/Base.hsc
  3. +31 −0 test/poll.hs
View
32 src/System/ZMQ.hs
@@ -50,6 +50,7 @@ import Prelude hiding (init)
import Control.Applicative
import Control.Exception
import Data.Int
+import Data.Maybe
import System.ZMQ.Base
import qualified System.ZMQ.Base as B
import Foreign
@@ -249,24 +250,28 @@ poll fds to = do
createPoll :: [ZMQPoll] -> [Poll] -> IO [Poll]
createPoll [] fd = return fd
createPoll (p:pp) fd = do
- let s = pSocket p; f = pFd p; r = pRevents p
- if r /= 0
- then if f /= 0
- then createPoll pp (F (Fd f) (toEvent r):fd)
- else createPoll pp fd
- else if s /= nullPtr
- then createPoll pp (S (Socket s) (toEvent r):fd)
- else createPoll pp fd
+ let s = pSocket p;
+ f = pFd p;
+ r = toEvent $ pRevents p
+ if isJust r
+ then createPoll pp (newPoll s f r:fd)
+ else createPoll pp fd
+
+ newPoll :: ZMQSocket -> CInt -> Maybe PollEvent -> Poll
+ newPoll s 0 r = S (Socket s) (fromJust r)
+ newPoll _ f r = F (Fd f) (fromJust r)
fromEvent :: PollEvent -> CShort
fromEvent In = fromIntegral . pollVal $ pollIn
fromEvent Out = fromIntegral . pollVal $ pollOut
- fromEvent InOut = fromEvent In .|. fromEvent Out
+ fromEvent InOut = fromIntegral . pollVal $ pollInOut
+
+ toEvent :: CShort -> Maybe PollEvent
+ toEvent e | e == (fromIntegral . pollVal $ pollIn) = Just In
+ | e == (fromIntegral . pollVal $ pollOut) = Just Out
+ | e == (fromIntegral . pollVal $ pollInOut) = Just InOut
+ | otherwise = Nothing
- toEvent :: CShort -> PollEvent
- toEvent e | e == (fromIntegral . pollVal $ pollIn) = In
- | e == (fromIntegral . pollVal $ pollOut) = Out
- | otherwise = InOut
-- internal helpers:
@@ -313,3 +318,4 @@ toZMQFlag NoFlush = noFlush
combine :: [Flag] -> CInt
combine = fromIntegral . foldr ((.|.) . flagVal . toZMQFlag) 0
+
View
5 src/System/ZMQ/Base.hsc
@@ -98,8 +98,9 @@ newtype ZMQFlag = ZMQFlag { flagVal :: CInt } deriving (Eq, Ord)
newtype ZMQPollEvent = ZMQPollEvent { pollVal :: CShort } deriving (Eq, Ord)
#{enum ZMQPollEvent, ZMQPollEvent,
- pollIn = ZMQ_POLLIN,
- pollOut = ZMQ_POLLOUT
+ pollIn = ZMQ_POLLIN,
+ pollOut = ZMQ_POLLOUT,
+ pollInOut = ZMQ_POLLIN | ZMQ_POLLOUT
}
-- general initialization
View
31 test/poll.hs
@@ -0,0 +1,31 @@
+import Control.Applicative
+import Control.Monad
+import System.IO
+import System.Exit
+import System.Environment
+import qualified System.ZMQ as ZMQ
+import qualified Data.ByteString as SB
+
+main :: IO ()
+main = do
+ args <- getArgs
+ when (length args /= 1) $ do
+ hPutStrLn stderr usage
+ exitFailure
+ c <- ZMQ.init 1 1 True
+ s <- ZMQ.socket c ZMQ.Rep
+ let bindTo = head args
+ toPoll = [ZMQ.S s ZMQ.In]
+ ZMQ.bind s bindTo
+ forever $
+ ZMQ.poll toPoll 1000000 >>= receive
+ where
+ receive [] = return ()
+ receive ((ZMQ.S s e):ss) = do
+ msg <- ZMQ.receive s []
+ ZMQ.send s msg []
+ receive ss
+
+usage :: String
+usage = "usage: local_lat <bind-to>"
+

0 comments on commit 3c41094

Please sign in to comment.