zeromq4-haskell 0.6.2 → 0.6.3
raw patch · 8 files changed
+519/−491 lines, 8 filesdep ~exceptions
Dependency ranges changed: exceptions
Files
- CHANGELOG.md +6/−0
- src/System/ZMQ4.hs +8/−9
- src/System/ZMQ4/Base.hsc +0/−371
- src/System/ZMQ4/Error.hs +0/−99
- src/System/ZMQ4/Internal.hs +8/−2
- src/System/ZMQ4/Internal/Base.hsc +387/−0
- src/System/ZMQ4/Internal/Error.hs +102/−0
- zeromq4-haskell.cabal +8/−10
CHANGELOG.md view
@@ -1,3 +1,9 @@+0.6.3+-----------------------------------------------------------------------------+- Make internal modules available.+- Typeable instance for `Context`.+- Update dependencies.+ 0.6.2 ----------------------------------------------------------------------------- - Bug fixes: #56 (we no longer call zmq_msg_close after successfull sends)
src/System/ZMQ4.hs view
@@ -220,15 +220,15 @@ import Foreign.C.String import Foreign.C.Types (CInt, CShort) import System.Posix.Types (Fd(..))-import System.ZMQ4.Base import System.ZMQ4.Internal-import System.ZMQ4.Error+import System.ZMQ4.Internal.Base+import System.ZMQ4.Internal.Error -import qualified Data.ByteString as SB-import qualified Data.ByteString.Lazy as LB-import qualified Data.List.NonEmpty as S-import qualified Prelude as P-import qualified System.ZMQ4.Base as B+import qualified Data.ByteString as SB+import qualified Data.ByteString.Lazy as LB+import qualified Data.List.NonEmpty as S+import qualified Prelude as P+import qualified System.ZMQ4.Internal.Base as B import GHC.Conc (threadWaitRead) import GHC.Generics(Generic)@@ -898,8 +898,7 @@ #else c_zmq_recvmsg s (msgPtr m) (flagVal dontWait) #endif- ptr <- c_zmq_msg_data (msgPtr m)- evt <- peek ptr+ evt <- peekZMQEvent (msgPtr m) str <- receive soc return . Just $ eventMessage str evt
− src/System/ZMQ4/Base.hsc
@@ -1,371 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ForeignFunctionInterface #-}--module System.ZMQ4.Base where--import Foreign-import Foreign.C.Types-import Foreign.C.String-import Control.Applicative--#include <zmq.h>--#if ZMQ_VERSION_MAJOR != 4- #error *** INVALID 0MQ VERSION (must be 4.x) ***-#endif---------------------------------------------------------------------------------- Message--newtype ZMQMsg = ZMQMsg- { content :: Ptr ()- } deriving (Eq, Ord)--instance Storable ZMQMsg where- alignment _ = #{alignment zmq_msg_t}- sizeOf _ = #{size zmq_msg_t}- peek p = ZMQMsg <$> #{peek zmq_msg_t, _} p- poke p (ZMQMsg c) = #{poke zmq_msg_t, _} p c---------------------------------------------------------------------------------- Poll--data ZMQPoll = ZMQPoll- { pSocket :: {-# UNPACK #-} !ZMQSocket- , pFd :: {-# UNPACK #-} !CInt- , pEvents :: {-# UNPACK #-} !CShort- , pRevents :: {-# UNPACK #-} !CShort- }--instance Storable ZMQPoll where- alignment _ = #{alignment zmq_pollitem_t}- sizeOf _ = #{size zmq_pollitem_t}- peek p = do- s <- #{peek zmq_pollitem_t, socket} p- f <- #{peek zmq_pollitem_t, fd} p- e <- #{peek zmq_pollitem_t, events} p- re <- #{peek zmq_pollitem_t, revents} p- return $ ZMQPoll s f e re- poke p (ZMQPoll s f e re) = do- #{poke zmq_pollitem_t, socket} p s- #{poke zmq_pollitem_t, fd} p f- #{poke zmq_pollitem_t, events} p e- #{poke zmq_pollitem_t, revents} p re--type ZMQMsgPtr = Ptr ZMQMsg-type ZMQCtx = Ptr ()-type ZMQSocket = Ptr ()-type ZMQPollPtr = Ptr ZMQPoll--#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)---------------------------------------------------------------------------------- Socket Types--newtype ZMQSocketType = ZMQSocketType- { typeVal :: CInt- } deriving (Eq, Ord)--#{enum ZMQSocketType, ZMQSocketType- , pair = ZMQ_PAIR- , pub = ZMQ_PUB- , sub = ZMQ_SUB- , xpub = ZMQ_XPUB- , xsub = ZMQ_XSUB- , request = ZMQ_REQ- , response = ZMQ_REP- , dealer = ZMQ_DEALER- , router = ZMQ_ROUTER- , pull = ZMQ_PULL- , push = ZMQ_PUSH- , stream = ZMQ_STREAM-}---------------------------------------------------------------------------------- Socket Options--newtype ZMQOption = ZMQOption- { optVal :: CInt- } deriving (Eq, Ord)--#{enum ZMQOption, ZMQOption- , affinity = ZMQ_AFFINITY- , backlog = ZMQ_BACKLOG- , conflate = ZMQ_CONFLATE- , curve = ZMQ_CURVE- , curvePublicKey = ZMQ_CURVE_PUBLICKEY- , curveSecretKey = ZMQ_CURVE_SECRETKEY- , curveServer = ZMQ_CURVE_SERVER- , curveServerKey = ZMQ_CURVE_SERVERKEY- , delayAttachOnConnect = ZMQ_DELAY_ATTACH_ON_CONNECT- , events = ZMQ_EVENTS- , filedesc = ZMQ_FD- , identity = ZMQ_IDENTITY- , immediate = ZMQ_IMMEDIATE- , ipv4Only = ZMQ_IPV4ONLY- , ipv6 = ZMQ_IPV6- , lastEndpoint = ZMQ_LAST_ENDPOINT- , linger = ZMQ_LINGER- , maxMessageSize = ZMQ_MAXMSGSIZE- , mcastHops = ZMQ_MULTICAST_HOPS- , mechanism = ZMQ_MECHANISM- , null = ZMQ_NULL- , plain = ZMQ_PLAIN- , plainPassword = ZMQ_PLAIN_PASSWORD- , plainServer = ZMQ_PLAIN_SERVER- , plainUserName = ZMQ_PLAIN_USERNAME- , probeRouter = ZMQ_PROBE_ROUTER- , rate = ZMQ_RATE- , receiveBuf = ZMQ_RCVBUF- , receiveHighWM = ZMQ_RCVHWM- , receiveMore = ZMQ_RCVMORE- , receiveTimeout = ZMQ_RCVTIMEO- , reconnectIVL = ZMQ_RECONNECT_IVL- , reconnectIVLMax = ZMQ_RECONNECT_IVL_MAX- , recoveryIVL = ZMQ_RECOVERY_IVL- , reqCorrelate = ZMQ_REQ_CORRELATE- , reqRelaxed = ZMQ_REQ_RELAXED- , routerMandatory = ZMQ_ROUTER_MANDATORY- , sendBuf = ZMQ_SNDBUF- , sendHighWM = ZMQ_SNDHWM- , sendTimeout = ZMQ_SNDTIMEO- , subscribe = ZMQ_SUBSCRIBE- , tcpAcceptFilter = ZMQ_TCP_ACCEPT_FILTER- , tcpKeepAlive = ZMQ_TCP_KEEPALIVE- , tcpKeepAliveCount = ZMQ_TCP_KEEPALIVE_CNT- , tcpKeepAliveIdle = ZMQ_TCP_KEEPALIVE_IDLE- , tcpKeepAliveInterval = ZMQ_TCP_KEEPALIVE_INTVL- , unsubscribe = ZMQ_UNSUBSCRIBE- , xpubVerbose = ZMQ_XPUB_VERBOSE- , zapDomain = ZMQ_ZAP_DOMAIN-}---------------------------------------------------------------------------------- Context Options--newtype ZMQCtxOption = ZMQCtxOption- { ctxOptVal :: CInt- } deriving (Eq, Ord)--#{enum ZMQCtxOption, ZMQCtxOption- , _ioThreads = ZMQ_IO_THREADS- , _maxSockets = ZMQ_MAX_SOCKETS-}---------------------------------------------------------------------------------- Event Type--newtype ZMQEventType = ZMQEventType- { eventTypeVal :: Word16- } deriving (Eq, Ord, Show)--#{enum ZMQEventType, ZMQEventType- , connected = ZMQ_EVENT_CONNECTED- , connectDelayed = ZMQ_EVENT_CONNECT_DELAYED- , connectRetried = ZMQ_EVENT_CONNECT_RETRIED- , listening = ZMQ_EVENT_LISTENING- , bindFailed = ZMQ_EVENT_BIND_FAILED- , accepted = ZMQ_EVENT_ACCEPTED- , acceptFailed = ZMQ_EVENT_ACCEPT_FAILED- , closed = ZMQ_EVENT_CLOSED- , closeFailed = ZMQ_EVENT_CLOSE_FAILED- , disconnected = ZMQ_EVENT_DISCONNECTED- , allEvents = ZMQ_EVENT_ALL- , monitorStopped = ZMQ_EVENT_MONITOR_STOPPED-}---------------------------------------------------------------------------------- Event--data ZMQEvent = ZMQEvent- { zeEvent :: {-# UNPACK #-} !ZMQEventType- , zeValue :: {-# UNPACK #-} !Int32- }--instance Storable ZMQEvent where- alignment _ = #{alignment zmq_event_t}- sizeOf _ = #{size zmq_event_t}- peek e = ZMQEvent- <$> (ZMQEventType <$> #{peek zmq_event_t, event} e)- <*> #{peek zmq_event_t, value} e- poke e (ZMQEvent (ZMQEventType a) b) = do- #{poke zmq_event_t, event} e a- #{poke zmq_event_t, value} e b---------------------------------------------------------------------------------- Security Mechanism--newtype ZMQSecMechanism = ZMQSecMechanism- { secMechanism :: Int- } deriving (Eq, Ord, Show)--#{enum ZMQSecMechanism, ZMQSecMechanism- , secNull = ZMQ_NULL- , secPlain = ZMQ_PLAIN- , secCurve = ZMQ_CURVE-}---------------------------------------------------------------------------------- Message Options--newtype ZMQMsgOption = ZMQMsgOption- { msgOptVal :: CInt- } deriving (Eq, Ord)--#{enum ZMQMsgOption, ZMQMsgOption- , more = ZMQ_MORE-}---------------------------------------------------------------------------------- Flags--newtype ZMQFlag = ZMQFlag- { flagVal :: CInt- } deriving (Eq, Ord)--#{enum ZMQFlag, ZMQFlag- , dontWait = ZMQ_DONTWAIT- , sndMore = ZMQ_SNDMORE-}---------------------------------------------------------------------------------- Poll Events--newtype ZMQPollEvent = ZMQPollEvent- { pollVal :: CShort- } deriving (Eq, Ord)--#{enum ZMQPollEvent, ZMQPollEvent,- pollIn = ZMQ_POLLIN,- pollOut = ZMQ_POLLOUT,- pollerr = ZMQ_POLLERR-}---------------------------------------------------------------------------------- function declarations---- general initialization--foreign import ccall unsafe "zmq.h zmq_version"- c_zmq_version :: Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()--foreign import ccall unsafe "zmq.h zmq_ctx_new"- c_zmq_ctx_new :: IO ZMQCtx--foreign import ccall unsafe "zmq.h zmq_ctx_shutdown"- c_zmq_ctx_shutdown :: ZMQCtx -> IO CInt--foreign import ccall unsafe "zmq.h zmq_ctx_term"- c_zmq_ctx_term :: ZMQCtx -> IO CInt--foreign import ccall unsafe "zmq.h zmq_ctx_get"- c_zmq_ctx_get :: ZMQCtx -> CInt -> IO CInt--foreign import ccall unsafe "zmq.h zmq_ctx_set"- c_zmq_ctx_set :: ZMQCtx -> CInt -> CInt -> IO CInt---- zmq_msg_t related--foreign import ccall unsafe "zmq.h zmq_msg_init"- c_zmq_msg_init :: ZMQMsgPtr -> IO CInt--foreign import ccall unsafe "zmq.h zmq_msg_init_size"- c_zmq_msg_init_size :: ZMQMsgPtr -> CSize -> IO CInt--foreign import ccall unsafe "zmq.h zmq_msg_close"- c_zmq_msg_close :: ZMQMsgPtr -> IO CInt--foreign import ccall unsafe "zmq.h zmq_msg_data"- c_zmq_msg_data :: ZMQMsgPtr -> IO (Ptr a)--foreign import ccall unsafe "zmq.h zmq_msg_size"- c_zmq_msg_size :: ZMQMsgPtr -> IO CSize--foreign import ccall unsafe "zmq.h zmq_msg_get"- c_zmq_msg_get :: ZMQMsgPtr -> CInt -> IO CInt--foreign import ccall unsafe "zmq.h zmq_msg_set"- c_zmq_msg_set :: ZMQMsgPtr -> CInt -> CInt -> IO CInt---- socket--foreign import ccall unsafe "zmq.h zmq_socket"- c_zmq_socket :: ZMQCtx -> CInt -> IO ZMQSocket--foreign import ccall unsafe "zmq.h zmq_close"- c_zmq_close :: ZMQSocket -> IO CInt--foreign import ccall unsafe "zmq.h zmq_setsockopt"- c_zmq_setsockopt :: ZMQSocket- -> CInt -- option- -> Ptr () -- option value- -> CSize -- option value size- -> IO CInt--foreign import ccall unsafe "zmq.h zmq_getsockopt"- c_zmq_getsockopt :: ZMQSocket- -> CInt -- option- -> Ptr () -- option value- -> Ptr CSize -- option value size ptr- -> IO CInt--foreign import ccall unsafe "zmq.h zmq_bind"- c_zmq_bind :: ZMQSocket -> CString -> IO CInt--foreign import ccall unsafe "zmq.h zmq_unbind"- c_zmq_unbind :: ZMQSocket -> CString -> IO CInt--foreign import ccall unsafe "zmq.h zmq_connect"- c_zmq_connect :: ZMQSocket -> CString -> IO CInt--foreign import ccall unsafe "zmq.h zmq_disconnect"- c_zmq_disconnect :: ZMQSocket -> CString -> IO CInt--#ifdef mingw32_HOST_OS-foreign import ccall safe "zmq.h zmq_sendmsg"- c_zmq_sendmsg :: ZMQSocket -> ZMQMsgPtr -> CInt -> IO CInt--foreign import ccall safe "zmq.h zmq_recvmsg"- c_zmq_recvmsg :: ZMQSocket -> ZMQMsgPtr -> CInt -> IO CInt-#else-foreign import ccall unsafe "zmq.h zmq_sendmsg"- c_zmq_sendmsg :: ZMQSocket -> ZMQMsgPtr -> CInt -> IO CInt--foreign import ccall unsafe "zmq.h zmq_recvmsg"- c_zmq_recvmsg :: ZMQSocket -> ZMQMsgPtr -> CInt -> IO CInt-#endif--foreign import ccall unsafe "zmq.h zmq_socket_monitor"- c_zmq_socket_monitor :: ZMQSocket -> CString -> CInt -> IO CInt---- errors--foreign import ccall unsafe "zmq.h zmq_errno"- c_zmq_errno :: IO CInt--foreign import ccall unsafe "zmq.h zmq_strerror"- c_zmq_strerror :: CInt -> IO CString---- proxy--foreign import ccall safe "zmq.h zmq_proxy"- c_zmq_proxy :: ZMQSocket -> ZMQSocket -> ZMQSocket -> IO CInt---- poll--foreign import ccall safe "zmq.h zmq_poll"- c_zmq_poll :: ZMQPollPtr -> CInt -> CLong -> IO CInt---- Z85 encode/decode--foreign import ccall unsafe "zmq.h zmq_z85_encode"- c_zmq_z85_encode :: CString -> Ptr Word8 -> CSize -> IO CString--foreign import ccall unsafe "zmq.h zmq_z85_decode"- c_zmq_z85_decode :: Ptr Word8 -> CString -> IO (Ptr Word8)---- curve crypto--foreign import ccall unsafe "zmq.h zmq_curve_keypair"- c_zmq_curve_keypair :: CString -> CString -> IO CInt-
− src/System/ZMQ4/Error.hs
@@ -1,99 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}---- We use our own functions for throwing exceptions in order to get--- the actual error message via 'zmq_strerror'. 0MQ defines additional--- error numbers besides those defined by the operating system, so--- 'zmq_strerror' should be used in preference to 'strerror' which is--- used by the standard throw* functions in 'Foreign.C.Error'.-module System.ZMQ4.Error where--import Control.Applicative-import Control.Monad-import Control.Exception-import Text.Printf-import Data.Typeable (Typeable)--import Foreign hiding (throwIf, throwIf_, void)-import Foreign.C.Error-import Foreign.C.String-import Foreign.C.Types (CInt)--import System.ZMQ4.Base---- | ZMQError encapsulates information about errors, which occur--- when using the native 0MQ API, such as error number and message.-data ZMQError = ZMQError- { errno :: Int -- ^ Error number value.- , source :: String -- ^ Source where this error originates from.- , message :: String -- ^ Actual error message.- } deriving (Eq, Ord, Typeable)--instance Show ZMQError where- show e = printf "ZMQError { errno = %d, source = \"%s\", message = \"%s\" }"- (errno e) (source e) (message e)--instance Exception ZMQError--throwError :: String -> IO a-throwError src = do- (Errno e) <- zmqErrno- msg <- zmqErrnoMessage e- throwIO $ ZMQError (fromIntegral e) src msg--throwIf :: (a -> Bool) -> String -> IO a -> IO a-throwIf p src act = do- r <- act- if p r then throwError src else return r--throwIf_ :: (a -> Bool) -> String -> IO a -> IO ()-throwIf_ p src act = void $ throwIf p src act--throwIfRetry :: (a -> Bool) -> String -> IO a -> IO a-throwIfRetry p src act = do- r <- act- if p r then zmqErrno >>= k else return r- where- k e | e == eINTR = throwIfRetry p src act- | otherwise = throwError src--throwIfRetry_ :: (a -> Bool) -> String -> IO a -> IO ()-throwIfRetry_ p src act = void $ throwIfRetry p src act--throwIfMinus1 :: (Eq a, Num a) => String -> IO a -> IO a-throwIfMinus1 = throwIf (== -1)--throwIfMinus1_ :: (Eq a, Num a) => String -> IO a -> IO ()-throwIfMinus1_ = throwIf_ (== -1)--throwIfNull :: String -> IO (Ptr a) -> IO (Ptr a)-throwIfNull = throwIf (== nullPtr)--throwIfMinus1Retry :: (Eq a, Num a) => String -> IO a -> IO a-throwIfMinus1Retry = throwIfRetry (== -1)--throwIfMinus1Retry_ :: (Eq a, Num a) => String -> IO a -> IO ()-throwIfMinus1Retry_ = throwIfRetry_ (== -1)--throwIfRetryMayBlock :: (a -> Bool) -> String -> IO a -> IO b -> IO a-throwIfRetryMayBlock p src f on_block = do- r <- f- if p r then zmqErrno >>= k else return r- where- k e | e == eINTR = throwIfRetryMayBlock p src f on_block- | e == eWOULDBLOCK || e == eAGAIN = on_block >> throwIfRetryMayBlock p src f on_block- | otherwise = throwError src--throwIfRetryMayBlock_ :: (a -> Bool) -> String -> IO a -> IO b -> IO ()-throwIfRetryMayBlock_ p src f on_block = void $ throwIfRetryMayBlock p src f on_block--throwIfMinus1RetryMayBlock :: (Eq a, Num a) => String -> IO a -> IO b -> IO a-throwIfMinus1RetryMayBlock = throwIfRetryMayBlock (== -1)--throwIfMinus1RetryMayBlock_ :: (Eq a, Num a) => String -> IO a -> IO b -> IO ()-throwIfMinus1RetryMayBlock_ = throwIfRetryMayBlock_ (== -1)--zmqErrnoMessage :: CInt -> IO String-zmqErrnoMessage e = c_zmq_strerror e >>= peekCString--zmqErrno :: IO Errno-zmqErrno = Errno <$> c_zmq_errno
src/System/ZMQ4/Internal.hs view
@@ -1,6 +1,9 @@+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE StandaloneDeriving #-} +-- | /Warning/: This is an internal module and subject+-- to change without notice. module System.ZMQ4.Internal ( Context (..) , Socket (..)@@ -68,10 +71,11 @@ import Data.IORef (newIORef) import Data.Restricted+import Data.Typeable import System.Posix.Types (Fd(..))-import System.ZMQ4.Base-import System.ZMQ4.Error+import System.ZMQ4.Internal.Base+import System.ZMQ4.Internal.Error import qualified Data.ByteString as SB import qualified Data.ByteString.Lazy as LB@@ -139,6 +143,8 @@ -- | A 0MQ context representation. newtype Context = Context { _ctx :: ZMQCtx }++deriving instance Typeable Context -- | A 0MQ Socket. newtype Socket a = Socket
+ src/System/ZMQ4/Internal/Base.hsc view
@@ -0,0 +1,387 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- | /Warning/: This is an internal module and subject+-- to change without notice.+module System.ZMQ4.Internal.Base where++import Foreign+import Foreign.C.Types+import Foreign.C.String+import Control.Applicative++#include <zmq.h>++#if ZMQ_VERSION_MAJOR != 4+ #error *** INVALID 0MQ VERSION (must be 4.x) ***+#endif++-----------------------------------------------------------------------------+-- Message++newtype ZMQMsg = ZMQMsg+ { content :: Ptr ()+ } deriving (Eq, Ord)++instance Storable ZMQMsg where+ alignment _ = #{alignment zmq_msg_t}+ sizeOf _ = #{size zmq_msg_t}+ peek p = ZMQMsg <$> #{peek zmq_msg_t, _} p+ poke p (ZMQMsg c) = #{poke zmq_msg_t, _} p c++-----------------------------------------------------------------------------+-- Poll++data ZMQPoll = ZMQPoll+ { pSocket :: {-# UNPACK #-} !ZMQSocket+ , pFd :: {-# UNPACK #-} !CInt+ , pEvents :: {-# UNPACK #-} !CShort+ , pRevents :: {-# UNPACK #-} !CShort+ }++instance Storable ZMQPoll where+ alignment _ = #{alignment zmq_pollitem_t}+ sizeOf _ = #{size zmq_pollitem_t}+ peek p = do+ s <- #{peek zmq_pollitem_t, socket} p+ f <- #{peek zmq_pollitem_t, fd} p+ e <- #{peek zmq_pollitem_t, events} p+ re <- #{peek zmq_pollitem_t, revents} p+ return $ ZMQPoll s f e re+ poke p (ZMQPoll s f e re) = do+ #{poke zmq_pollitem_t, socket} p s+ #{poke zmq_pollitem_t, fd} p f+ #{poke zmq_pollitem_t, events} p e+ #{poke zmq_pollitem_t, revents} p re++type ZMQMsgPtr = Ptr ZMQMsg+type ZMQCtx = Ptr ()+type ZMQSocket = Ptr ()+type ZMQPollPtr = Ptr ZMQPoll++#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)++-----------------------------------------------------------------------------+-- Socket Types++newtype ZMQSocketType = ZMQSocketType+ { typeVal :: CInt+ } deriving (Eq, Ord)++#{enum ZMQSocketType, ZMQSocketType+ , pair = ZMQ_PAIR+ , pub = ZMQ_PUB+ , sub = ZMQ_SUB+ , xpub = ZMQ_XPUB+ , xsub = ZMQ_XSUB+ , request = ZMQ_REQ+ , response = ZMQ_REP+ , dealer = ZMQ_DEALER+ , router = ZMQ_ROUTER+ , pull = ZMQ_PULL+ , push = ZMQ_PUSH+ , stream = ZMQ_STREAM+}++-----------------------------------------------------------------------------+-- Socket Options++newtype ZMQOption = ZMQOption+ { optVal :: CInt+ } deriving (Eq, Ord)++#{enum ZMQOption, ZMQOption+ , affinity = ZMQ_AFFINITY+ , backlog = ZMQ_BACKLOG+ , conflate = ZMQ_CONFLATE+ , curve = ZMQ_CURVE+ , curvePublicKey = ZMQ_CURVE_PUBLICKEY+ , curveSecretKey = ZMQ_CURVE_SECRETKEY+ , curveServer = ZMQ_CURVE_SERVER+ , curveServerKey = ZMQ_CURVE_SERVERKEY+ , delayAttachOnConnect = ZMQ_DELAY_ATTACH_ON_CONNECT+ , events = ZMQ_EVENTS+ , filedesc = ZMQ_FD+ , identity = ZMQ_IDENTITY+ , immediate = ZMQ_IMMEDIATE+ , ipv4Only = ZMQ_IPV4ONLY+ , ipv6 = ZMQ_IPV6+ , lastEndpoint = ZMQ_LAST_ENDPOINT+ , linger = ZMQ_LINGER+ , maxMessageSize = ZMQ_MAXMSGSIZE+ , mcastHops = ZMQ_MULTICAST_HOPS+ , mechanism = ZMQ_MECHANISM+ , null = ZMQ_NULL+ , plain = ZMQ_PLAIN+ , plainPassword = ZMQ_PLAIN_PASSWORD+ , plainServer = ZMQ_PLAIN_SERVER+ , plainUserName = ZMQ_PLAIN_USERNAME+ , probeRouter = ZMQ_PROBE_ROUTER+ , rate = ZMQ_RATE+ , receiveBuf = ZMQ_RCVBUF+ , receiveHighWM = ZMQ_RCVHWM+ , receiveMore = ZMQ_RCVMORE+ , receiveTimeout = ZMQ_RCVTIMEO+ , reconnectIVL = ZMQ_RECONNECT_IVL+ , reconnectIVLMax = ZMQ_RECONNECT_IVL_MAX+ , recoveryIVL = ZMQ_RECOVERY_IVL+ , reqCorrelate = ZMQ_REQ_CORRELATE+ , reqRelaxed = ZMQ_REQ_RELAXED+ , routerMandatory = ZMQ_ROUTER_MANDATORY+ , sendBuf = ZMQ_SNDBUF+ , sendHighWM = ZMQ_SNDHWM+ , sendTimeout = ZMQ_SNDTIMEO+ , subscribe = ZMQ_SUBSCRIBE+ , tcpAcceptFilter = ZMQ_TCP_ACCEPT_FILTER+ , tcpKeepAlive = ZMQ_TCP_KEEPALIVE+ , tcpKeepAliveCount = ZMQ_TCP_KEEPALIVE_CNT+ , tcpKeepAliveIdle = ZMQ_TCP_KEEPALIVE_IDLE+ , tcpKeepAliveInterval = ZMQ_TCP_KEEPALIVE_INTVL+ , unsubscribe = ZMQ_UNSUBSCRIBE+ , xpubVerbose = ZMQ_XPUB_VERBOSE+ , zapDomain = ZMQ_ZAP_DOMAIN+}++-----------------------------------------------------------------------------+-- Context Options++newtype ZMQCtxOption = ZMQCtxOption+ { ctxOptVal :: CInt+ } deriving (Eq, Ord)++#{enum ZMQCtxOption, ZMQCtxOption+ , _ioThreads = ZMQ_IO_THREADS+ , _maxSockets = ZMQ_MAX_SOCKETS+}++-----------------------------------------------------------------------------+-- Event Type++newtype ZMQEventType = ZMQEventType+ { eventTypeVal :: Word16+ } deriving (Eq, Ord, Show, Storable)++#{enum ZMQEventType, ZMQEventType+ , connected = ZMQ_EVENT_CONNECTED+ , connectDelayed = ZMQ_EVENT_CONNECT_DELAYED+ , connectRetried = ZMQ_EVENT_CONNECT_RETRIED+ , listening = ZMQ_EVENT_LISTENING+ , bindFailed = ZMQ_EVENT_BIND_FAILED+ , accepted = ZMQ_EVENT_ACCEPTED+ , acceptFailed = ZMQ_EVENT_ACCEPT_FAILED+ , closed = ZMQ_EVENT_CLOSED+ , closeFailed = ZMQ_EVENT_CLOSE_FAILED+ , disconnected = ZMQ_EVENT_DISCONNECTED+ , allEvents = ZMQ_EVENT_ALL+ , monitorStopped = ZMQ_EVENT_MONITOR_STOPPED+}++-----------------------------------------------------------------------------+-- Event++data ZMQEvent = ZMQEvent+ { zeEvent :: {-# UNPACK #-} !ZMQEventType+ , zeValue :: {-# UNPACK #-} !Int32+ }++#if ZMQ_VERSION < 40100+instance Storable ZMQEvent where+ alignment _ = #{alignment zmq_event_t}+ sizeOf _ = #{size zmq_event_t}+ peek e = ZMQEvent+ <$> (ZMQEventType <$> #{peek zmq_event_t, event} e)+ <*> #{peek zmq_event_t, value} e+ poke e (ZMQEvent (ZMQEventType a) b) = do+ #{poke zmq_event_t, event} e a+ #{poke zmq_event_t, value} e b+#endif++peekZMQEvent :: ZMQMsgPtr -> IO ZMQEvent+peekZMQEvent m = do+ p <- c_zmq_msg_data m+#if ZMQ_VERSION < 40100+ peek p+#else+ e <- peek p+ v <- peek (p `plusPtr` 2)+ return (ZMQEvent e v)+#endif++-----------------------------------------------------------------------------+-- Security Mechanism++newtype ZMQSecMechanism = ZMQSecMechanism+ { secMechanism :: Int+ } deriving (Eq, Ord, Show)++#{enum ZMQSecMechanism, ZMQSecMechanism+ , secNull = ZMQ_NULL+ , secPlain = ZMQ_PLAIN+ , secCurve = ZMQ_CURVE+}++-----------------------------------------------------------------------------+-- Message Options++newtype ZMQMsgOption = ZMQMsgOption+ { msgOptVal :: CInt+ } deriving (Eq, Ord)++#{enum ZMQMsgOption, ZMQMsgOption+ , more = ZMQ_MORE+}++-----------------------------------------------------------------------------+-- Flags++newtype ZMQFlag = ZMQFlag+ { flagVal :: CInt+ } deriving (Eq, Ord)++#{enum ZMQFlag, ZMQFlag+ , dontWait = ZMQ_DONTWAIT+ , sndMore = ZMQ_SNDMORE+}++-----------------------------------------------------------------------------+-- Poll Events++newtype ZMQPollEvent = ZMQPollEvent+ { pollVal :: CShort+ } deriving (Eq, Ord)++#{enum ZMQPollEvent, ZMQPollEvent,+ pollIn = ZMQ_POLLIN,+ pollOut = ZMQ_POLLOUT,+ pollerr = ZMQ_POLLERR+}++-----------------------------------------------------------------------------+-- function declarations++-- general initialization++foreign import ccall unsafe "zmq.h zmq_version"+ c_zmq_version :: Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()++foreign import ccall unsafe "zmq.h zmq_ctx_new"+ c_zmq_ctx_new :: IO ZMQCtx++foreign import ccall unsafe "zmq.h zmq_ctx_shutdown"+ c_zmq_ctx_shutdown :: ZMQCtx -> IO CInt++foreign import ccall unsafe "zmq.h zmq_ctx_term"+ c_zmq_ctx_term :: ZMQCtx -> IO CInt++foreign import ccall unsafe "zmq.h zmq_ctx_get"+ c_zmq_ctx_get :: ZMQCtx -> CInt -> IO CInt++foreign import ccall unsafe "zmq.h zmq_ctx_set"+ c_zmq_ctx_set :: ZMQCtx -> CInt -> CInt -> IO CInt++-- zmq_msg_t related++foreign import ccall unsafe "zmq.h zmq_msg_init"+ c_zmq_msg_init :: ZMQMsgPtr -> IO CInt++foreign import ccall unsafe "zmq.h zmq_msg_init_size"+ c_zmq_msg_init_size :: ZMQMsgPtr -> CSize -> IO CInt++foreign import ccall unsafe "zmq.h zmq_msg_close"+ c_zmq_msg_close :: ZMQMsgPtr -> IO CInt++foreign import ccall unsafe "zmq.h zmq_msg_data"+ c_zmq_msg_data :: ZMQMsgPtr -> IO (Ptr a)++foreign import ccall unsafe "zmq.h zmq_msg_size"+ c_zmq_msg_size :: ZMQMsgPtr -> IO CSize++foreign import ccall unsafe "zmq.h zmq_msg_get"+ c_zmq_msg_get :: ZMQMsgPtr -> CInt -> IO CInt++foreign import ccall unsafe "zmq.h zmq_msg_set"+ c_zmq_msg_set :: ZMQMsgPtr -> CInt -> CInt -> IO CInt++-- socket++foreign import ccall unsafe "zmq.h zmq_socket"+ c_zmq_socket :: ZMQCtx -> CInt -> IO ZMQSocket++foreign import ccall unsafe "zmq.h zmq_close"+ c_zmq_close :: ZMQSocket -> IO CInt++foreign import ccall unsafe "zmq.h zmq_setsockopt"+ c_zmq_setsockopt :: ZMQSocket+ -> CInt -- option+ -> Ptr () -- option value+ -> CSize -- option value size+ -> IO CInt++foreign import ccall unsafe "zmq.h zmq_getsockopt"+ c_zmq_getsockopt :: ZMQSocket+ -> CInt -- option+ -> Ptr () -- option value+ -> Ptr CSize -- option value size ptr+ -> IO CInt++foreign import ccall unsafe "zmq.h zmq_bind"+ c_zmq_bind :: ZMQSocket -> CString -> IO CInt++foreign import ccall unsafe "zmq.h zmq_unbind"+ c_zmq_unbind :: ZMQSocket -> CString -> IO CInt++foreign import ccall unsafe "zmq.h zmq_connect"+ c_zmq_connect :: ZMQSocket -> CString -> IO CInt++foreign import ccall unsafe "zmq.h zmq_disconnect"+ c_zmq_disconnect :: ZMQSocket -> CString -> IO CInt++#ifdef mingw32_HOST_OS+foreign import ccall safe "zmq.h zmq_sendmsg"+ c_zmq_sendmsg :: ZMQSocket -> ZMQMsgPtr -> CInt -> IO CInt++foreign import ccall safe "zmq.h zmq_recvmsg"+ c_zmq_recvmsg :: ZMQSocket -> ZMQMsgPtr -> CInt -> IO CInt+#else+foreign import ccall unsafe "zmq.h zmq_sendmsg"+ c_zmq_sendmsg :: ZMQSocket -> ZMQMsgPtr -> CInt -> IO CInt++foreign import ccall unsafe "zmq.h zmq_recvmsg"+ c_zmq_recvmsg :: ZMQSocket -> ZMQMsgPtr -> CInt -> IO CInt+#endif++foreign import ccall unsafe "zmq.h zmq_socket_monitor"+ c_zmq_socket_monitor :: ZMQSocket -> CString -> CInt -> IO CInt++-- errors++foreign import ccall unsafe "zmq.h zmq_errno"+ c_zmq_errno :: IO CInt++foreign import ccall unsafe "zmq.h zmq_strerror"+ c_zmq_strerror :: CInt -> IO CString++-- proxy++foreign import ccall safe "zmq.h zmq_proxy"+ c_zmq_proxy :: ZMQSocket -> ZMQSocket -> ZMQSocket -> IO CInt++-- poll++foreign import ccall safe "zmq.h zmq_poll"+ c_zmq_poll :: ZMQPollPtr -> CInt -> CLong -> IO CInt++-- Z85 encode/decode++foreign import ccall unsafe "zmq.h zmq_z85_encode"+ c_zmq_z85_encode :: CString -> Ptr Word8 -> CSize -> IO CString++foreign import ccall unsafe "zmq.h zmq_z85_decode"+ c_zmq_z85_decode :: Ptr Word8 -> CString -> IO (Ptr Word8)++-- curve crypto++foreign import ccall unsafe "zmq.h zmq_curve_keypair"+ c_zmq_curve_keypair :: CString -> CString -> IO CInt+
+ src/System/ZMQ4/Internal/Error.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE DeriveDataTypeable #-}++-- | We use our own functions for throwing exceptions in order to get+-- the actual error message via 'zmq_strerror'. 0MQ defines additional+-- error numbers besides those defined by the operating system, so+-- 'zmq_strerror' should be used in preference to 'strerror' which is+-- used by the standard throw* functions in 'Foreign.C.Error'.+--+-- /Warning/: This is an internal module and subject+-- to change without notice.+module System.ZMQ4.Internal.Error where++import Control.Applicative+import Control.Monad+import Control.Exception+import Text.Printf+import Data.Typeable (Typeable)++import Foreign hiding (throwIf, throwIf_, void)+import Foreign.C.Error+import Foreign.C.String+import Foreign.C.Types (CInt)++import System.ZMQ4.Internal.Base++-- | ZMQError encapsulates information about errors, which occur+-- when using the native 0MQ API, such as error number and message.+data ZMQError = ZMQError+ { errno :: Int -- ^ Error number value.+ , source :: String -- ^ Source where this error originates from.+ , message :: String -- ^ Actual error message.+ } deriving (Eq, Ord, Typeable)++instance Show ZMQError where+ show e = printf "ZMQError { errno = %d, source = \"%s\", message = \"%s\" }"+ (errno e) (source e) (message e)++instance Exception ZMQError++throwError :: String -> IO a+throwError src = do+ (Errno e) <- zmqErrno+ msg <- zmqErrnoMessage e+ throwIO $ ZMQError (fromIntegral e) src msg++throwIf :: (a -> Bool) -> String -> IO a -> IO a+throwIf p src act = do+ r <- act+ if p r then throwError src else return r++throwIf_ :: (a -> Bool) -> String -> IO a -> IO ()+throwIf_ p src act = void $ throwIf p src act++throwIfRetry :: (a -> Bool) -> String -> IO a -> IO a+throwIfRetry p src act = do+ r <- act+ if p r then zmqErrno >>= k else return r+ where+ k e | e == eINTR = throwIfRetry p src act+ | otherwise = throwError src++throwIfRetry_ :: (a -> Bool) -> String -> IO a -> IO ()+throwIfRetry_ p src act = void $ throwIfRetry p src act++throwIfMinus1 :: (Eq a, Num a) => String -> IO a -> IO a+throwIfMinus1 = throwIf (== -1)++throwIfMinus1_ :: (Eq a, Num a) => String -> IO a -> IO ()+throwIfMinus1_ = throwIf_ (== -1)++throwIfNull :: String -> IO (Ptr a) -> IO (Ptr a)+throwIfNull = throwIf (== nullPtr)++throwIfMinus1Retry :: (Eq a, Num a) => String -> IO a -> IO a+throwIfMinus1Retry = throwIfRetry (== -1)++throwIfMinus1Retry_ :: (Eq a, Num a) => String -> IO a -> IO ()+throwIfMinus1Retry_ = throwIfRetry_ (== -1)++throwIfRetryMayBlock :: (a -> Bool) -> String -> IO a -> IO b -> IO a+throwIfRetryMayBlock p src f on_block = do+ r <- f+ if p r then zmqErrno >>= k else return r+ where+ k e | e == eINTR = throwIfRetryMayBlock p src f on_block+ | e == eWOULDBLOCK || e == eAGAIN = on_block >> throwIfRetryMayBlock p src f on_block+ | otherwise = throwError src++throwIfRetryMayBlock_ :: (a -> Bool) -> String -> IO a -> IO b -> IO ()+throwIfRetryMayBlock_ p src f on_block = void $ throwIfRetryMayBlock p src f on_block++throwIfMinus1RetryMayBlock :: (Eq a, Num a) => String -> IO a -> IO b -> IO a+throwIfMinus1RetryMayBlock = throwIfRetryMayBlock (== -1)++throwIfMinus1RetryMayBlock_ :: (Eq a, Num a) => String -> IO a -> IO b -> IO ()+throwIfMinus1RetryMayBlock_ = throwIfRetryMayBlock_ (== -1)++zmqErrnoMessage :: CInt -> IO String+zmqErrnoMessage e = c_zmq_strerror e >>= peekCString++zmqErrno :: IO Errno+zmqErrno = Errno <$> c_zmq_errno
zeromq4-haskell.cabal view
@@ -1,12 +1,12 @@ name: zeromq4-haskell-version: 0.6.2+version: 0.6.3 synopsis: Bindings to ZeroMQ 4.x category: System, FFI license: MIT license-file: LICENSE author: Toralf Wittner maintainer: Toralf Wittner <tw@dtex.org>-copyright: (c) 2010 - 2014 zeromq-haskell authors+copyright: (c) 2010 - 2015 zeromq-haskell authors homepage: http://github.com/twittner/zeromq-haskell/ stability: experimental tested-With: GHC == 7.6.3@@ -40,24 +40,22 @@ library hs-source-dirs: src+ ghc-options: -Wall -O2 -fwarn-tabs -funbox-strict-fields+ exposed-modules:+ Data.Restricted System.ZMQ4 System.ZMQ4.Monadic- Data.Restricted-- other-modules:- System.ZMQ4.Base System.ZMQ4.Internal- System.ZMQ4.Error-- ghc-options: -Wall -O2 -fwarn-tabs -funbox-strict-fields+ System.ZMQ4.Internal.Base+ System.ZMQ4.Internal.Error build-depends: base >= 3 && < 5 , async == 2.0.* , bytestring , containers- , exceptions == 0.6.*+ , exceptions >= 0.6 && < 1.0 , semigroups >= 0.8 , transformers >= 0.3