summaryrefslogtreecommitdiffhomepage
path: root/src/IPC/DBus.hs
diff options
context:
space:
mode:
authorSergei Trofimovich <slyfox@gentoo.org>2018-06-04 10:43:22 +0000
committerjao <jao@gnu.org>2018-07-12 00:46:22 +0100
commitd3d3cf639e736244c12191c8c35ceb465c0b9103 (patch)
treef1b6c0072ba43ccb694d7ace37b6eecf2cc6ea1b /src/IPC/DBus.hs
parent6177f6f017d635e3acbac09dc061f4dcaf3320cc (diff)
downloadxmobar-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.hs17
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)