summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/App
diff options
context:
space:
mode:
Diffstat (limited to 'src/Xmobar/App')
-rw-r--r--src/Xmobar/App/TextEventLoop.hs88
1 files changed, 88 insertions, 0 deletions
diff --git a/src/Xmobar/App/TextEventLoop.hs b/src/Xmobar/App/TextEventLoop.hs
new file mode 100644
index 0000000..ae3a9e3
--- /dev/null
+++ b/src/Xmobar/App/TextEventLoop.hs
@@ -0,0 +1,88 @@
+{-# LANGUAGE CPP #-}
+
+------------------------------------------------------------------------------
+-- |
+-- Module: Xmobar.App.TextEventLoop
+-- Copyright: (c) 2022 Jose Antonio Ortega Ruiz
+-- License: BSD3-style (see LICENSE)
+--
+-- Maintainer: jao@gnu.org
+-- Stability: unstable
+-- Portability: unportable
+-- Created: Fri Jan 28, 2022 01:21
+--
+--
+-- Text-only event loop
+--
+------------------------------------------------------------------------------
+
+module Xmobar.App.TextEventLoop (startLoop) where
+
+import Prelude hiding (lookup)
+
+import Control.Monad.Reader
+import Control.Concurrent
+import Control.Concurrent.Async (Async, async)
+import Control.Concurrent.STM
+import Control.Exception (bracket_, handle, SomeException(..))
+
+import Xmobar.System.Signal
+import Xmobar.Config.Types (Config)
+import Xmobar.Run.Exec
+import Xmobar.Run.Runnable
+import Xmobar.X11.Parsers (parseStringAsText)
+
+import Xmobar.App.CommandThreads (startCommand, refreshLockT)
+
+#ifdef DBUS
+import Xmobar.System.DBus
+#endif
+
+-- | Starts the main event loop and threads
+startLoop :: Config
+ -> TMVar SignalType
+ -> TMVar ()
+ -> [[([Async ()], TVar String)]]
+ -> IO ()
+startLoop cfg sig pauser vs = do
+ tv <- newTVarIO []
+ _ <- forkIO (handle (handler "checker") (checker tv [] vs sig pauser))
+#ifdef DBUS
+ runIPC sig
+#endif
+ eventLoop cfg tv sig
+ where
+ handler thing (SomeException e) =
+ void $ putStrLn ("Thread " ++ thing ++ " failed: " ++ show e)
+
+-- | 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 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 pauser
+ where
+ concatV = fmap concat . mapM (readTVar . snd)
+
+-- | Continuously wait for a signal from a thread or a interrupt handler
+eventLoop :: Config -> TVar [String] -> TMVar SignalType -> IO ()
+eventLoop cfg tv signal = do
+ typ <- atomically $ takeTMVar signal
+ case typ of
+ Wakeup -> updateString cfg tv >>= putStrLn >> eventLoop cfg tv signal
+ _ -> eventLoop cfg tv signal
+
+updateString :: Config -> TVar [String] -> IO String
+updateString conf v = do
+ s <- readTVarIO v
+ let l:c:r:_ = s ++ repeat ""
+ liftIO $ concat `fmap` mapM (parseStringAsText conf) [l, c, r]