diff options
Diffstat (limited to 'src/Xmobar/App')
-rw-r--r-- | src/Xmobar/App/TextEventLoop.hs | 88 |
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] |