diff options
author | Sergei Trofimovich <slyfox@gentoo.org> | 2018-06-04 10:43:22 +0000 |
---|---|---|
committer | jao <jao@gnu.org> | 2018-07-12 00:46:22 +0100 |
commit | d3d3cf639e736244c12191c8c35ceb465c0b9103 (patch) | |
tree | f1b6c0072ba43ccb694d7ace37b6eecf2cc6ea1b /src/IPC/DBus.hs | |
parent | 6177f6f017d635e3acbac09dc061f4dcaf3320cc (diff) | |
download | xmobar-d3d3cf639e736244c12191c8c35ceb465c0b9103.tar.gz xmobar-d3d3cf639e736244c12191c8c35ceb465c0b9103.tar.bz2 |
port to dbus-1
Signed-off-by: Sergei Trofimovich <slyfox@gentoo.org>
Diffstat (limited to 'src/IPC/DBus.hs')
-rw-r--r-- | src/IPC/DBus.hs | 17 |
1 files changed, 11 insertions, 6 deletions
diff --git a/src/IPC/DBus.hs b/src/IPC/DBus.hs index 3f2d6f2..b9bffd5 100644 --- a/src/IPC/DBus.hs +++ b/src/IPC/DBus.hs @@ -15,11 +15,13 @@ module IPC.DBus (runIPC) where import DBus -import DBus.Client +import DBus.Client hiding (interfaceName) +import qualified DBus.Client as DC import Control.Monad (when) import Control.Concurrent.STM import Control.Exception (handle) import System.IO (stderr, hPutStrLn) +import Control.Monad.IO.Class (liftIO) import Signal @@ -40,10 +42,13 @@ runIPC mvst = handle printException exportConnection exportConnection = do client <- connectSession requestName client busName [ nameDoNotQueue ] - export client objectPath [ sendSignalMethod mvst ] + export client objectPath defaultInterface + { DC.interfaceName = interfaceName + , DC.interfaceMethods = [ sendSignalMethod mvst ] + } sendSignalMethod :: TMVar SignalType -> Method -sendSignalMethod mvst = method interfaceName sendSignalName +sendSignalMethod mvst = makeMethod sendSignalName (signature_ [variantType $ toVariant (undefined :: SignalType)]) (signature_ []) sendSignalMethodCall @@ -51,11 +56,11 @@ sendSignalMethod mvst = method interfaceName sendSignalName sendSignalName :: MemberName sendSignalName = memberName_ "SendSignal" - sendSignalMethodCall :: MethodCall -> IO Reply - sendSignalMethodCall mc = do + sendSignalMethodCall :: MethodCall -> DBusR Reply + sendSignalMethodCall mc = liftIO $ do when ( methodCallMember mc == sendSignalName ) $ mapM_ (sendSignal . fromVariant) (methodCallBody mc) - return ( replyReturn [] ) + return ( ReplyReturn [] ) sendSignal :: Maybe SignalType -> IO () sendSignal = maybe (return ()) (atomically . putTMVar mvst) |