Permalink
Browse files

Initial commit.

Rough first draft of basic 0MQ FFI.
  • Loading branch information...
0 parents commit a62abe5d2ca6c0d4664b3cade59821b0a64ede2f Toralf Wittner committed Jan 16, 2010
Showing with 579 additions and 0 deletions.
  1. +165 −0 LICENSE
  2. +1 −0 README
  3. +6 −0 Setup.hs
  4. +192 −0 src/System/ZMQ.hs
  5. +185 −0 src/System/ZMQ/Base.hsc
  6. +30 −0 zeromq-haskell.cabal
165 LICENSE
@@ -0,0 +1,165 @@
+ GNU LESSER GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+ This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+ 0. Additional Definitions.
+
+ As used herein, "this License" refers to version 3 of the GNU Lesser
+General Public License, and the "GNU GPL" refers to version 3 of the GNU
+General Public License.
+
+ "The Library" refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+ An "Application" is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+ A "Combined Work" is a work produced by combining or linking an
+Application with the Library. The particular version of the Library
+with which the Combined Work was made is also called the "Linked
+Version".
+
+ The "Minimal Corresponding Source" for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+ The "Corresponding Application Code" for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+ 1. Exception to Section 3 of the GNU GPL.
+
+ You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+ 2. Conveying Modified Versions.
+
+ If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+ a) under this License, provided that you make a good faith effort to
+ ensure that, in the event an Application does not supply the
+ function or data, the facility still operates, and performs
+ whatever part of its purpose remains meaningful, or
+
+ b) under the GNU GPL, with none of the additional permissions of
+ this License applicable to that copy.
+
+ 3. Object Code Incorporating Material from Library Header Files.
+
+ The object code form of an Application may incorporate material from
+a header file that is part of the Library. You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+ a) Give prominent notice with each copy of the object code that the
+ Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the object code with a copy of the GNU GPL and this license
+ document.
+
+ 4. Combined Works.
+
+ You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+ a) Give prominent notice with each copy of the Combined Work that
+ the Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the Combined Work with a copy of the GNU GPL and this license
+ document.
+
+ c) For a Combined Work that displays copyright notices during
+ execution, include the copyright notice for the Library among
+ these notices, as well as a reference directing the user to the
+ copies of the GNU GPL and this license document.
+
+ d) Do one of the following:
+
+ 0) Convey the Minimal Corresponding Source under the terms of this
+ License, and the Corresponding Application Code in a form
+ suitable for, and under terms that permit, the user to
+ recombine or relink the Application with a modified version of
+ the Linked Version to produce a modified Combined Work, in the
+ manner specified by section 6 of the GNU GPL for conveying
+ Corresponding Source.
+
+ 1) Use a suitable shared library mechanism for linking with the
+ Library. A suitable mechanism is one that (a) uses at run time
+ a copy of the Library already present on the user's computer
+ system, and (b) will operate properly with a modified version
+ of the Library that is interface-compatible with the Linked
+ Version.
+
+ e) Provide Installation Information, but only if you would otherwise
+ be required to provide such information under section 6 of the
+ GNU GPL, and only to the extent that such information is
+ necessary to install and execute a modified version of the
+ Combined Work produced by recombining or relinking the
+ Application with a modified version of the Linked Version. (If
+ you use option 4d0, the Installation Information must accompany
+ the Minimal Corresponding Source and Corresponding Application
+ Code. If you use option 4d1, you must provide the Installation
+ Information in the manner specified by section 6 of the GNU GPL
+ for conveying Corresponding Source.)
+
+ 5. Combined Libraries.
+
+ You may place library facilities that are a work based on the
+Library side by side in a single library together with other library
+facilities that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+ a) Accompany the combined library with a copy of the same work based
+ on the Library, uncombined with any other library facilities,
+ conveyed under the terms of this License.
+
+ b) Give prominent notice with the combined library that part of it
+ is a work based on the Library, and explaining where to find the
+ accompanying uncombined form of the same work.
+
+ 6. Revised Versions of the GNU Lesser General Public License.
+
+ The Free Software Foundation may publish revised and/or new versions
+of the GNU Lesser General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the
+Library as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License "or any later version"
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+ If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.
1 README
@@ -0,0 +1 @@
+Haskell bindings to zeromq (http://zeromq.org).
6 Setup.hs
@@ -0,0 +1,6 @@
+module Main where
+
+import Distribution.Simple
+
+main = defaultMain
+
192 src/System/ZMQ.hs
@@ -0,0 +1,192 @@
+-- |
+-- Module : System.ZMQ
+-- Copyright : (c) 2010 Toralf Wittner
+-- License : LGPL
+-- Maintainer : toralf.wittner@gmail.com
+-- Stability : experimental
+-- Portability : non-portable
+--
+
+module System.ZMQ (
+
+ Size,
+ Context,
+ Socket,
+ SocketType(..),
+ SocketOption(..),
+ Flag,
+ Message,
+
+ init,
+ term,
+
+ socket,
+ close,
+ setSockOpt,
+ bind,
+ connect,
+ send,
+ flush,
+ receive
+
+) where
+
+import Prelude hiding (init)
+import Control.Applicative
+import Control.Exception
+import Data.Binary
+import Data.Int
+import System.ZMQ.Base
+import Foreign
+import Foreign.C.Error
+import Foreign.C.String
+import Foreign.C.Types (CInt)
+import qualified Data.ByteString as SB
+import qualified Data.ByteString.Lazy as LB
+import qualified Data.ByteString.Unsafe as UB
+
+
+type Size = Word
+newtype Context = Context { ctx :: ZMQCtx }
+newtype Socket = Socket { sock :: ZMQSocket }
+
+data SocketType = P2P | Pub | Sub | Req | Rep | XReq | XRep | Up | Down
+ deriving (Eq, Ord, Show)
+
+data SocketOption =
+ HighWM Int64
+ | LowWM Int64
+ | Swap Int64
+ | Affinity Int64
+ | Identity String
+ | Subscribe String
+ | Unsubscribe String
+ | Rate Word64
+ | RecoveryIVL Word64
+ | McastLoop Word64
+ | SendBuf Word64
+ | ReceiveBuf Word64
+ deriving (Eq, Ord, Show)
+
+data Flag = NoBlock | NoFlush deriving (Eq, Ord, Show)
+
+init :: Size -> Size -> Flag -> IO Context
+init appThreads ioThreads flag = do
+ c <- throwErrnoIfNull "init" $
+ c_zmq_init (fromIntegral appThreads)
+ (fromIntegral ioThreads)
+ (flagVal . fl2cfl $ flag)
+ return (Context c)
+
+
+term :: Context -> IO ()
+term = throwErrnoIfMinus1_ "term" . c_zmq_term . ctx
+
+socket :: Context -> SocketType -> IO Socket
+socket c st = Socket <$> make c (st2cst st)
+
+close :: Socket -> IO ()
+close = throwErrnoIfMinus1_ "close" . c_zmq_close . sock
+
+setSockOpt :: Socket -> SocketOption -> IO ()
+setSockOpt s (HighWM o) = setOpt s highWM o
+setSockOpt s (LowWM o) = setOpt s lowWM o
+setSockOpt s (Swap o) = setOpt s swap o
+setSockOpt s (Affinity o) = setOpt s affinity o
+setSockOpt s (Identity o) = withCString o $ setOpt s identity
+setSockOpt s (Subscribe o) = withCString o $ setOpt s subscribe
+setSockOpt s (Unsubscribe o) = withCString o $ setOpt s unsubscribe
+setSockOpt s (Rate o) = setOpt s rate o
+setSockOpt s (RecoveryIVL o) = setOpt s recoveryIVL o
+setSockOpt s (McastLoop o) = setOpt s mcastLoop o
+setSockOpt s (SendBuf o) = setOpt s sendBuf o
+setSockOpt s (ReceiveBuf o) = setOpt s receiveBuf o
+
+bind :: Socket -> String -> IO ()
+bind (Socket s) str = throwErrnoIfMinus1_ "bind" $
+ withCString str (c_zmq_bind s)
+
+connect :: Socket -> String -> IO ()
+connect (Socket s) str = throwErrnoIfMinus1_ "connect" $
+ withCString str (c_zmq_connect s)
+
+send :: Binary a => Socket -> a -> [Flag] -> IO ()
+send (Socket s) val fls = mapM_ sendChunk (LB.toChunks . encode $ val)
+ where
+ sendChunk :: SB.ByteString -> IO ()
+ sendChunk b = bracket (messageOf b) messageClose $ \msg ->
+ withStablePtrOf msg $ \ptr -> throwErrnoIfMinus1_ "sendChunk" $
+ c_zmq_send s (castPtr . castStablePtrToPtr $ ptr)
+ (combine fls)
+
+flush :: Socket -> IO ()
+flush = throwErrnoIfMinus1_ "flush" . c_zmq_flush . sock
+
+receive :: Binary a => Socket -> [Flag] -> IO a
+receive = undefined
+
+-- internal helpers:
+
+messageOf :: SB.ByteString -> IO (Message SB.ByteString)
+messageOf b = UB.unsafeUseAsCStringLen b $ \(cstr, len) -> do
+ msg <- messageInitSize (fromIntegral len)
+ withStablePtrOf msg $ \ptr -> do
+ data_ptr <- c_zmq_msg_data (fromStablePtr ptr)
+ copyBytes data_ptr cstr len
+ return msg
+
+messageClose :: Message a -> IO ()
+messageClose m = withStablePtrOf m $ \ptr ->
+ throwErrnoIfMinus1_ "messageClose" $
+ c_zmq_msg_close (fromStablePtr ptr)
+
+messageInit :: IO (Message a)
+messageInit = do
+ let msg = Message nullPtr
+ bracket (newStablePtr msg) freeStablePtr $ \ptr ->
+ throwErrnoIfMinus1_ "messageInit" $
+ c_zmq_msg_init (castPtr . castStablePtrToPtr $ ptr)
+ return msg
+
+messageInitSize :: Word -> IO (Message a)
+messageInitSize s = do
+ let msg = Message nullPtr
+ bracket (newStablePtr msg) freeStablePtr $ \ptr ->
+ throwErrnoIfMinus1_ "messageInitSize" $
+ c_zmq_msg_init_size (castPtr . castStablePtrToPtr $ ptr)
+ (fromIntegral s)
+ return msg
+
+make :: Context -> CSocketType -> IO ZMQSocket
+make (Context c) = throwErrnoIfNull "socket" . c_zmq_socket c . typeVal
+
+setOpt :: (Storable a) => Socket -> OptionType -> a -> IO ()
+setOpt (Socket s) (OptionType o) i = throwErrnoIfMinus1_ "setSockOpt" $
+ withStablePtrOf i $ \ptr ->
+ c_zmq_setsockopt s (fromIntegral o)
+ (fromStablePtr ptr)
+ (fromIntegral . sizeOf $ i)
+
+st2cst :: SocketType -> CSocketType
+st2cst P2P = p2p
+st2cst Pub = pub
+st2cst Sub = sub
+st2cst Req = request
+st2cst Rep = response
+st2cst XReq = xrequest
+st2cst XRep = xresponse
+st2cst Up = upstream
+st2cst Down = downstream
+
+fl2cfl :: Flag -> CFlag
+fl2cfl NoBlock = noBlock
+fl2cfl NoFlush = noFlush
+
+combine :: [Flag] -> CInt
+combine = fromIntegral . foldr ((.|.) . flagVal . fl2cfl) 0
+
+withStablePtrOf :: a -> (StablePtr a -> IO b) -> IO b
+withStablePtrOf x f = bracket (newStablePtr x) freeStablePtr f
+
+fromStablePtr :: StablePtr a -> Ptr b
+fromStablePtr = castPtr . castStablePtrToPtr
185 src/System/ZMQ/Base.hsc
@@ -0,0 +1,185 @@
+{-# LANGUAGE CPP, ForeignFunctionInterface #-}
+-- |
+-- Module : System.ZMQ.Base
+-- Copyright : (c) 2010 Toralf Wittner
+-- License : LGPL
+-- Maintainer : toralf.wittner@gmail.com
+-- Stability : experimental
+-- Portability : non-portable
+--
+
+module System.ZMQ.Base where
+
+import Control.Applicative
+import Foreign
+import Foreign.C.Types
+import Foreign.C.String
+
+#include <zmq.h>
+
+data Message a = Message { content :: Ptr a }
+
+instance Storable (Message a) where
+ alignment _ = #{alignment zmq_msg_t}
+ sizeOf _ = #{size zmq_msg_t}
+ peek p = Message <$> #{peek zmq_msg_t, content} p
+ poke p (Message c) = #{poke zmq_msg_t, content} p c
+
+data Poll = Poll
+ { pSocket :: ZMQSocket
+ , pFd :: CInt
+ , pEvents :: CShort
+ , pRevents :: CShort
+ }
+
+instance Storable Poll 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 $ Poll s f e re
+ poke p (Poll 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 a = Ptr (Message a)
+type ZMQFun = FunPtr (Ptr () -> Ptr () -> IO ())
+type ZMQCtx = Ptr ()
+type ZMQSocket = Ptr ()
+type ZMQPollPtr = Ptr Poll
+type ZMQStopWatch = Ptr ()
+
+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
+
+newtype CSocketType = CSocketType { typeVal :: CInt } deriving (Eq, Ord)
+
+#{enum CSocketType, CSocketType,
+ p2p = ZMQ_P2P,
+ pub = ZMQ_PUB,
+ sub = ZMQ_SUB,
+ request = ZMQ_REQ,
+ response = ZMQ_REP,
+ xrequest = ZMQ_XREQ,
+ xresponse = ZMQ_XREP,
+ upstream = ZMQ_UPSTREAM,
+ downstream = ZMQ_DOWNSTREAM
+}
+
+newtype OptionType = OptionType { optVal :: CInt } deriving (Eq, Ord)
+
+#{enum OptionType, OptionType,
+ highWM = ZMQ_HWM,
+ lowWM = ZMQ_LWM,
+ swap = ZMQ_SWAP,
+ affinity = ZMQ_AFFINITY,
+ identity = ZMQ_IDENTITY,
+ subscribe = ZMQ_SUBSCRIBE,
+ unsubscribe = ZMQ_UNSUBSCRIBE,
+ rate = ZMQ_RATE,
+ recoveryIVL = ZMQ_RECOVERY_IVL,
+ mcastLoop = ZMQ_MCAST_LOOP,
+ sendBuf = ZMQ_SNDBUF,
+ receiveBuf = ZMQ_RCVBUF
+}
+
+newtype CFlag = CFlag { flagVal :: CInt } deriving (Eq, Ord)
+
+#{enum CFlag, CFlag,
+ noBlock = ZMQ_NOBLOCK,
+ noFlush = ZMQ_NOFLUSH
+}
+
+-- general initialization
+
+foreign import ccall unsafe "zmq.h zmq_init"
+ c_zmq_init :: CInt -> CInt -> CInt -> IO ZMQCtx
+
+foreign import ccall unsafe "zmq.h zmq_term"
+ c_zmq_term :: ZMQCtx -> IO CInt
+
+-- zmq_msg_t related
+
+foreign import ccall unsafe "zmq.h zmq_msg_init"
+ c_zmq_msg_init :: ZMQMsgPtr a -> IO CInt
+
+foreign import ccall unsafe "zmq.h zmq_msg_init_size"
+ c_zmq_msg_init_size :: ZMQMsgPtr a -> CSize -> IO CInt
+
+foreign import ccall unsafe "zmq.h zmq_msg_init_data"
+ c_zmq_msg_init_data :: ZMQMsgPtr a
+ -> Ptr () -- ^ msg
+ -> CSize -- ^ size
+ -> ZMQFun -- ^ free function
+ -> Ptr () -- ^ hint
+ -> IO CInt
+
+foreign import ccall unsafe "zmq.h zmq_msg_close"
+ c_zmq_msg_close :: ZMQMsgPtr a -> IO CInt
+
+foreign import ccall unsafe "zmq.h zmq_msg_move"
+ c_zmq_msg_move :: ZMQMsgPtr a -> ZMQMsgPtr a -> IO CInt
+
+foreign import ccall unsafe "zmq.h zmq_msg_copy"
+ c_zmq_msg_copy :: ZMQMsgPtr a -> ZMQMsgPtr a -> IO CInt
+
+foreign import ccall unsafe "zmq.h zmq_msg_data"
+ c_zmq_msg_data :: ZMQMsgPtr a -> IO (Ptr a)
+
+foreign import ccall unsafe "zmq.h zmq_msg_size"
+ c_zmq_msg_size :: ZMQMsgPtr a -> 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_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 a -> CInt -> IO CInt
+
+foreign import ccall unsafe "zmq.h zmq_flush"
+ c_zmq_flush :: ZMQSocket -> IO CInt
+
+foreign import ccall unsafe "zmq.h zmq_recv"
+ c_zmq_recv :: ZMQSocket -> ZMQMsgPtr a -> CInt -> IO CInt
+
+-- poll
+
+foreign import ccall unsafe "zmq.h zmq_poll"
+ c_zmq_poll :: ZMQPollPtr -> CInt -> CLong -> IO CInt
+
+
+-- utility
+
+foreign import ccall unsafe "zmq.h zmq_strerror"
+ c_zmq_strerror :: CInt -> IO CString
+
+foreign import ccall unsafe "zmq.h zmq_stopwatch_start"
+ c_zmq_stopwatch_start :: IO ZMQStopWatch
+
+foreign import ccall unsafe "zmq.h zmq_stopwatch_stop"
+ c_zmq_stopwatch_stop :: ZMQStopWatch -> IO CULong
+
+foreign import ccall unsafe "zmq.h zmq_sleep"
+ c_zmq_sleep :: CInt -> IO ()
+
30 zeromq-haskell.cabal
@@ -0,0 +1,30 @@
+name: zeromq-haskell
+version: 0.1
+synopsis: bindings to zeromq
+description: Bindings to zeromq (http://zeromq.org)
+category: System
+license: LGPL
+license-file: LICENSE
+author: Toralf Wittner
+maintainer: toralf.wittner@gmail.com
+copyright: Copyright (c) 2010 Toralf Wittner
+homepage: http://github.com/twittner/zeromq-haskell/
+stability: experimental
+tested-With: GHC == 6.12.1
+cabal-version: >= 1.6.0
+build-type: Simple
+extra-source-files: README
+
+library
+ exposed-modules: System.ZMQ.Base, System.ZMQ
+ ghc-options: -Wall -O2
+ extensions: CPP,
+ ForeignFunctionInterface,
+ TypeSynonymInstances
+ build-depends: base >= 3 && < 5,
+ unix,
+ containers,
+ binary,
+ bytestring
+ hs-source-dirs: src
+

0 comments on commit a62abe5

Please sign in to comment.