udbus 0.2.0 → 0.2.1

raw patch · 2 files changed

+49/−2 lines, 2 files

Files

• Network/DBus.hs +48/−1
• udbus.cabal +1/−1

@@ -12,6 +12,7 @@     -- * handle connections to DBus       establish     , establishWithCatchall+    , disconnect     , DBusConnection     -- * Types     , DBusMessageable(..)@@ -49,6 +50,10 @@     , unregisterCall     , registerSignal     , unregisterSignal+    -- * Types to interact with the dispatcher+    , Signalback+    , Callback+    , DispatchTable     -- * create a new context on system or session bus     , busGetSystem     , busGetSession@@ -62,7 +67,7 @@ import Network.DBus.Message import Network.DBus.MessageType import Network.DBus.StdMessage-import Control.Concurrent (forkIO, ThreadId)+import Control.Concurrent (forkIO, killThread, ThreadId) import Control.Concurrent.MVar import Control.Exception import Data.Maybe@@ -126,6 +131,22 @@     _   <- auth ctx     runMainLoopCatchall catchall ctx +-- | Close dbus socket and stop mainloop thread.+disconnect :: DBusConnection -> IO ()+disconnect conn = do+    mtid <- tryTakeMVar (connectionMainLoop conn)+    when (isJust mtid) $ do+        killThread (fromJust mtid)+        busClose (connectionContext conn)+        _ <- swapMVar (connectionPaths conn) M.empty+        _ <- swapMVar (connectionSignals conn) M.empty+        callbacks <- swapMVar (connectionCallbacks conn) M.empty+        forM_ (M.toList callbacks) $ \(_, mvar) ->+            putMVar mvar $ toDBusMessage $+              DBusError 0 (ErrorName "org.freedesktop.dbus.disconnected") []++-- | call a method on the DBus, and wait synchronously+-- for the return value. call :: DBusConnection -> BusName -> DBusCall -> IO DBusReturn call con destination c = do     let msg = messageMapFields (fieldsSetDestination destination) $ toDBusMessage c@@ -151,6 +172,8 @@         errorFromDBusMessage :: DBusMessage -> Maybe DBusError         errorFromDBusMessage = fromDBusMessage +-- | Add a match rules which will cause to receive message that aren't directed+-- to this connection but match this rule. addMatch :: DBusConnection -> DBusMatchRules -> IO () addMatch con mr = call con dbusDestination (msgDBusAddMatch serialized) >> return ()     where@@ -165,6 +188,12 @@         mm key f = maybe "" (surroundQuote key . f)         surroundQuote key v = concat [ key, "='",  v, "'" ] +-- | Send an arbitrary DBusMessageable message on the bus, using+-- a new serial value. the serial value allocated is returned to+-- the caller.+--+-- PS: completely misnamed.+reply :: DBusMessageable a => DBusConnection -> a -> IO Serial reply con rep = do     let msg = toDBusMessage rep     sendLock con $ messageSend (connectionContext con) msg@@ -179,7 +208,12 @@ unregisterPath_ f con path =     modifyMVar_ (f con) (return . M.delete path) +-- | Register a method handler table for a specific object path+registerCall :: DBusConnection -> ObjectPath -> DispatchTable Callback -> IO () registerCall = registerPath_ connectionPaths++-- | Unregister all method handlers for a specific object path+unregisterCall :: DBusConnection -> ObjectPath -> IO () unregisterCall = unregisterPath_ connectionPaths  {-# DEPRECATED registerPath "use registerCall" #-}@@ -187,11 +221,21 @@ {-# DEPRECATED unregisterPath "use unregisterCall" #-} unregisterPath = unregisterPath_ connectionPaths +-- | Register a signal handler table for a specific object path+registerSignal :: DBusConnection -> ObjectPath -> DispatchTable Signalback -> IO () registerSignal = registerPath_ connectionSignals++-- | Unregister all signals handler for a specific object path+unregisterSignal :: DBusConnection -> ObjectPath -> IO () unregisterSignal = unregisterPath_ connectionSignals +-- | run a main DBus loop which will create a new dispatcher+-- handshake on the bus and wait for message to dispatch runMainLoop = runMainLoopCatchall (\_ -> return ()) +-- | similar to 'runMainLoop' but also give the ability to specify+-- a catch-all-message callback for any message that are not handled+-- by specific function. runMainLoopCatchall catchAll context = do     callbacks   <- newMVar M.empty     callPaths   <- newMVar M.empty@@ -214,6 +258,9 @@     _ <- call con dbusDestination msgDBusHello     return con +-- | A dispatcher is forever waiting for new+-- message on the dbus and dispatch them according+-- to the tables. dispatcher con = forever loop where     loop = do         msg      <- messageRecv (connectionContext con)

@@ -1,5 +1,5 @@ Name:                udbus-Version:             0.2.0+Version:             0.2.1 Description:         Small and flexible implementation of the dbus protocol. License:             BSD3 License-file:        LICENSE