diff options
Diffstat (limited to 'src/IPC/DBus.hs')
| -rw-r--r-- | src/IPC/DBus.hs | 15 |
1 files changed, 7 insertions, 8 deletions
diff --git a/src/IPC/DBus.hs b/src/IPC/DBus.hs index 469a7c6..60544a9 100644 --- a/src/IPC/DBus.hs +++ b/src/IPC/DBus.hs @@ -18,13 +18,12 @@ import Prelude hiding (catch) import DBus import DBus.Client -import Control.Monad (join, when) -import Control.Concurrent +import Control.Monad (when) +import Control.Concurrent.STM import Control.Exception (catch) import System.IO (stderr, hPutStrLn) import Signal -import Plugins.Utils (safeHead) busName :: BusName busName = busName_ "org.Xmobar.Control" @@ -35,7 +34,7 @@ objectPath = objectPath_ "/org/Xmobar/Control" interfaceName :: InterfaceName interfaceName = interfaceName_ "org.Xmobar.Control" -runIPC :: MVar SignalType -> IO () +runIPC :: TMVar SignalType -> IO () runIPC mvst = catch exportConnection printException where printException :: ClientError -> IO () @@ -45,7 +44,7 @@ runIPC mvst = catch exportConnection printException requestName client busName [ nameDoNotQueue ] export client objectPath [ sendSignalMethod mvst ] -sendSignalMethod :: MVar SignalType -> Method +sendSignalMethod :: TMVar SignalType -> Method sendSignalMethod mvst = method interfaceName sendSignalName (signature_ [variantType $ toVariant $ (undefined :: SignalType)]) (signature_ []) @@ -56,9 +55,9 @@ sendSignalMethod mvst = method interfaceName sendSignalName sendSignalMethodCall :: MethodCall -> IO Reply sendSignalMethodCall mc = do - when ( methodCallMember mc == sendSignalName ) $ sendSignal $ - join $ safeHead $ map fromVariant $ methodCallBody mc + when ( methodCallMember mc == sendSignalName ) + $ mapM_ (sendSignal . fromVariant) (methodCallBody mc) return ( replyReturn [] ) sendSignal :: Maybe SignalType -> IO () - sendSignal = maybe (return ()) (putMVar mvst) + sendSignal = maybe (return ()) (atomically . putTMVar mvst) |