Implement timer coalescing (noticeably less CPU/power usage)

xmobar currently runs every monitor in its own thread. Monitors that do
periodic updates simply sleep and loop. This unfortunately leads to
these threads coming out of sync, and xmobar ends up waking up and
redrawing for every periodic monitor. In my case, that is 7 times per
second, which is enough for xmobar to be at the top of "top" with more
than 1% CPU usage, and to have a noticeable impact on battery life.

This commit adds a central timer coordination thread which makes sure
that periodic updates happen together and that we only redraw once
they're all done.

Together with PR #409, I managed to lower the idle power draw of my
laptop from 4W to 3W.

1 files changed, 34 insertions, 9 deletions

diff --git a/src/Xmobar/App/EventLoop.hs b/src/Xmobar/App/EventLoop.hs
index 3fab3e5..f6ab932 100644
--- a/src/Xmobar/App/EventLoop.hs
+++ b/src/Xmobar/App/EventLoop.hs
@@ -17,7 +17,12 @@
 ------------------------------------------------------------------------------
 
 
-module Xmobar.App.EventLoop (startLoop, startCommand) where
+module Xmobar.App.EventLoop
+    ( startLoop
+    , startCommand
+    , newRefreshLock
+    , refreshLock
+    ) where
 
 import Prelude hiding (lookup)
 import Graphics.X11.Xlib hiding (textExtents, textWidth)
@@ -31,7 +36,7 @@ import Control.Monad.Reader
 import Control.Concurrent
 import Control.Concurrent.Async (Async, async)
 import Control.Concurrent.STM
-import Control.Exception (handle, SomeException(..))
+import Control.Exception (bracket_, handle, SomeException(..))
 import Data.Bits
 import Data.Map hiding (foldr, map, filter)
 import Data.Maybe (fromJust, isJust)
@@ -63,15 +68,34 @@ import Xmobar.System.DBus
 runX :: XConf -> X () -> IO ()
 runX xc f = runReaderT f xc
 
+newRefreshLock :: IO (TMVar ())
+newRefreshLock = atomically $ newTMVar ()
+
+refreshLock :: TMVar () -> IO a -> IO a
+refreshLock var = bracket_ lock unlock
+    where
+        lock = atomically $ takeTMVar var
+        unlock = atomically $ putTMVar var ()
+
+refreshLockT :: TMVar () -> STM a -> STM a
+refreshLockT var action = do
+    takeTMVar var
+    r <- action
+    putTMVar var ()
+    return r
+
 -- | Starts the main event loop and threads
-startLoop :: XConf -> TMVar SignalType -> [[([Async ()], TVar String)]]
-             -> IO ()
-startLoop xcfg@(XConf _ _ w _ _ _ _) sig vs = do
+startLoop :: XConf
+          -> TMVar SignalType
+          -> TMVar ()
+          -> [[([Async ()], TVar String)]]
+          -> IO ()
+startLoop xcfg@(XConf _ _ w _ _ _ _) sig pauser vs = do
 #ifdef XFT
     xftInitFtLibrary
 #endif
     tv <- atomically $ newTVar []
-    _ <- forkIO (handle (handler "checker") (checker tv [] vs sig))
+    _ <- forkIO (handle (handler "checker") (checker tv [] vs sig pauser))
 #ifdef THREADED_RUNTIME
     _ <- forkOS (handle (handler "eventer") (eventer sig))
 #else
@@ -111,15 +135,16 @@ checker :: TVar [String]
            -> [String]
            -> [[([Async ()], TVar String)]]
            -> TMVar SignalType
+           -> TMVar ()
            -> IO ()
-checker tvar ov vs signal = do
-      nval <- atomically $ do
+checker tvar ov vs signal pauser = do
+      nval <- atomically $ refreshLockT pauser $ do
               nv <- mapM concatV vs
               guard (nv /= ov)
               writeTVar tvar nv
               return nv
       atomically $ putTMVar signal Wakeup
-      checker tvar nval vs signal
+      checker tvar nval vs signal pauser
     where
       concatV = fmap concat . mapM (readTVar . snd)