From 2a71487437ca4afed6f35acc1e16c2e03bfc053c Mon Sep 17 00:00:00 2001
From: Tomas Janousek <tomi@nomi.cz>
Date: Tue, 13 Aug 2019 22:37:01 +0200
Subject: Refactor code from tenthSeconds to doEveryTenthSeconds

A preparation for timer coalescing: tenthSeconds is just a sleep whereas
doEveryTenthSeconds enables using a central timer and waiting for all
monitors to update before refreshing the window. This commit is just a
simple refactor, the actual timer coalescing code comes later.
---
 src/Xmobar/Plugins/DateZone.hs            |  2 +-
 src/Xmobar/Plugins/Monitors/Common/Run.hs | 19 ++++++++++++++++---
 src/Xmobar/Run/Command.hs                 |  2 +-
 src/Xmobar/Run/Exec.hs                    |  8 ++++++--
 4 files changed, 24 insertions(+), 7 deletions(-)

diff --git a/src/Xmobar/Plugins/DateZone.hs b/src/Xmobar/Plugins/DateZone.hs
index 35767a8..7ac3ea1 100644
--- a/src/Xmobar/Plugins/DateZone.hs
+++ b/src/Xmobar/Plugins/DateZone.hs
@@ -72,7 +72,7 @@ instance Exec DateZone where
        else
         go (date f locale)
 
-      where go func = func >>= cb >> tenthSeconds r >> go func
+      where go func = doEveryTenthSeconds r $ func >>= cb
 
 {-# NOINLINE localeLock #-}
 -- ensures that only one plugin instance sets the locale
diff --git a/src/Xmobar/Plugins/Monitors/Common/Run.hs b/src/Xmobar/Plugins/Monitors/Common/Run.hs
index a73a6fb..3baa7aa 100644
--- a/src/Xmobar/Plugins/Monitors/Common/Run.hs
+++ b/src/Xmobar/Plugins/Monitors/Common/Run.hs
@@ -19,6 +19,8 @@ module Xmobar.Plugins.Monitors.Common.Run ( runM
                                           , runMD
                                           , runMB
                                           , runMBD
+                                          , runML
+                                          , runMLD
                                           , getArgvs
                                           ) where
 
@@ -28,7 +30,7 @@ import Control.Monad.Reader
 import System.Console.GetOpt
 
 import Xmobar.Plugins.Monitors.Common.Types
-import Xmobar.Run.Exec (tenthSeconds)
+import Xmobar.Run.Exec (doEveryTenthSeconds)
 
 options :: [OptDescr Opts]
 options =
@@ -108,11 +110,11 @@ doConfigOptions (o:oo) =
 
 runM :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int
         -> (String -> IO ()) -> IO ()
-runM args conf action r = runMB args conf action (tenthSeconds r)
+runM args conf action r = runML args conf action (doEveryTenthSeconds r)
 
 runMD :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int
         -> ([String] -> Monitor Bool) -> (String -> IO ()) -> IO ()
-runMD args conf action r = runMBD args conf action (tenthSeconds r)
+runMD args conf action r = runMLD args conf action (doEveryTenthSeconds r)
 
 runMB :: [String] -> IO MConfig -> ([String] -> Monitor String) -> IO ()
         -> (String -> IO ()) -> IO ()
@@ -124,5 +126,16 @@ runMBD args conf action wait detect cb = handle (cb . showException) loop
   where ac = doArgs args action detect
         loop = conf >>= runReaderT ac >>= cb >> wait >> loop
 
+runML :: [String] -> IO MConfig -> ([String] -> Monitor String)
+      -> (IO () -> IO ()) -> (String -> IO ()) -> IO ()
+runML args conf action looper = runMLD args conf action looper (\_ -> return True)
+
+runMLD :: [String] -> IO MConfig -> ([String] -> Monitor String)
+       -> (IO () -> IO ()) -> ([String] -> Monitor Bool) -> (String -> IO ())
+       -> IO ()
+runMLD args conf action looper detect cb = handle (cb . showException) loop
+  where ac = doArgs args action detect
+        loop = looper $ conf >>= runReaderT ac >>= cb
+
 showException :: SomeException -> String
 showException = ("error: "++) . show . flip asTypeOf undefined
diff --git a/src/Xmobar/Run/Command.hs b/src/Xmobar/Run/Command.hs
index 0953132..e6153c1 100644
--- a/src/Xmobar/Run/Command.hs
+++ b/src/Xmobar/Run/Command.hs
@@ -41,7 +41,7 @@ instance Exec Command where
     start (Com p as al r) cb =
       start (ComX p as ("Could not execute command " ++ p) al r) cb
     start (ComX prog args msg _ r) cb = if r > 0 then go else exec
-        where go = exec >> tenthSeconds r >> go
+        where go = doEveryTenthSeconds r exec
               exec = do
                 (i,o,e,p) <- runInteractiveProcess prog args Nothing Nothing
                 exit <- waitForProcess p
diff --git a/src/Xmobar/Run/Exec.hs b/src/Xmobar/Run/Exec.hs
index c8fcb9e..db7e7b4 100644
--- a/src/Xmobar/Run/Exec.hs
+++ b/src/Xmobar/Run/Exec.hs
@@ -17,7 +17,7 @@
 --
 -----------------------------------------------------------------------------
 
-module Xmobar.Run.Exec (Exec (..), tenthSeconds) where
+module Xmobar.Run.Exec (Exec (..), tenthSeconds, doEveryTenthSeconds) where
 
 import Prelude
 import Data.Char
@@ -34,6 +34,10 @@ tenthSeconds s | s >= x = do threadDelay (x * 100000)
                | otherwise = threadDelay (s * 100000)
                where x = (maxBound :: Int) `div` 100000
 
+doEveryTenthSeconds :: Int -> IO () -> IO ()
+doEveryTenthSeconds r action = go
+    where go = action >> tenthSeconds r >> go
+
 class Show e => Exec e where
     alias   :: e -> String
     alias   e    = takeWhile (not . isSpace) $ show e
@@ -43,6 +47,6 @@ class Show e => Exec e where
     run     _    = return ""
     start   :: e -> (String -> IO ()) -> IO ()
     start   e cb = go
-        where go = run e >>= cb >> tenthSeconds (rate e) >> go
+        where go = doEveryTenthSeconds (rate e) $ run e >>= cb
     trigger :: e -> (Maybe SignalType -> IO ()) -> IO ()
     trigger _ sh  = sh Nothing
-- 
cgit v1.2.3