diff options
| author | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2012-08-22 22:37:33 +0200 |
|---|---|---|
| committer | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2012-08-22 22:37:33 +0200 |
| commit | 8e87d8671c06eb5acca3a4c92e569e1dba253160 (patch) | |
| tree | 30a68352ed847b7d19c7951b0c8c76187838753f /src/IPC/DBus.hs | |
| parent | 2596e2a21d23979ca1bebd87698b00e195d5b5d9 (diff) | |
| parent | 68f9f51cd7e20190e1ef2fd95beaf7c852f11c81 (diff) | |
| download | xmobar-8e87d8671c06eb5acca3a4c92e569e1dba253160.tar.gz xmobar-8e87d8671c06eb5acca3a4c92e569e1dba253160.tar.bz2 | |
Merge remote-tracking branch 'jrk/replacemvar' into jrk
Conflicts:
readme.md
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) |