summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/App/CommandThreads.hs
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2022-01-29 01:59:17 +0000
committerjao <jao@gnu.org>2022-01-29 06:42:29 +0000
commit23399ceab6ca3fe9938cf97b7aa726258512be98 (patch)
tree479d7535bb7e4c9631e8c8ca21ee5100f791a1ef /src/Xmobar/App/CommandThreads.hs
parent0d3021eb601dadfa10fae30f108108894086c82c (diff)
downloadxmobar-23399ceab6ca3fe9938cf97b7aa726258512be98.tar.gz
xmobar-23399ceab6ca3fe9938cf97b7aa726258512be98.tar.bz2
Refactoring of the previous patch and its surroundings
Diffstat (limited to 'src/Xmobar/App/CommandThreads.hs')
-rw-r--r--src/Xmobar/App/CommandThreads.hs82
1 files changed, 76 insertions, 6 deletions
diff --git a/src/Xmobar/App/CommandThreads.hs b/src/Xmobar/App/CommandThreads.hs
index 1de2936..931a072 100644
--- a/src/Xmobar/App/CommandThreads.hs
+++ b/src/Xmobar/App/CommandThreads.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
------------------------------------------------------------------------------
-- |
-- Module: Xmobar.App.CommandThreads
@@ -14,18 +16,29 @@
--
------------------------------------------------------------------------------
-module Xmobar.App.CommandThreads ( startCommand
+module Xmobar.App.CommandThreads ( initLoop
+ , loop
, newRefreshLock
- , refreshLock
- , refreshLockT) where
+ , refreshLock) where
+import Control.Concurrent (forkIO)
+import Control.Exception (bracket_, bracket, handle, SomeException(..))
import Control.Concurrent.STM
-import Control.Concurrent.Async (Async, async)
-import Control.Exception (bracket_)
+import Control.Concurrent.Async (Async, async, cancel)
+import Control.Monad (guard, void, unless)
+import Data.Maybe (isJust)
+import Data.Foldable (for_)
-import Xmobar.System.Signal (SignalType)
+import Xmobar.System.Signal
+import Xmobar.Config.Types
import Xmobar.Run.Runnable (Runnable)
import Xmobar.Run.Exec (start, trigger, alias)
+import Xmobar.Run.Template
+import Xmobar.App.Timer (withTimer)
+
+#ifdef DBUS
+import Xmobar.System.DBus
+#endif
newRefreshLock :: IO (TMVar ())
newRefreshLock = newTMVarIO ()
@@ -43,6 +56,45 @@ refreshLockT var action = do
putTMVar var ()
return r
+type StartFunction = TMVar SignalType
+ -> TMVar ()
+ -> [[([Async ()], TVar String)]]
+ -> IO ()
+
+loop :: Config -> StartFunction -> IO ()
+loop conf starter = withDeferSignals $ do
+ cls <- mapM (parseTemplate (commands conf) (sepChar conf))
+ (splitTemplate (alignSep conf) (template conf))
+ let confSig = unSignalChan (signal conf)
+ sig <- maybe newEmptyTMVarIO pure confSig
+ unless (isJust confSig) $ setupSignalHandler sig
+ refLock <- newRefreshLock
+ withTimer (refreshLock refLock) $
+ bracket (mapM (mapM $ startCommand sig) cls)
+ cleanupThreads
+ $ \vars -> do
+ starter sig refLock vars
+
+cleanupThreads :: [[([Async ()], a)]] -> IO ()
+cleanupThreads vars =
+ for_ (concat vars) $ \(asyncs, _) ->
+ for_ asyncs cancel
+
+-- | Initialises context for an event loop, returning a TVar that
+-- will hold the current list of values computed by commands.
+initLoop :: TMVar SignalType -> TMVar () -> [[([Async ()], TVar String)]]
+ -> IO (TVar [String])
+initLoop sig lock vs = do
+ tv <- newTVarIO ([] :: [String])
+ _ <- forkIO (handle (handler "checker") (checker tv [] vs sig lock))
+#ifdef DBUS
+ runIPC sig
+#endif
+ return tv
+ where
+ handler thing (SomeException e) =
+ void $ putStrLn ("Thread " ++ thing ++ " failed: " ++ show e)
+
-- | Runs a command as an independent thread and returns its Async handles
-- and the TVar the command will be writing to.
startCommand :: TMVar SignalType
@@ -59,3 +111,21 @@ startCommand sig (com,s,ss)
(atomically . putTMVar sig)
return ([a1, a2], var)
where is = s ++ "Updating..." ++ ss
+
+-- | Send signal to eventLoop every time a var is updated
+checker :: TVar [String]
+ -> [String]
+ -> [[([Async ()], TVar String)]]
+ -> TMVar SignalType
+ -> TMVar ()
+ -> IO ()
+checker tvar ov vs sig pauser = do
+ nval <- atomically $ refreshLockT pauser $ do
+ nv <- mapM concatV vs
+ guard (nv /= ov)
+ writeTVar tvar nv
+ return nv
+ atomically $ putTMVar sig Wakeup
+ checker tvar nval vs sig pauser
+ where
+ concatV = fmap concat . mapM (readTVar . snd)