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.

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)