module System.ZMQ.Base where
import Foreign
import Foreign.C.Types
import Foreign.C.String
import Control.Applicative
zmqVersion :: (Int, Int, Int)
zmqVersion = ( 2
, 1
, 10)
newtype ZMQMsg = ZMQMsg { content :: Ptr () }
instance Storable ZMQMsg where
alignment _ = 8
sizeOf _ = (40)
peek p = ZMQMsg <$> (\hsc_ptr -> peekByteOff hsc_ptr 0) p
poke p (ZMQMsg c) = (\hsc_ptr -> pokeByteOff hsc_ptr 0) p c
data ZMQPoll = ZMQPoll
{ pSocket :: ZMQSocket
, pFd :: CInt
, pEvents :: CShort
, pRevents :: CShort
}
instance Storable ZMQPoll where
alignment _ = 8
sizeOf _ = (16)
peek p = do
s <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
f <- (\hsc_ptr -> peekByteOff hsc_ptr 8) p
e <- (\hsc_ptr -> peekByteOff hsc_ptr 12) p
re <- (\hsc_ptr -> peekByteOff hsc_ptr 14) p
return $ ZMQPoll s f e re
poke p (ZMQPoll s f e re) = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) p s
(\hsc_ptr -> pokeByteOff hsc_ptr 8) p f
(\hsc_ptr -> pokeByteOff hsc_ptr 12) p e
(\hsc_ptr -> pokeByteOff hsc_ptr 14) p re
type ZMQMsgPtr = Ptr ZMQMsg
type ZMQCtx = Ptr ()
type ZMQSocket = Ptr ()
type ZMQPollPtr = Ptr ZMQPoll
newtype ZMQSocketType = ZMQSocketType { typeVal :: CInt } deriving (Eq, Ord)
pair :: ZMQSocketType
pair = ZMQSocketType 0
pub :: ZMQSocketType
pub = ZMQSocketType 1
sub :: ZMQSocketType
sub = ZMQSocketType 2
xpub :: ZMQSocketType
xpub = ZMQSocketType 9
xsub :: ZMQSocketType
xsub = ZMQSocketType 10
request :: ZMQSocketType
request = ZMQSocketType 3
response :: ZMQSocketType
response = ZMQSocketType 4
xrequest :: ZMQSocketType
xrequest = ZMQSocketType 5
xresponse :: ZMQSocketType
xresponse = ZMQSocketType 6
pull :: ZMQSocketType
pull = ZMQSocketType 7
push :: ZMQSocketType
push = ZMQSocketType 8
upstream :: ZMQSocketType
upstream = ZMQSocketType 7
downstream :: ZMQSocketType
downstream = ZMQSocketType 8
newtype ZMQOption = ZMQOption { optVal :: CInt } deriving (Eq, Ord)
affinity :: ZMQOption
affinity = ZMQOption 4
backlog :: ZMQOption
backlog = ZMQOption 19
events :: ZMQOption
events = ZMQOption 15
filedesc :: ZMQOption
filedesc = ZMQOption 14
identity :: ZMQOption
identity = ZMQOption 5
linger :: ZMQOption
linger = ZMQOption 17
rate :: ZMQOption
rate = ZMQOption 8
receiveBuf :: ZMQOption
receiveBuf = ZMQOption 12
receiveMore :: ZMQOption
receiveMore = ZMQOption 13
reconnectIVL :: ZMQOption
reconnectIVL = ZMQOption 18
reconnectIVLMax :: ZMQOption
reconnectIVLMax = ZMQOption 21
recoveryIVL :: ZMQOption
recoveryIVL = ZMQOption 9
sendBuf :: ZMQOption
sendBuf = ZMQOption 11
subscribe :: ZMQOption
subscribe = ZMQOption 6
unsubscribe :: ZMQOption
unsubscribe = ZMQOption 7
highWM :: ZMQOption
highWM = ZMQOption 1
mcastLoop :: ZMQOption
mcastLoop = ZMQOption 10
recoveryIVLMsec :: ZMQOption
recoveryIVLMsec = ZMQOption 20
swap :: ZMQOption
swap = ZMQOption 3
newtype ZMQFlag = ZMQFlag { flagVal :: CInt } deriving (Eq, Ord)
noBlock :: ZMQFlag
noBlock = ZMQFlag 1
sndMore :: ZMQFlag
sndMore = ZMQFlag 2
newtype ZMQPollEvent = ZMQPollEvent { pollVal :: CShort } deriving (Eq, Ord)
pollIn :: ZMQPollEvent
pollIn = ZMQPollEvent 1
pollOut :: ZMQPollEvent
pollOut = ZMQPollEvent 2
pollerr :: ZMQPollEvent
pollerr = ZMQPollEvent 4
pollInOut :: ZMQPollEvent
pollInOut = ZMQPollEvent 3
newtype ZMQDevice = ZMQDevice { deviceType :: CInt } deriving (Eq, Ord)
deviceStreamer :: ZMQDevice
deviceStreamer = ZMQDevice 1
deviceForwarder :: ZMQDevice
deviceForwarder = ZMQDevice 2
deviceQueue :: ZMQDevice
deviceQueue = ZMQDevice 3
foreign import ccall safe "zmq.h zmq_device"
c_zmq_device :: CInt -> ZMQSocket -> ZMQSocket -> IO CInt
foreign import ccall unsafe "zmq.h zmq_init"
c_zmq_init :: CInt -> IO ZMQCtx
foreign import ccall unsafe "zmq.h zmq_term"
c_zmq_term :: ZMQCtx -> IO CInt
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_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
-> Ptr ()
-> CSize
-> IO CInt
foreign import ccall unsafe "zmq.h zmq_getsockopt"
c_zmq_getsockopt :: ZMQSocket
-> CInt
-> Ptr ()
-> Ptr CSize
-> IO CInt
foreign import ccall unsafe "zmq.h zmq_bind"
c_zmq_bind :: 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_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
foreign import ccall safe "zmq.h zmq_poll"
c_zmq_poll :: ZMQPollPtr -> CInt -> CLong -> IO CInt