diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,34 @@ +0.5 +----------------------------------------------------------------------------- +- bugfix release (#44, PR #47) which exposes `DontWait` flag on Windows +- exports `socketMonitor` +- `Eq`, `Typable` and `Generic` instances of socket types + +0.4.1 +----------------------------------------------------------------------------- +- adjust dependencies constraints + +0.4 +----------------------------------------------------------------------------- +- update `exceptions` and rework tests + +0.3.2 +----------------------------------------------------------------------------- +- adjust dependencies constraints + +0.3.1 +----------------------------------------------------------------------------- +- preliminary Windows support (#8) + +0.3 +----------------------------------------------------------------------------- +- remove `MonadCatchIO-transformers` +- use `pkg-config` (except on Windows) + +0.2 +----------------------------------------------------------------------------- +- add `disconnect` + +0.1 +----------------------------------------------------------------------------- +- initial release supporting 0MQ 4.x diff --git a/src/System/ZMQ4.hs b/src/System/ZMQ4.hs --- a/src/System/ZMQ4.hs +++ b/src/System/ZMQ4.hs @@ -1,5 +1,7 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE GADTs #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} -- | -- Module : System.ZMQ4 @@ -60,7 +62,7 @@ , Size , Context , Socket - , Flag (SendMore) + , Flag (..) , Switch (..) , Timeout , Event (..) @@ -84,6 +86,7 @@ , receiveMulti , version , monitor + , socketMonitor , poll , System.ZMQ4.subscribe @@ -212,6 +215,7 @@ import Data.List.NonEmpty (NonEmpty) import Data.Restricted import Data.Traversable (forM) +import Data.Typeable import Foreign hiding (throwIf, throwIf_, throwIfNull, void) import Foreign.C.String import Foreign.C.Types (CInt, CShort) @@ -227,45 +231,46 @@ import qualified System.ZMQ4.Base as B import GHC.Conc (threadWaitRead, threadWaitWrite) +import GHC.Generics(Generic) ----------------------------------------------------------------------------- -- Socket Types -- | -data Pair = Pair +data Pair = Pair deriving (Eq, Typeable, Generic) -- | -data Pub = Pub +data Pub = Pub deriving (Eq, Typeable, Generic) -- | -data Sub = Sub +data Sub = Sub deriving (Eq, Typeable, Generic) -- | -data XPub = XPub +data XPub = XPub deriving (Eq, Typeable, Generic) -- | -data XSub = XSub +data XSub = XSub deriving (Eq, Typeable, Generic) -- | -data Req = Req +data Req = Req deriving (Eq, Typeable, Generic) -- | -data Rep = Rep +data Rep = Rep deriving (Eq, Typeable, Generic) -- | -data Dealer = Dealer +data Dealer = Dealer deriving (Eq, Typeable, Generic) -- | -data Router = Router +data Router = Router deriving (Eq, Typeable, Generic) -- | -data Pull = Pull +data Pull = Pull deriving (Eq, Typeable, Generic) -- | -data Push = Push +data Push = Push deriving (Eq, Typeable, Generic) -- | -data Stream = Stream +data Stream = Stream deriving (Eq, Typeable, Generic) type XReq = Dealer {-# DEPRECATED XReq "Use Dealer" #-} @@ -790,7 +795,11 @@ send sock fls val = bracket (messageOf val) messageClose $ \m -> onSocket "send" sock $ \s -> retry "send" (waitWrite sock) $ +#ifdef mingw32_HOST_OS + c_zmq_sendmsg s (msgPtr m) (combineFlags fls) +#else c_zmq_sendmsg s (msgPtr m) (combineFlags (DontWait : fls)) +#endif -- | Send the given 'LB.ByteString' over the socket -- (cf. ). @@ -806,7 +815,11 @@ send' sock fls val = bracket (messageOfLazy val) messageClose $ \m -> onSocket "send'" sock $ \s -> retry "send'" (waitWrite sock) $ +#ifdef mingw32_HOST_OS + c_zmq_sendmsg s (msgPtr m) (combineFlags fls) +#else c_zmq_sendmsg s (msgPtr m) (combineFlags (DontWait : fls)) +#endif -- | Send a multi-part message. -- This function applies the 'SendMore' 'Flag' between all message parts. @@ -828,7 +841,11 @@ receive sock = bracket messageInit messageClose $ \m -> onSocket "receive" sock $ \s -> do retry "receive" (waitRead sock) $ +#ifdef mingw32_HOST_OS + c_zmq_recvmsg s (msgPtr m) 0 +#else c_zmq_recvmsg s (msgPtr m) (flagVal dontWait) +#endif data_ptr <- c_zmq_msg_data (msgPtr m) size <- c_zmq_msg_size (msgPtr m) SB.packCStringLen (data_ptr, fromIntegral size) @@ -873,7 +890,12 @@ where next soc m False = messageClose m `finally` close soc >> return Nothing next soc m True = onSocket "recv" soc $ \s -> do - retry "recv" (waitRead soc) $ c_zmq_recvmsg s (msgPtr m) (flagVal dontWait) + retry "recv" (waitRead soc) $ +#ifdef mingw32_HOST_OS + c_zmq_recvmsg s (msgPtr m) 0 +#else + c_zmq_recvmsg s (msgPtr m) (flagVal dontWait) +#endif ptr <- c_zmq_msg_data (msgPtr m) evt <- peek ptr str <- receive soc diff --git a/src/System/ZMQ4/Internal.hs b/src/System/ZMQ4/Internal.hs --- a/src/System/ZMQ4/Internal.hs +++ b/src/System/ZMQ4/Internal.hs @@ -81,7 +81,7 @@ -- | Flags to apply on send operations (cf. man zmq_send) data Flag = - DontWait -- ^ ZMQ_DONTWAIT + DontWait -- ^ ZMQ_DONTWAIT (Only relevant on Windows.) | SendMore -- ^ ZMQ_SNDMORE deriving (Eq, Ord, Show) @@ -257,7 +257,7 @@ peek sPtr >>= \len -> peekA (bPtr, fromIntegral len) getStrOpt :: Socket a -> ZMQOption -> IO String -getStrOpt = getCStrOpt peekCStringLen +getStrOpt = getCStrOpt (peekCString . fst) getByteStringOpt :: Socket a -> ZMQOption -> IO SB.ByteString getByteStringOpt = getCStrOpt SB.packCStringLen diff --git a/src/System/ZMQ4/Monadic.hs b/src/System/ZMQ4/Monadic.hs --- a/src/System/ZMQ4/Monadic.hs +++ b/src/System/ZMQ4/Monadic.hs @@ -17,7 +17,7 @@ ( -- * Type Definitions ZMQ , Socket - , Z.Flag (SendMore) + , Z.Flag (..) , Z.Switch (..) , Z.Timeout , Z.Event (..) @@ -79,6 +79,7 @@ , unsubscribe , proxy , monitor + , socketMonitor , Z.poll -- * Socket Options (Read) @@ -348,6 +349,9 @@ monitor :: [Z.EventType] -> Socket z t -> ZMQ z (Bool -> IO (Maybe Z.EventMsg)) monitor es s = onContext $ \ctx -> Z.monitor es ctx (_unsocket s) + +socketMonitor :: [Z.EventType] -> String -> Socket z t -> ZMQ z () +socketMonitor es addr s = liftIO $ Z.socketMonitor es addr (_unsocket s) -- * Socket Options (Read) diff --git a/tests/System/ZMQ4/Test/Properties.hs b/tests/System/ZMQ4/Test/Properties.hs --- a/tests/System/ZMQ4/Test/Properties.hs +++ b/tests/System/ZMQ4/Test/Properties.hs @@ -8,6 +8,7 @@ import Test.QuickCheck import Test.QuickCheck.Monadic (monadicIO, run) import Test.Tasty +import Test.Tasty.HUnit import Test.Tasty.QuickCheck import Control.Applicative @@ -49,6 +50,7 @@ , testProperty "set;get socket option (Pull)" (prop_set_get_socket_option Pull) , testProperty "set;get socket option (Push)" (prop_set_get_socket_option Push) , testProperty "(un-)subscribe" (prop_subscribe Sub) + , testCase "last_enpoint" (last_endpoint) , testGroup "connect disconnect" [ testProperty "" (prop_connect_disconnect x) | x <- [ (AnySocket Rep, AnySocket Req) @@ -100,6 +102,15 @@ where ieq :: (Integral i, Integral k) => i -> k -> Bool ieq i k = (fromIntegral i :: Int) == (fromIntegral k :: Int) + +last_endpoint :: IO () +last_endpoint = do + let a = "tcp://127.0.0.1:43821" + a' <- runZMQ $ do + s <- socket Rep + bind s a + lastEndpoint s + a @=? a' prop_subscribe :: (Subscriber a, SocketType a) => a -> ByteString -> Property prop_subscribe t subs = monadicIO $ run $ diff --git a/zeromq4-haskell.cabal b/zeromq4-haskell.cabal --- a/zeromq4-haskell.cabal +++ b/zeromq4-haskell.cabal @@ -1,5 +1,5 @@ name: zeromq4-haskell -version: 0.4.1 +version: 0.5 synopsis: Bindings to ZeroMQ 4.x category: System, FFI license: MIT @@ -14,6 +14,7 @@ build-type: Simple extra-source-files: README.md + , CHANGELOG.md , AUTHORS , examples/*.hs , examples/Makefile @@ -80,4 +81,5 @@ , bytestring , QuickCheck >= 2.6 , tasty >= 0.8 + , tasty-hunit >= 0.8 , tasty-quickcheck >= 0.8