c-mosquitto (empty) → 0.1.0.0
raw patch · 11 files changed
+688/−0 lines, 11 filesdep +basedep +bytestringdep +c-mosquittosetup-changed
Dependencies added: base, bytestring, c-mosquitto, containers, inline-c, options, primitive
Files
- LICENSE +30/−0
- README.md +1/−0
- Setup.hs +2/−0
- app/Main.hs +60/−0
- c-mosquitto.cabal +56/−0
- src/Language/C/Inline/TypeLevel.hs +66/−0
- src/Network/Mosquitto.c +181/−0
- src/Network/Mosquitto.hs +207/−0
- src/Network/Mosquitto/Internal/Inline.hs +12/−0
- src/Network/Mosquitto/Internal/Types.hs +71/−0
- test/Spec.hs +2/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Marcin Tolysz (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Marcin Tolysz nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,1 @@+# c-mosquitto
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}+module Main where++import qualified Network.Mosquitto as M+import Network.Mosquitto.Internal.Types+import Control.Concurrent+import Control.Monad++import Control.Applicative+import Options++data MainOptions = MainOptions+ { caCert :: String+ , userCert :: String+ , userKey :: String+ , server :: String+ , port :: Int+ , keepAlive :: Int+ }++instance Options MainOptions where+ defineOptions = pure MainOptions+ <*> simpleOption "ca" "rootCA.pem"+ "server's CA"+ <*> simpleOption "cert" "cert.pem"+ "client cert"+ <*> simpleOption "key" "cert.key"+ "client key"+ <*> simpleOption "server" "localhost"+ "client key"+ <*> simpleOption "port" 8883+ "server's port"+ <*> simpleOption "keep-alive" 1200+ "server's port"++main :: IO ()+main = runCommand $ \MainOptions{..} args -> M.withMosquittoLibrary $ do+ print M.version++ m <- M.newMosquitto True "server" (Just ())+ M.setTls m caCert userCert userKey+ M.setTlsInsecure m True++ M.onMessage m print+ M.onLog m $ const putStrLn+ M.onConnect m print+ M.onDisconnect m print+ M.onSubscribe m $ curry print++ M.connect m server port keepAlive++ M.subscribe m 0 "rcv/#"++ forkIO $ forever $ do+ M.publish m False 0 "hello" "bla"+ threadDelay 5000000++ M.loopForever m+ M.destroyMosquitto m+ print "The end"
+ c-mosquitto.cabal view
@@ -0,0 +1,56 @@+name: c-mosquitto+version: 0.1.0.0+synopsis: Simpe mosquito MQTT binding able to work with the Amazons IoT+-- description:+homepage: https://github.com/tolysz/c-mosquitto#readme+license: BSD3+license-file: LICENSE+author: Marcin Tolysz+maintainer: tolysz@gmail.com+copyright: 2017(c) Marcin Tolysz+category: Library+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules:+ Network.Mosquitto+ Network.Mosquitto.Internal.Types+ Network.Mosquitto.Internal.Inline+ Language.C.Inline.TypeLevel++ build-depends: base >= 4.7 && < 5+ , inline-c+ , primitive+ , containers+ , bytestring+ default-language: Haskell2010++ cc-options: -Wall -O2+ c-sources: src/Network/Mosquitto.c+ extra-libraries: mosquitto++executable c-mosquitto+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends: base+ , c-mosquitto+ , options+ default-language: Haskell2010++test-suite c-mosquitto-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , c-mosquitto++ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/tolysz/c-mosquitto
+ src/Language/C/Inline/TypeLevel.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE TypeFamilies #-}++module Language.C.Inline.TypeLevel where++import Foreign.C.Types+import Foreign.Ptr ( Ptr, nullPtr )+import Data.Int ( Int32 )+import GHC.TypeLits++import Control.Monad.Primitive ( PrimMonad, PrimState )++-- | Wrapper for mutable values+newtype Mut a s = Mut { unMut :: a }++type family Mutable (a :: *) :: * -> *++class FreezeThaw a where+ freeze :: (PrimMonad m) => Mutable a (PrimState m) -> m a+ thaw :: (PrimMonad m) => a -> m (Mutable a (PrimState m))++ unsafeFreeze :: (PrimMonad m) => Mutable a (PrimState m) -> m a+ unsafeThaw :: (PrimMonad m) => a -> m (Mutable a (PrimState m))++type family C (a :: *) :: *++type instance C (Maybe a) = C a+type instance C (Mut a s) = C a++-- | Perform an IO action with a pointer to the C equivalent of a value+class WithPtr a where+ -- | Perform an action with a temporary pointer to the underlying+ -- representation of @a@+ --+ -- The pointer is not guaranteed to be usuable outside the scope of this+ -- function. The same warnings apply as for 'withForeignPtr'.+ withPtr :: a -> (Ptr (C a) -> IO b) -> IO b++-- | 'Nothing' is represented as a 'nullPtr'.+instance (WithPtr a) => WithPtr (Maybe a) where+ withPtr Nothing f = f nullPtr+ withPtr (Just obj) f = withPtr obj f++-- instance WithPtr () where+-- withPtr ptr f = f ptr++-- | Mutable types use the same underlying representation as unmutable types.+instance (WithPtr a) => WithPtr (Mut a s) where+ withPtr = withPtr . unMut++-- | Information about the storage requirements of values in C+--+-- This class assumes that the type @a@ is merely a symbol that corresponds with+-- a type in C.+class CSizeOf a where+ -- | Computes the storage requirements (in bytes) of values of+ -- type @a@ in C.+ cSizeOf :: proxy a -> Int++--------------------------------------------------------------------------------++-- | Types of which a value can be constructed from a pointer to the C+-- equivalent of that value+--+-- Used to wrap values created in C.+class FromPtr a where+ fromPtr :: IO (Ptr (C a)) -> IO a
+ src/Network/Mosquitto.c view
@@ -0,0 +1,181 @@++#include <stdio.h>++#include <mosquitto.h>++int inline_c_Network_Mosquitto_0_af973a022b4e1bdc5e364f24abf1f96042f22074(struct mosquitto_message * ptr_inline_c_0) {+return ( ptr_inline_c_0->mid);+}+++char * inline_c_Network_Mosquitto_1_1ffdbc152633d765d9af8dc1a99fc84de7cdc43d(struct mosquitto_message * ptr_inline_c_0) {+return (ptr_inline_c_0 -> topic );+}+++char * inline_c_Network_Mosquitto_2_2a9eed77120139b9bb64a7f6606b06cf995c53d0(struct mosquitto_message * ptr_inline_c_0) {+return (ptr_inline_c_0 -> payload );+}+++int inline_c_Network_Mosquitto_3_a343e4f7dc55e7308355464e738a9402fb43c490(struct mosquitto_message * ptr_inline_c_0) {+return (ptr_inline_c_0 -> payloadlen );+}+++int inline_c_Network_Mosquitto_4_f085573633eba51cb044b22361e904fc48b4a9f3(struct mosquitto_message * ptr_inline_c_0) {+return ( ptr_inline_c_0->qos);+}+++bool inline_c_Network_Mosquitto_5_ceaf89a39d1e88cb7f623dfa0d464582f936ed4f(struct mosquitto_message * ptr_inline_c_0) {+return ( ptr_inline_c_0->retain);+}+++int inline_c_Network_Mosquitto_6_d5c23f7055ae67c09ff206dd6a9cc4f020e85c61() {+return ( mosquitto_lib_init() );+}+++int inline_c_Network_Mosquitto_7_f62c1e89d0a67f1afbdb4eb34ac4bfb9ad34dd96() {+return ( mosquitto_lib_cleanup() );+}+++void inline_c_Network_Mosquitto_8_7dea8f89bfffce831052393584adc3a08aa14253(int * a_inline_c_0, int * b_inline_c_1, int * c_inline_c_2) {+ mosquitto_lib_version(a_inline_c_0,b_inline_c_1,c_inline_c_2); +}+++struct mosquitto * inline_c_Network_Mosquitto_9_f6927ebaedf8d0928ab12c9fbae686d2dd74e3c0(char * userId_inline_c_0, bool clearSession_inline_c_1) {+return (+ mosquitto_new( userId_inline_c_0+ , clearSession_inline_c_1+ , 0 // (void * ptrUserData)+ )+ );+}+++void inline_c_Network_Mosquitto_10_403fc80492c1877303448c739bc735b61f91b41d(struct mosquitto * ptr_inline_c_0) {++ mosquitto_destroy(ptr_inline_c_0)+ ;+}+++void inline_c_Network_Mosquitto_11_2e52b4e387ff964e8763e13931c04b69aff55430(struct mosquitto * pMosq_inline_c_0, char * caFile_inline_c_1, char * certFile_inline_c_2, char * keyFile_inline_c_3) {++ mosquitto_tls_set( pMosq_inline_c_0+ , caFile_inline_c_1+ , 0+ , certFile_inline_c_2+ , keyFile_inline_c_3+ , 0+ )+ ;+}+++void inline_c_Network_Mosquitto_12_a6d84b6d438cc1f4f26a03133618129025930e03(struct mosquitto * pMosq_inline_c_0, char * hostname_inline_c_1, int port_inline_c_2, int keepAlive_inline_c_3) {++ mosquitto_connect( pMosq_inline_c_0+ , hostname_inline_c_1+ , port_inline_c_2+ , keepAlive_inline_c_3+ )+ ;+}+++void inline_c_Network_Mosquitto_13_9b2300d6db40d43ebb6d72e3b5a020f27089aa9f(struct mosquitto * pMosq_inline_c_0, void (* on_subscribe_inline_c_1)(struct mosquitto *, void *, int , int , const int *)) {++ mosquitto_subscribe_callback_set+ ( pMosq_inline_c_0+ , on_subscribe_inline_c_1+ );+ +}+++void inline_c_Network_Mosquitto_14_c37f43d389a2b1e4a300492e3a711a4a76e04f57(struct mosquitto * pMosq_inline_c_0, void (* on_connect_inline_c_1)(struct mosquitto *, void *, int )) {++ mosquitto_connect_callback_set+ ( pMosq_inline_c_0+ , on_connect_inline_c_1+ );+ +}+++void inline_c_Network_Mosquitto_15_73f1686f2c07e9747998ec5d1a023376b6401ac8(struct mosquitto * pMosq_inline_c_0, void (* on_disconnect_inline_c_1)(struct mosquitto *, void *, int )) {++ mosquitto_disconnect_callback_set+ ( pMosq_inline_c_0+ , on_disconnect_inline_c_1+ );+ +}+++void inline_c_Network_Mosquitto_16_374d617a6dd1e6b1b85395b1c3a2043f8a86cd2b(struct mosquitto * pMosq_inline_c_0, void (* on_log_inline_c_1)(struct mosquitto *, void *, int , const char *)) {++ mosquitto_log_callback_set+ ( pMosq_inline_c_0+ , on_log_inline_c_1+ );+ +}+++void inline_c_Network_Mosquitto_17_2dd27966a8764a1bdd083baf0f4690e8e2ef1475(struct mosquitto * pMosq_inline_c_0, void (* on_message_inline_c_1)(struct mosquitto *, void *, const struct mosquitto_message *)) {++ mosquitto_message_callback_set+ ( pMosq_inline_c_0+ , on_message_inline_c_1+ );+ +}+++void inline_c_Network_Mosquitto_18_4b8c8d8774deee8ab1d79ed9d536914d1ca65d06(struct mosquitto * pMosq_inline_c_0) {++ mosquitto_loop_forever(pMosq_inline_c_0, -1, 1)+ ;+}+++void inline_c_Network_Mosquitto_19_969dca874ea20234f06362014c8097eab6c27f8f(struct mosquitto * pMosq_inline_c_0, bool isInsecure_inline_c_1) {++ mosquitto_tls_insecure_set(pMosq_inline_c_0, isInsecure_inline_c_1)+ ;+}+++void inline_c_Network_Mosquitto_20_61ffbebe13cb650a9058a8b715732b7a82987f92(struct mosquitto * pMosq_inline_c_0, char * topic_inline_c_1, long payload_inline_c_2, char * payload_inline_c_3, int qos_inline_c_4, bool retain_inline_c_5) {++ mosquitto_publish+ ( pMosq_inline_c_0+ , 0+ , topic_inline_c_1+ , payload_inline_c_2+ , payload_inline_c_3+ , qos_inline_c_4+ , retain_inline_c_5+ )+ ;+}+++void inline_c_Network_Mosquitto_21_491fe5e8a7e8888c30139bd3dcd275298b39e3a8(struct mosquitto * pMosq_inline_c_0, char * topic_inline_c_1, int qos_inline_c_2) {++ mosquitto_subscribe+ ( pMosq_inline_c_0+ , 0+ , topic_inline_c_1+ , qos_inline_c_2+ )+ ;+}+
+ src/Network/Mosquitto.hs view
@@ -0,0 +1,207 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Network.Mosquitto where++import Data.Coerce (coerce)+import Data.Monoid ((<>))+import Control.Monad+import Foreign.C.Types+import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, newForeignPtr_)+import Foreign.Ptr ( Ptr, nullPtr, castPtr, FunPtr)+import Foreign.Marshal.Alloc ( alloca )+import Foreign.C.String (peekCString, peekCStringLen)++import qualified Language.C.Inline as C+import qualified Language.C.Inline.Unsafe as CU++import Language.C.Inline.TypeLevel++import System.IO.Unsafe (unsafePerformIO)+import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as C8+import qualified Data.ByteString.Internal as BSI+import qualified Data.ByteString.Unsafe as BS++import Network.Mosquitto.Internal.Types+import Network.Mosquitto.Internal.Inline+import Foreign.Storable++C.context (C.baseCtx <> C.vecCtx <> C.funCtx <> mosquittoCtx)+C.include "<stdio.h>"+C.include "<mosquitto.h>"++c'MessageToMMessage :: Ptr C'Message -> IO Message+c'MessageToMMessage ptr =+ Message+ <$> (fromIntegral <$> [C.exp| int { $(struct mosquitto_message * ptr)->mid} |])+ <*> (peekCString =<< [C.exp| char * {$(struct mosquitto_message * ptr) -> topic } |])+ <*> (C8.packCStringLen =<< (,)+ <$> [C.exp| char * {$(struct mosquitto_message * ptr) -> payload } |]+ <*> fmap fromIntegral [C.exp| int {$(struct mosquitto_message * ptr) -> payloadlen } |])+ <*> (fromIntegral <$> [C.exp| int { $(struct mosquitto_message * ptr)->qos} |])+ <*> [C.exp| bool { $(struct mosquitto_message * ptr)->retain} |]++{-# NOINLINE init #-}+init = [C.exp| int{ mosquitto_lib_init() }|]++{-# NOINLINE cleanup #-}+cleanup = [C.exp| int{ mosquitto_lib_cleanup() }|]++withMosquittoLibrary :: IO a -> IO a+withMosquittoLibrary f = Network.Mosquitto.init *> f <* cleanup++{-# NOINLINE version #-}+version :: (Int, Int, Int)+version = unsafePerformIO $+ alloca $ \a -> alloca $ \b -> alloca $ \c -> do+ [C.block|void{ mosquitto_lib_version($(int *a),$(int *b),$(int *c)); }|]+ (,,) <$> peek' a+ <*> peek' b+ <*> peek' c+ where+ peek' x = fromIntegral <$> peek x++newMosquitto :: Bool -> String -> Maybe a -> IO (Mosquitto a)+newMosquitto clearSession (C8.pack -> userId) _userData = do+ fp <- newForeignPtr_ <$> [C.exp|struct mosquitto *{+ mosquitto_new( $bs-ptr:userId+ , $(bool clearSession)+ , 0 // (void * ptrUserData)+ )+ }|]+ Mosquitto <$> fp++destroyMosquitto :: Mosquitto a -> IO ()+destroyMosquitto ms = withPtr ms $ \ptr ->+ [C.exp|void{+ mosquitto_destroy($(struct mosquitto *ptr))+ }|]++setTls :: Mosquitto a -> String -> String -> String -> IO ()+setTls mosq (C8.pack -> caFile) (C8.pack -> certFile) (C8.pack -> keyFile) =+ withPtr mosq $ \pMosq ->+ [C.exp|void{+ mosquitto_tls_set( $(struct mosquitto *pMosq)+ , $bs-ptr:caFile+ , 0+ , $bs-ptr:certFile+ , $bs-ptr:keyFile+ , 0+ )+ }|]++connect :: Mosquitto a -> String -> Int -> Int -> IO ()+connect mosq (C8.pack -> hostname) (fromIntegral -> port) (fromIntegral -> keepAlive) =+ withPtr mosq $ \pMosq ->+ [C.exp|void{+ mosquitto_connect( $(struct mosquitto *pMosq)+ , $bs-ptr:hostname+ , $(int port)+ , $(int keepAlive)+ )+ }|]++onSubscribe :: Mosquitto a -> OnSubscribe -> IO ()+onSubscribe mosq onSubscribe = do+ on_subscribe <- mkCOnSubscribe $ \_ _ mid (fromIntegral -> ii) iis ->+ onSubscribe (fromIntegral mid) =<< mapM (fmap fromIntegral . peekElemOff iis) [0..ii-1]+ withPtr mosq $ \pMosq ->+ [C.block|void{+ mosquitto_subscribe_callback_set+ ( $(struct mosquitto *pMosq)+ , $(void (*on_subscribe)(struct mosquitto *,void *, int, int, const int *))+ );+ }|]+++onConnect :: Mosquitto a -> OnConnection -> IO ()+onConnect mosq onConnect = do+ on_connect <- mkCOnConnection $ \_ _ ii -> onConnect (fromIntegral ii)+ withPtr mosq $ \pMosq ->+ [C.block|void{+ mosquitto_connect_callback_set+ ( $(struct mosquitto *pMosq)+ , $(void (*on_connect)(struct mosquitto *,void *, int))+ );+ }|]++onDisconnect :: Mosquitto a -> OnConnection -> IO ()+onDisconnect mosq onDisconnect = do+ on_disconnect <- mkCOnConnection $ \_ _ ii -> onDisconnect (fromIntegral ii)+ withPtr mosq $ \pMosq ->+ [C.block|void{+ mosquitto_disconnect_callback_set+ ( $(struct mosquitto *pMosq)+ , $(void (*on_disconnect)(struct mosquitto *,void *, int))+ );+ }|]++onLog :: Mosquitto a -> OnLog -> IO ()+onLog mosq onLog = do+ on_log <- mkCOnLog $ \_ _ ii mm -> onLog (fromIntegral ii) =<< peekCString mm+ withPtr mosq $ \pMosq ->+ [C.block|void{+ mosquitto_log_callback_set+ ( $(struct mosquitto *pMosq)+ , $(void (*on_log)(struct mosquitto *,void *, int, const char *))+ );+ }|]++onMessage :: Mosquitto a -> OnMessage -> IO ()+onMessage mosq onMessage = do+ on_message <- mkCOnMessage $ \_ _ mm -> (onMessage =<< c'MessageToMMessage mm)+ withPtr mosq $ \pMosq ->+ [C.block|void{+ mosquitto_message_callback_set+ ( $(struct mosquitto *pMosq)+ , $(void (*on_message)(struct mosquitto *, void *, const struct mosquitto_message *))+ );+ }|]++loopForever :: Mosquitto a -> IO ()+loopForever mosq =+ withPtr mosq $ \pMosq ->+ [C.exp|void{+ mosquitto_loop_forever($(struct mosquitto *pMosq), -1, 1)+ }|]++setTlsInsecure :: Mosquitto a -> Bool -> IO ()+setTlsInsecure mosq isInsecure =+ withPtr mosq $ \pMosq ->+ [C.exp|void{+ mosquitto_tls_insecure_set($(struct mosquitto *pMosq), $(bool isInsecure))+ }|]++publish :: Mosquitto a -> Bool -> Int -> String -> S.ByteString -> IO ()+publish mosq retain (fromIntegral -> qos) (C8.pack -> topic) payload =+ withPtr mosq $ \pMosq ->+ [C.exp|void{+ mosquitto_publish+ ( $(struct mosquitto *pMosq)+ , 0+ , $bs-ptr:topic+ , $bs-len:payload+ , $bs-ptr:payload+ , $(int qos)+ , $(bool retain)+ )+ }|]++subscribe :: Mosquitto a -> Int -> String -> IO ()+subscribe mosq (fromIntegral -> qos) (C8.pack -> topic) =+ withPtr mosq $ \pMosq ->+ [C.exp|void{+ mosquitto_subscribe+ ( $(struct mosquitto *pMosq)+ , 0+ , $bs-ptr:topic+ , $(int qos)+ )+ }|]
+ src/Network/Mosquitto/Internal/Inline.hs view
@@ -0,0 +1,12 @@++module Network.Mosquitto.Internal.Inline where++import qualified Language.C.Inline.Context as C+import Data.Monoid ( (<>) )++import Network.Mosquitto.Internal.Types++mosquittoCtx :: C.Context+mosquittoCtx = C.bsCtx <> C.vecCtx <> ctx+ where+ ctx = mempty { C.ctxTypesTable = mosquittoTypesTable }
+ src/Network/Mosquitto/Internal/Types.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}++module Network.Mosquitto.Internal.Types where++import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)+import Foreign.Ptr (Ptr, FunPtr)+import Foreign.C.Types+import Language.C.Inline.TypeLevel+import qualified Language.C.Types as C+import qualified Language.C.Inline.Context as C+import Data.ByteString (ByteString)++import qualified Data.Map as M+import Foreign.Storable++-- haskell types+newtype Mosquitto a = Mosquitto { unMosquitto :: ForeignPtr (C (Mosquitto a))}+-- newtype Message = Message { unMessage :: Ptr (C Message)}+newtype RawMessage = RawMessage { unRawMessage :: Ptr (C RawMessage)}++data Message = Message+ { mid :: Int+ , topic :: String+ , payload :: ByteString+ , qos :: Int+ , retain :: Bool+ } deriving (Eq, Show, Read)+++data C'Mosquitto+data C'Message++-- glue+type instance C (Mosquitto a) = C'Mosquitto+type instance C RawMessage = C'Message++instance WithPtr (Mosquitto a) where+ withPtr = withForeignPtr . unMosquitto+instance WithPtr RawMessage where+ withPtr m f = f (unRawMessage m)+++mosquittoTypesTable :: C.TypesTable+mosquittoTypesTable = M.fromList+ [ ( C.Struct "mosquitto" , [t| C'Mosquitto |] )+ , ( C.Struct "mosquitto_message" , [t| C'Message |] )+ , ( C.TypeName "bool" , [t| Bool |] )+ ]++type OnMessage = Message -> IO ()+type COnMessage = Ptr C'Mosquitto -> Ptr () -> Ptr C'Message -> IO ()+foreign import ccall "wrapper"+ mkCOnMessage :: COnMessage -> IO (FunPtr COnMessage)++type OnLog = Int -> String -> IO ()+type COnLog = Ptr C'Mosquitto -> Ptr () -> CInt -> Ptr CChar -> IO ()+foreign import ccall "wrapper"+ mkCOnLog :: COnLog -> IO (FunPtr COnLog)++type OnConnection = Int -> IO ()+type COnConnection = Ptr C'Mosquitto -> Ptr () -> CInt -> IO ()+foreign import ccall "wrapper"+ mkCOnConnection :: COnConnection -> IO (FunPtr COnConnection)++type OnSubscribe = Int -> [Int] -> IO ()+type COnSubscribe = Ptr C'Mosquitto -> Ptr () -> CInt -> CInt -> Ptr CInt -> IO ()+foreign import ccall "wrapper"+ mkCOnSubscribe :: COnSubscribe -> IO (FunPtr COnSubscribe)
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"