zeromq-haskell 0.8.1 → 0.8.2
raw patch · 7 files changed
+134/−302 lines, 7 filesdep +QuickCheckdep +test-framework-quickcheck2dep −HUnitdep −test-framework-hunit
Dependencies added: QuickCheck, test-framework-quickcheck2
Dependencies removed: HUnit, test-framework-hunit
Files
- README.md +5/−4
- src/System/ZMQ.hs +5/−85
- src/System/ZMQ/Base.hsc +1/−64
- src/System/ZMQ/Internal.hs +4/−20
- tests/System/ZMQ/Test/Properties.hs +108/−0
- tests/tests.hs +4/−109
- zeromq-haskell.cabal +7/−20
README.md view
@@ -5,6 +5,11 @@ This software currently has *beta* status, i.e. it had seen limited testing. +Version 0.8.2 - Revert changes to support 0MQ 2.x as well as 3.x in a single+package. Instead git branches will be used to track the various 0MQ versions+and a separate zeromq-haskell-3 library will be released to hackage.+Also this releases handles EINTR properly in socket option setting/getting.+ Version 0.8.1 - zmqVersion has been renamed to version and reports the runtime version of 0MQ, instead of the compile time version macros. @@ -29,10 +34,6 @@ As usual for Haskell packages this software is installed best via Cabal (http://www.haskell.org/cabal). In addition to GHC it depends on 0MQ of course.-Please note that by default zeromq-haskell attempts to compile against 0MQ 2.x.-If instead you want to use 0MQ 3.x, then provide the following flags to Cabal:-- --flags="-zmq2 zmq3" Notes -----
src/System/ZMQ.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, ExistentialQuantification #-}+{-# LANGUAGE ExistentialQuantification #-} -- | -- Module : System.ZMQ -- Copyright : (c) 2010-2011 Toralf Wittner@@ -29,31 +29,19 @@ , Pair(..) , Pub(..) , Sub(..)-#ifdef ZMQ3- , XPub(..)- , XSub(..)-#endif , Req(..) , Rep(..) , XReq(..) , XRep(..) , Pull(..) , Push(..)--#ifdef ZMQ2 , Up(..) , Down(..)-#endif , withContext , withSocket , setOption , getOption--#ifdef ZMQ3- , getMsgOption-#endif- , System.ZMQ.subscribe , System.ZMQ.unsubscribe , bind@@ -71,10 +59,8 @@ , socket , close -#ifdef ZMQ2 , Device(..) , device-#endif ) where @@ -123,25 +109,6 @@ instance SType Sub where zmqSocketType = const sub -#ifdef ZMQ3--- | Same as 'Pub' except that you can receive subscriptions from the--- peers in form of incoming messages. Subscription message is a byte 1--- (for subscriptions) or byte 0 (for unsubscriptions) followed by the--- subscription body.--- /Compatible peer sockets/: 'Sub', 'XSub'.-data XPub = XPub-instance SType XPub where- zmqSocketType = const xpub---- | Same as 'Sub' except that you subscribe by sending subscription--- messages to the socket. Subscription message is a byte 1 (for subscriptions)--- or byte 0 (for unsubscriptions) followed by the subscription body.--- /Compatible peer sockets/: 'Pub', 'XPub'.-data XSub = XSub-instance SType XSub where- zmqSocketType = const xsub-#endif- -- | Socket to send requests and receive replies. Requests are -- load-balanced among all the peers. This socket type allows only an -- alternated sequence of send's and recv's.@@ -200,7 +167,6 @@ instance SType Push where zmqSocketType = const push -#ifdef ZMQ2 {-# DEPRECATED Up "Use Pull instead." #-} -- | Socket to receive messages from up the stream. Messages are -- fair-queued from among all the connected peers. Send function is not@@ -216,15 +182,11 @@ data Down = Down instance SType Down where zmqSocketType = const downstream-#endif -- | Subscribable. class SubsType a instance SubsType Sub-#ifdef ZMQ3-instance SubsType XSub-#endif -- | The option to set on 0MQ sockets (cf. zmq_setsockopt and zmq_getsockopt -- manpages for details).@@ -232,7 +194,7 @@ Affinity Word64 -- ^ ZMQ_AFFINITY | Backlog CInt -- ^ ZMQ_BACKLOG | Events PollEvent -- ^ ZMQ_EVENTS- | FD Int -- ^ ZMQ_FD+ | FD CInt -- ^ ZMQ_FD | Identity String -- ^ ZMQ_IDENTITY | Linger CInt -- ^ ZMQ_LINGER | Rate Int64 -- ^ ZMQ_RATE@@ -242,28 +204,12 @@ | ReconnectIVLMax CInt -- ^ ZMQ_RECONNECT_IVL_MAX | RecoveryIVL Int64 -- ^ ZMQ_RECOVERY_IVL | SendBuf Word64 -- ^ ZMQ_SNDBUF-#ifdef ZMQ2 | HighWM Word64 -- ^ ZMQ_HWM | McastLoop Bool -- ^ ZMQ_MCAST_LOOP | RecoveryIVLMsec Int64 -- ^ ZMQ_RECOVERY_IVL_MSEC | Swap Int64 -- ^ ZMQ_SWAP-#endif-#ifdef ZMQ3- | IPv4Only Bool -- ^ ZMQ_IPV4ONLY- | MaxMsgSize Int64 -- ^ ZMQ_MAXMSGSIZE- | McastHops Int -- ^ ZMQ_MULTICAST_HOPS- | ReceiveHighWM Int -- ^ ZMQ_RCVHWM- | ReceiveTimeout Int -- ^ ZMQ_RCVTIMEO- | SendHighWM Int -- ^ ZMQ_SNDHWM- | SendTimeout Int -- ^ ZMQ_SNDTIMEO-#endif deriving (Eq, Ord, Show) -#ifdef ZMQ3-data MessageOption = MoreMsgParts CInt -- ^ ZMQ_MORE- deriving (Eq, Ord, Show)-#endif- -- | The events to wait for in poll (cf. man zmq_poll) data PollEvent = In -- ^ ZMQ_POLLIN (incoming messages)@@ -300,21 +246,10 @@ setOption s (ReconnectIVLMax o) = setIntOpt s reconnectIVLMax o setOption s (RecoveryIVL o) = setIntOpt s recoveryIVL o setOption s (SendBuf o) = setIntOpt s sendBuf o-#ifdef ZMQ2 setOption s (HighWM o) = setIntOpt s highWM o setOption s (McastLoop o) = setBoolOpt s mcastLoop o setOption s (RecoveryIVLMsec o) = setIntOpt s recoveryIVLMsec o setOption s (Swap o) = setIntOpt s swap o-#endif-#ifdef ZMQ3-setOption s (IPv4Only o) = setBoolOpt s ipv4Only o-setOption s (MaxMsgSize o) = setIntOpt s maxMessageSize o-setOption s (McastHops o) = setIntOpt s mcastHops o-setOption s (ReceiveHighWM o) = setIntOpt s receiveHighWM o-setOption s (ReceiveTimeout o) = setIntOpt s receiveTimeout o-setOption s (SendHighWM o) = setIntOpt s sendHighWM o-setOption s (SendTimeout o) = setIntOpt s sendTimeout o-#endif -- | Get the given socket option by passing in some dummy value of -- that option. The actual value will be returned. Please note that@@ -334,25 +269,11 @@ getOption s (ReconnectIVLMax _) = ReconnectIVLMax <$> getIntOpt s reconnectIVLMax getOption s (RecoveryIVL _) = RecoveryIVL <$> getIntOpt s recoveryIVL getOption s (SendBuf _) = SendBuf <$> getIntOpt s sendBuf-#ifdef ZMQ2 getOption s (HighWM _) = HighWM <$> getIntOpt s highWM getOption s (McastLoop _) = McastLoop <$> getBoolOpt s mcastLoop getOption s (RecoveryIVLMsec _) = RecoveryIVLMsec <$> getIntOpt s recoveryIVLMsec getOption s (Swap _) = Swap <$> getIntOpt s swap-#endif-#ifdef ZMQ3-getOption s (IPv4Only _) = IPv4Only <$> getBoolOpt s ipv4Only-getOption s (MaxMsgSize _) = MaxMsgSize <$> getIntOpt s maxMessageSize-getOption s (McastHops _) = McastHops <$> getIntOpt s mcastHops-getOption s (ReceiveHighWM _) = ReceiveHighWM <$> getIntOpt s receiveHighWM-getOption s (ReceiveTimeout _) = ReceiveTimeout <$> getIntOpt s receiveTimeout-getOption s (SendHighWM _) = SendHighWM <$> getIntOpt s sendHighWM-getOption s (SendTimeout _) = SendTimeout <$> getIntOpt s sendTimeout -getMsgOption :: Message -> MessageOption -> IO MessageOption-getMsgOption m (MoreMsgParts _) = MoreMsgParts <$> getIntMsgOpt m more-#endif- version :: IO (Int, Int, Int) version = with 0 $ \major_ptr ->@@ -373,7 +294,7 @@ -- | Terminate a 0MQ context (cf. zmq_term). You should normally -- prefer to use 'with' instead. term :: Context -> IO ()-term = throwErrnoIfMinus1_ "term" . c_zmq_term . ctx+term = throwErrnoIfMinus1Retry_ "term" . c_zmq_term . ctx -- | Run an action with a 0MQ context. The 'Context' supplied to your -- action will /not/ be valid after the action either returns or@@ -381,7 +302,7 @@ withContext :: Size -> (Context -> IO a) -> IO a withContext ioThreads act = bracket (throwErrnoIfNull "c_zmq_init" $ c_zmq_init (fromIntegral ioThreads))- (throwErrnoIfMinus1_ "c_zmq_term" . c_zmq_term)+ (throwErrnoIfMinus1Retry_ "c_zmq_term" . c_zmq_term) (act . Context) -- | Run an action with a 0MQ socket. The socket will be closed after running@@ -516,7 +437,6 @@ waitRead = wait' threadWaitRead pollIn waitWrite = wait' threadWaitWrite pollOut -#ifdef ZMQ2 -- | Type representing ZeroMQ devices, as used with zmq_device data Device = Streamer -- ^ ZMQ_STREAMER@@ -538,4 +458,4 @@ fromDevice Streamer = fromIntegral . deviceType $ deviceStreamer fromDevice Forwarder = fromIntegral . deviceType $ deviceForwarder fromDevice Queue = fromIntegral . deviceType $ deviceQueue-#endif+
src/System/ZMQ/Base.hsc view
@@ -17,17 +17,8 @@ #include <zmq.h> --- Ensure Cabal flag matches compile time version of 0MQ-#ifdef ZMQ2 #if ZMQ_VERSION_MAJOR != 2- ERROR__ZMQ2_Flag_does_not_match_0MQ_Version-#endif-#endif--#ifdef ZMQ3-#if ZMQ_VERSION_MAJOR != 3- ERROR__ZMQ3_Flag_does_not_match_0MQ_Version-#endif+ ERROR__Invalid_0MQ_Version #endif newtype ZMQMsg = ZMQMsg { content :: Ptr () }@@ -35,14 +26,8 @@ instance Storable ZMQMsg where alignment _ = #{alignment zmq_msg_t} sizeOf _ = #{size zmq_msg_t}-#ifdef ZMQ2 peek p = ZMQMsg <$> #{peek zmq_msg_t, content} p poke p (ZMQMsg c) = #{poke zmq_msg_t, content} p c-#endif-#ifdef ZMQ3- peek p = ZMQMsg <$> #{peek zmq_msg_t, _} p- poke p (ZMQMsg c) = #{poke zmq_msg_t, _} p c-#endif data ZMQPoll = ZMQPoll { pSocket :: ZMQSocket@@ -87,10 +72,8 @@ , xresponse = ZMQ_XREP , pull = ZMQ_PULL , push = ZMQ_PUSH-#ifdef ZMQ2 , upstream = ZMQ_UPSTREAM , downstream = ZMQ_DOWNSTREAM-#endif } newtype ZMQOption = ZMQOption { optVal :: CInt } deriving (Eq, Ord)@@ -111,45 +94,18 @@ , sendBuf = ZMQ_SNDBUF , subscribe = ZMQ_SUBSCRIBE , unsubscribe = ZMQ_UNSUBSCRIBE-#ifdef ZMQ2 , highWM = ZMQ_HWM , mcastLoop = ZMQ_MCAST_LOOP , recoveryIVLMsec = ZMQ_RECOVERY_IVL_MSEC , swap = ZMQ_SWAP-#endif-#ifdef ZMQ3- , ipv4Only = ZMQ_IPV4ONLY- , maxMessageSize = ZMQ_MAXMSGSIZE- , mcastHops = ZMQ_MULTICAST_HOPS- , receiveHighWM = ZMQ_RCVHWM- , receiveTimeout = ZMQ_RCVTIMEO- , sendHighWM = ZMQ_SNDHWM- , sendTimeout = ZMQ_SNDTIMEO-#endif } -#ifdef ZMQ3-newtype ZMQMsgOption = ZMQMsgOption { msgOptVal :: CInt } deriving (Eq, Ord)--#{enum ZMQMsgOption, ZMQMsgOption- , more = ZMQ_MORE-}-#endif- newtype ZMQFlag = ZMQFlag { flagVal :: CInt } deriving (Eq, Ord) -#ifdef ZMQ2 #{enum ZMQFlag, ZMQFlag , noBlock = ZMQ_NOBLOCK , sndMore = ZMQ_SNDMORE }-#endif-#ifdef ZMQ3-#{enum ZMQFlag, ZMQFlag- , noBlock = ZMQ_DONTWAIT- , sndMore = ZMQ_SNDMORE-}-#endif newtype ZMQPollEvent = ZMQPollEvent { pollVal :: CShort } deriving (Eq, Ord) @@ -160,8 +116,6 @@ pollInOut = ZMQ_POLLIN | ZMQ_POLLOUT } --#ifdef ZMQ2 newtype ZMQDevice = ZMQDevice { deviceType :: CInt } deriving (Eq, Ord) #{enum ZMQDevice, ZMQDevice,@@ -172,7 +126,6 @@ foreign import ccall safe "zmq.h zmq_device" c_zmq_device :: CInt -> ZMQSocket -> ZMQSocket -> IO CInt-#endif -- general initialization @@ -231,27 +184,11 @@ c_zmq_connect :: ZMQSocket -> CString -> IO CInt -#ifdef ZMQ2 foreign import ccall unsafe "zmq.h zmq_send" c_zmq_send :: ZMQSocket -> ZMQMsgPtr -> CInt -> IO CInt foreign import ccall unsafe "zmq.h zmq_recv" c_zmq_recv :: ZMQSocket -> ZMQMsgPtr -> CInt -> IO CInt-#endif-#ifdef ZMQ3-foreign import ccall unsafe "zmq.h zmq_sendmsg"- c_zmq_send :: ZMQSocket -> ZMQMsgPtr -> CInt -> IO CInt--foreign import ccall unsafe "zmq.h zmq_recvmsg"- c_zmq_recv :: ZMQSocket -> ZMQMsgPtr -> CInt -> IO CInt--foreign import ccall unsafe "zmq.h zmq_getmsgopt"- c_zmq_getmsgopt :: ZMQMsgPtr- -> CInt -- option- -> Ptr () -- option value- -> Ptr CSize -- option value size ptr- -> IO CInt-#endif -- poll
src/System/ZMQ/Internal.hs view
@@ -17,11 +17,6 @@ , getBoolOpt , getIntOpt , getStrOpt--#ifdef ZMQ3- , getIntMsgOpt-#endif- , toZMQFlag , combine , mkSocket@@ -121,14 +116,14 @@ setIntOpt :: (Storable b, Integral b) => Socket a -> ZMQOption -> b -> IO () setIntOpt sock (ZMQOption o) i = onSocket "setIntOpt" sock $ \s ->- throwErrnoIfMinus1_ "setIntOpt" $ with i $ \ptr ->+ throwErrnoIfMinus1Retry_ "setIntOpt" $ with i $ \ptr -> c_zmq_setsockopt s (fromIntegral o) (castPtr ptr) (fromIntegral . sizeOf $ i) setStrOpt :: Socket a -> ZMQOption -> String -> IO () setStrOpt sock (ZMQOption o) str = onSocket "setStrOpt" sock $ \s ->- throwErrnoIfMinus1_ "setStrOpt" $ withCStringLen str $ \(cstr, len) ->+ throwErrnoIfMinus1Retry_ "setStrOpt" $ withCStringLen str $ \(cstr, len) -> c_zmq_setsockopt s (fromIntegral o) (castPtr cstr) (fromIntegral len)@@ -141,7 +136,7 @@ let i = 0 bracket (new i) free $ \iptr -> bracket (new (fromIntegral . sizeOf $ i :: CSize)) free $ \jptr -> do- throwErrnoIfMinus1_ "getIntOpt" $+ throwErrnoIfMinus1Retry_ "getIntOpt" $ c_zmq_getsockopt s (fromIntegral o) (castPtr iptr) jptr peek iptr @@ -149,20 +144,9 @@ getStrOpt sock (ZMQOption o) = onSocket "getStrOpt" sock $ \s -> bracket (mallocBytes 255) free $ \bPtr -> bracket (new (255 :: CSize)) free $ \sPtr -> do- throwErrnoIfMinus1_ "getStrOpt" $+ throwErrnoIfMinus1Retry_ "getStrOpt" $ c_zmq_getsockopt s (fromIntegral o) (castPtr bPtr) sPtr peek sPtr >>= \len -> peekCStringLen (bPtr, fromIntegral len)--#ifdef ZMQ3-getIntMsgOpt :: (Storable a, Integral a) => Message -> ZMQMsgOption -> IO a-getIntMsgOpt (Message m) (ZMQMsgOption o) = do- let i = 0- bracket (new i) free $ \iptr ->- bracket (new (fromIntegral . sizeOf $ i :: CSize)) free $ \jptr -> do- throwErrnoIfMinus1_ "getIntMsgOpt" $- c_zmq_getmsgopt m (fromIntegral o) (castPtr iptr) jptr- peek iptr-#endif toZMQFlag :: Flag -> ZMQFlag toZMQFlag NoBlock = noBlock
+ tests/System/ZMQ/Test/Properties.hs view
@@ -0,0 +1,108 @@+module System.ZMQ.Test.Properties where++import Control.Applicative+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.QuickCheck2+import Test.QuickCheck+import Test.QuickCheck.Monadic++import Data.Int+import Data.Word+import Data.ByteString (ByteString)+import qualified System.ZMQ as ZMQ+import qualified Data.ByteString as SB+import qualified Data.ByteString.Char8 as CB++tests :: [Test]+tests = [+ testGroup "0MQ Socket Properties" [+ testProperty "get socket option (Push)" (prop_get_socket_option ZMQ.Push)+ , testProperty "get socket option (Pull)" (prop_get_socket_option ZMQ.Pull)+ , testProperty "get socket option (XRep)" (prop_get_socket_option ZMQ.XRep)+ , testProperty "get socket option (XReq)" (prop_get_socket_option ZMQ.XReq)+ , testProperty "get socket option (Rep)" (prop_get_socket_option ZMQ.Rep)+ , testProperty "get socket option (Req)" (prop_get_socket_option ZMQ.Req)+ , testProperty "get socket option (Sub)" (prop_get_socket_option ZMQ.Sub)+ , testProperty "get socket option (Pub)" (prop_get_socket_option ZMQ.Pub)+ , testProperty "get socket option (Pair)" (prop_get_socket_option ZMQ.Pair)+ , testProperty "get socket option (Down)" (prop_get_socket_option ZMQ.Down)+ , testProperty "get socket option (Up)" (prop_get_socket_option ZMQ.Up)++ , testProperty "set/get socket option (Push)" (prop_set_get_socket_option ZMQ.Push)+ , testProperty "set/get socket option (Pull)" (prop_set_get_socket_option ZMQ.Pull)+ , testProperty "set/get socket option (XRep)" (prop_set_get_socket_option ZMQ.XRep)+ , testProperty "set/get socket option (XReq)" (prop_set_get_socket_option ZMQ.XReq)+ , testProperty "set/get socket option (Rep)" (prop_set_get_socket_option ZMQ.Rep)+ , testProperty "set/get socket option (Req)" (prop_set_get_socket_option ZMQ.Req)+ , testProperty "set/get socket option (Sub)" (prop_set_get_socket_option ZMQ.Sub)+ , testProperty "set/get socket option (Pub)" (prop_set_get_socket_option ZMQ.Pub)+ , testProperty "set/get socket option (Pair)" (prop_set_get_socket_option ZMQ.Pair)+ , testProperty "set/get socket option (Down)" (prop_set_get_socket_option ZMQ.Down)+ , testProperty "set/get socket option (Up)" (prop_set_get_socket_option ZMQ.Up)++ , testProperty "(un-)subscribe" (prop_subscribe ZMQ.Sub)+ ]+ , testGroup "0MQ Messages" [+ testProperty "msg send == msg received (Req/Rep)" (prop_send_receive ZMQ.Req ZMQ.Rep)+ , testProperty "msg send == msg received (Push/Pull)" (prop_send_receive ZMQ.Push ZMQ.Pull)+ , testProperty "msg send == msg received (Pair/Pair)" (prop_send_receive ZMQ.Pair ZMQ.Pair)+ ]+ ]++prop_get_socket_option :: ZMQ.SType a => a -> Property+prop_get_socket_option t = forAll readOnlyOptions canGetOption+ where+ canGetOption opt = monadicIO $ run $+ ZMQ.withContext 1 $ \c ->+ ZMQ.withSocket c t $ \s -> ZMQ.getOption s opt++prop_set_get_socket_option :: ZMQ.SType a => a -> ZMQ.SocketOption -> Property+prop_set_get_socket_option t opt = monadicIO $ do+ o <- run $ ZMQ.withContext 1 $ \c ->+ ZMQ.withSocket c t $ \s -> do+ ZMQ.setOption s opt+ ZMQ.getOption s opt+ assert (opt == o)++prop_subscribe :: (ZMQ.SubsType a, ZMQ.SType a) => a -> String -> Property+prop_subscribe t subs = monadicIO $ run $+ ZMQ.withContext 1 $ \c ->+ ZMQ.withSocket c t $ \s -> do+ ZMQ.subscribe s subs+ ZMQ.unsubscribe s subs++prop_send_receive :: (ZMQ.SType a, ZMQ.SType b) => a -> b -> ByteString -> Property+prop_send_receive a b msg = monadicIO $ do+ msg' <- run $ ZMQ.withContext 0 $ \c ->+ ZMQ.withSocket c a $ \sender ->+ ZMQ.withSocket c b $ \receiver -> do+ ZMQ.bind receiver "inproc://endpoint"+ ZMQ.connect sender "inproc://endpoint"+ ZMQ.send sender msg []+ ZMQ.receive receiver []+ assert (msg == msg')++instance Arbitrary ZMQ.SocketOption where+ arbitrary = oneof [+ ZMQ.Affinity . fromIntegral <$> (arbitrary :: Gen Word64)+ , ZMQ.Backlog . fromIntegral <$> (arbitrary :: Gen Int32)+ , ZMQ.Linger . fromIntegral <$> (arbitrary :: Gen Int32)+ , ZMQ.Rate . fromIntegral <$> (arbitrary :: Gen Word32)+ , ZMQ.ReceiveBuf . fromIntegral <$> (arbitrary :: Gen Word64)+ , ZMQ.ReconnectIVL . fromIntegral <$> (arbitrary :: Gen Int32) `suchThat` (>= 0)+ , ZMQ.ReconnectIVLMax . fromIntegral <$> (arbitrary :: Gen Int32) `suchThat` (>= 0)+ , ZMQ.RecoveryIVL . fromIntegral <$> (arbitrary :: Gen Word32)+ , ZMQ.RecoveryIVLMsec .fromIntegral <$> (arbitrary :: Gen Int32) `suchThat` (>= 0)+ , ZMQ.SendBuf . fromIntegral <$> (arbitrary :: Gen Word64)+ , ZMQ.HighWM . fromIntegral <$> (arbitrary :: Gen Word64)+ , ZMQ.McastLoop <$> (arbitrary :: Gen Bool)+ , ZMQ.Swap . fromIntegral <$> (arbitrary :: Gen Int64) `suchThat` (>= 0)+ , ZMQ.Identity . show <$> arbitrary `suchThat` (\s -> SB.length s > 0 && SB.length s < 255)+ ]++instance Arbitrary ByteString where+ arbitrary = CB.pack <$> arbitrary++readOnlyOptions :: Gen ZMQ.SocketOption+readOnlyOptions = elements [ZMQ.FD undefined, ZMQ.ReceiveMore undefined, ZMQ.Events undefined]+
tests/tests.hs view
@@ -1,112 +1,7 @@-import Test.Framework (defaultMain, testGroup)-import Test.Framework (Test)-import Test.Framework.Providers.HUnit--import qualified System.ZMQ as ZMQ+{-# LANGUAGE CPP #-}+import Test.Framework (defaultMain)+import qualified System.ZMQ.Test.Properties as Properties main :: IO ()-main = defaultMain tests--tests :: [Test]-tests = [- testGroup "Misc" [- testCase "ZMQ Context" test_context- ]- , testGroup "Socket Creation" [- testCase "Push" (test_socket ZMQ.Push)- , testCase "Pull" (test_socket ZMQ.Pull)- , testCase "XRep" (test_socket ZMQ.XRep)- , testCase "XReq" (test_socket ZMQ.XReq)- , testCase "Rep" (test_socket ZMQ.Rep)- , testCase "Req" (test_socket ZMQ.Req)- , testCase "Sub" (test_socket ZMQ.Sub)- , testCase "Pub" (test_socket ZMQ.Pub)- , testCase "Pair" (test_socket ZMQ.Pair)---ifdef ZMQ2- , testCase "Down" (test_socket ZMQ.Down)- , testCase "Up" (test_socket ZMQ.Up)---endif- ]- , testGroup "Socket Option (get)" [- testCase "Affinity" (test_option_get (ZMQ.Affinity undefined))- , testCase "Backlog" (test_option_get (ZMQ.Backlog undefined))- , testCase "Events" (test_option_get (ZMQ.Events undefined))- , testCase "FD" (test_option_get (ZMQ.FD undefined))- , testCase "Identity" (test_option_get (ZMQ.Identity undefined))- , testCase "Linger" (test_option_get (ZMQ.Linger undefined))- , testCase "Rate" (test_option_get (ZMQ.Rate undefined))- , testCase "ReceiveBuf" (test_option_get (ZMQ.ReceiveBuf undefined))- , testCase "ReceiveMore" (test_option_get (ZMQ.ReceiveMore undefined))- , testCase "ReconnectIVL" (test_option_get (ZMQ.ReconnectIVL undefined))- , testCase "ReconnectIVLMax" (test_option_get (ZMQ.ReconnectIVLMax undefined))- , testCase "ReconnectIVL" (test_option_get (ZMQ.RecoveryIVL undefined))- , testCase "SendBuf" (test_option_get (ZMQ.SendBuf undefined))---ifdef ZMQ2- , testCase "HighWM" (test_option_get (ZMQ.HighWM undefined))- , testCase "McastLoop" (test_option_get (ZMQ.McastLoop undefined))- , testCase "RecoveryIVLMsec" (test_option_get (ZMQ.RecoveryIVLMsec undefined))- , testCase "Swap" (test_option_get (ZMQ.Swap undefined))---endif- ]- , testGroup "Socket Option (set)" [- testCase "Affinity" (test_option_set (ZMQ.Affinity 0))- , testCase "Backlog" (test_option_set (ZMQ.Backlog 100))- , testCase "Events" (test_option_set (ZMQ.Events undefined))- , testCase "FD" (test_option_set (ZMQ.FD undefined))- , testCase "Identity" (test_option_set (ZMQ.Identity "id"))- , testCase "Linger" (test_option_set (ZMQ.Linger (-1)))- , testCase "Rate" (test_option_set (ZMQ.Rate 100))- , testCase "ReceiveBuf" (test_option_set (ZMQ.ReceiveBuf 0))- , testCase "ReceiveMore" (test_option_set (ZMQ.ReceiveMore undefined))- , testCase "ReconnectIVL" (test_option_set (ZMQ.ReconnectIVL 100))- , testCase "ReconnectIVLMax" (test_option_set (ZMQ.ReconnectIVLMax 0))- , testCase "ReconnectIVL" (test_option_set (ZMQ.RecoveryIVL 100))- , testCase "SendBuf" (test_option_set (ZMQ.SendBuf 0))---ifdef ZMQ2- , testCase "HighWM" (test_option_set (ZMQ.HighWM 0))- , testCase "McastLoop" (test_option_set (ZMQ.McastLoop True))- , testCase "RecoveryIVLMsec" (test_option_set (ZMQ.RecoveryIVLMsec 10))- , testCase "Swap" (test_option_set (ZMQ.Swap 0))---endif- ]- , testGroup "Pub/Sub" [- testCase "Subscribe Sub" (test_subscribe ZMQ.Sub)- , testCase "Unsubscribe Sub" (test_unsubscribe ZMQ.Sub)- ]- ]--test_context :: IO ()-test_context = do- c1 <- ZMQ.init 1- c2 <- ZMQ.init 3- ZMQ.term c1- ZMQ.term c2--test_socket :: ZMQ.SType a => a -> IO ()-test_socket ty =- ZMQ.withContext 1 $ \c ->- ZMQ.socket c ty >>= ZMQ.close--test_option_get :: ZMQ.SocketOption -> IO ()-test_option_get o =- ZMQ.withContext 1 $ \c ->- ZMQ.withSocket c ZMQ.Sub $ \s ->- ZMQ.getOption s o >> return ()--test_option_set :: ZMQ.SocketOption -> IO ()-test_option_set o =- ZMQ.withContext 1 $ \c ->- ZMQ.withSocket c ZMQ.Sub $ \s ->- ZMQ.setOption s o--test_subscribe :: (ZMQ.SubsType a, ZMQ.SType a) => a -> IO ()-test_subscribe ty =- ZMQ.withContext 1 $ \c ->- ZMQ.withSocket c ty $ \s ->- ZMQ.subscribe s ""+main = defaultMain Properties.tests -test_unsubscribe :: (ZMQ.SubsType a, ZMQ.SType a) => a -> IO ()-test_unsubscribe ty =- ZMQ.withContext 1 $ \c ->- ZMQ.withSocket c ty $ \s ->- ZMQ.unsubscribe s ""
zeromq-haskell.cabal view
@@ -1,6 +1,6 @@ name: zeromq-haskell-version: 0.8.1-synopsis: bindings to zeromq+version: 0.8.2+synopsis: Bindings to ZeroMQ 2.1.x category: System, FFI license: MIT license-file: LICENSE@@ -17,6 +17,7 @@ , examples/*.hs , examples/perf/*.hs , tests/*.hs+ , tests/System/ZMQ/Test/*.hs description: The 0MQ lightweight messaging kernel is a library which extends the standard socket interfaces with features traditionally provided@@ -26,16 +27,7 @@ multiple transport protocols and more. This library provides the Haskell language binding to 0MQ and- supports 0MQ 2.x as well as 3.x (use -fzmq2 or -fzmq3 to select- between the two).--flag zmq2- description: Compile with 0MQ 2.x- default: True--flag zmq3- description: Compile with 0MQ 3.x- default: False+ supports 0MQ 2.1.x. library hs-source-dirs: src@@ -51,12 +43,6 @@ , containers , bytestring - if flag(zmq2)- cpp-options: -DZMQ2-- if flag(zmq3)- cpp-options: -DZMQ3- if os(freebsd) extra-libraries: zmq, pthread else@@ -71,9 +57,10 @@ , containers , bytestring , test-framework >= 0.4- , test-framework-hunit >= 0.2- , HUnit+ , test-framework-quickcheck2 >= 0.2+ , QuickCheck >= 2.4 ghc-options: -Wall -threaded -rtsopts+ cpp-options: -DZMQ2 source-repository head type: git