summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar.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/Xmobar.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/Xmobar.hs')
-rw-r--r--src/Xmobar.hs21
1 files changed, 11 insertions, 10 deletions
diff --git a/src/Xmobar.hs b/src/Xmobar.hs
index 2dbba11..79234d2 100644
--- a/src/Xmobar.hs
+++ b/src/Xmobar.hs
@@ -75,7 +75,7 @@ runX :: XConf -> X () -> IO ()
runX xc f = runReaderT f xc
-- | Starts the main event loop and threads
-startLoop :: XConf -> MVar SignalType -> [[(Maybe ThreadId, TVar String)]] -> IO ()
+startLoop :: XConf -> TMVar SignalType -> [[(Maybe ThreadId, TVar String)]] -> IO ()
startLoop xcfg@(XConf _ _ w _ _) sig vs = do
tv <- atomically $ newTVar []
_ <- forkIO (checker tv [] vs sig `catch`
@@ -107,16 +107,16 @@ startLoop xcfg@(XConf _ _ w _ _) sig vs = do
#endif
ev <- getEvent e
case ev of
- ConfigureEvent {} -> putMVar signal Reposition
- ExposeEvent {} -> putMVar signal Wakeup
- RRScreenChangeNotifyEvent {} -> putMVar signal Reposition
+ ConfigureEvent {} -> atomically $ putTMVar signal Reposition
+ ExposeEvent {} -> atomically $ putTMVar signal Wakeup
+ RRScreenChangeNotifyEvent {} -> atomically $ putTMVar signal Reposition
_ -> return ()
-- | Send signal to eventLoop every time a var is updated
checker :: TVar [String]
-> [String]
-> [[(Maybe ThreadId, TVar String)]]
- -> MVar SignalType
+ -> TMVar SignalType
-> IO ()
checker tvar ov vs signal = do
nval <- atomically $ do
@@ -124,16 +124,16 @@ checker tvar ov vs signal = do
guard (nv /= ov)
writeTVar tvar nv
return nv
- putMVar signal Wakeup
+ atomically $ putTMVar signal Wakeup
checker tvar nval vs signal
where
concatV = fmap concat . mapM (readTVar . snd)
-- | Continuously wait for a signal from a thread or a interrupt handler
-eventLoop :: TVar [String] -> XConf -> MVar SignalType -> IO ()
+eventLoop :: TVar [String] -> XConf -> TMVar SignalType -> IO ()
eventLoop tv xc@(XConf d _ w fs cfg) signal = do
- typ <- takeMVar signal
+ typ <- atomically $ takeTMVar signal
case typ of
Wakeup -> do
runX xc (updateWin tv)
@@ -186,7 +186,7 @@ eventLoop tv xc@(XConf d _ w fs cfg) signal = do
-- | Runs a command as an independent thread and returns its thread id
-- and the TVar the command will be writing to.
-startCommand :: MVar SignalType
+startCommand :: TMVar SignalType
-> (Runnable,String,String)
-> IO (Maybe ThreadId, TVar String)
startCommand sig (com,s,ss)
@@ -196,7 +196,8 @@ startCommand sig (com,s,ss)
| otherwise = do var <- atomically $ newTVar is
let cb str = atomically $ writeTVar var (s ++ str ++ ss)
h <- forkIO $ start com cb
- _ <- forkIO $ trigger com ( maybe (return ()) (putMVar sig) )
+ _ <- forkIO $ trigger com
+ $ maybe (return ()) (atomically . putTMVar sig)
return (Just h,var)
where is = s ++ "Updating..." ++ ss