summaryrefslogtreecommitdiffhomepage
path: root/src/IPC/DBus.hs
diff options
context:
space:
mode:
authorJochen Keil <jochen.keil@gmail.com>2012-08-22 20:25:29 +0200
committerJochen Keil <jochen.keil@gmail.com>2012-08-22 20:25:29 +0200
commit68f9f51cd7e20190e1ef2fd95beaf7c852f11c81 (patch)
tree666f67f41cde4a7ab9a3ea5d59a9ad22854e45a3 /src/IPC/DBus.hs
parentd52278f48d98f116d3a1ebd21000bf80d90b8c9d (diff)
downloadxmobar-68f9f51cd7e20190e1ef2fd95beaf7c852f11c81.tar.gz
xmobar-68f9f51cd7e20190e1ef2fd95beaf7c852f11c81.tar.bz2
Refactor MVar SignalType to TMVar SignalType
Replace MVar with TMVar from the STM package. This is common for ghc now. Since STM is used everywhere else in the src it also adds no additional dependencies. The main reason for this switch is, that readMVar, swapMVar, etc. are only atomically if there is no other producer for this MVar i.e. putMVar. For example readMVar is a combination of putMVar and takeMVar. Due to scheduling and readMVar's non-atomicity it is possible that values written to the MVar appear in the wrong order. Using TMVar fixes this problem, since it allows really atomical read/swap operations.
Diffstat (limited to 'src/IPC/DBus.hs')
-rw-r--r--src/IPC/DBus.hs8
1 files changed, 4 insertions, 4 deletions
diff --git a/src/IPC/DBus.hs b/src/IPC/DBus.hs
index d755220..60544a9 100644
--- a/src/IPC/DBus.hs
+++ b/src/IPC/DBus.hs
@@ -19,7 +19,7 @@ import Prelude hiding (catch)
import DBus
import DBus.Client
import Control.Monad (when)
-import Control.Concurrent
+import Control.Concurrent.STM
import Control.Exception (catch)
import System.IO (stderr, hPutStrLn)
@@ -34,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 ()
@@ -44,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_ [])
@@ -60,4 +60,4 @@ sendSignalMethod mvst = method interfaceName sendSignalName
return ( replyReturn [] )
sendSignal :: Maybe SignalType -> IO ()
- sendSignal = maybe (return ()) (putMVar mvst)
+ sendSignal = maybe (return ()) (atomically . putTMVar mvst)