diff options
author | jao <jao@gnu.org> | 2022-01-28 03:46:49 +0000 |
---|---|---|
committer | jao <jao@gnu.org> | 2022-01-29 06:42:29 +0000 |
commit | 93da696658061e1c14fdca70b6c0f04c412b1fd8 (patch) | |
tree | c53b24ab8cf60419d2a224fe279dfc2e9ac2ac71 /src/Xmobar | |
parent | 06e5c61ff84bae540ce16ca17abb94c703546acd (diff) | |
download | xmobar-93da696658061e1c14fdca70b6c0f04c412b1fd8.tar.gz xmobar-93da696658061e1c14fdca70b6c0f04c412b1fd8.tar.bz2 |
Basic Xmobar.App.TextEventLoop
Diffstat (limited to 'src/Xmobar')
-rw-r--r-- | src/Xmobar/App/TextEventLoop.hs | 88 | ||||
-rw-r--r-- | src/Xmobar/X11/Parsers.hs | 20 |
2 files changed, 106 insertions, 2 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] diff --git a/src/Xmobar/X11/Parsers.hs b/src/Xmobar/X11/Parsers.hs index 0685618..34d4336 100644 --- a/src/Xmobar/X11/Parsers.hs +++ b/src/Xmobar/X11/Parsers.hs @@ -14,8 +14,14 @@ -- ----------------------------------------------------------------------------- -module Xmobar.X11.Parsers (parseString, Box(..), BoxBorder(..), BoxOffset(..), - BoxMargins(..), TextRenderInfo(..), Widget(..)) where +module Xmobar.X11.Parsers ( parseString + , parseStringAsText + , Box(..) + , BoxBorder(..) + , BoxOffset(..) + , BoxMargins(..) + , TextRenderInfo(..) + , Widget(..)) where import Xmobar.Config.Types import Xmobar.X11.Actions @@ -62,6 +68,16 @@ parseString c s = Right x -> return (concat x) where ci = TextRenderInfo (fgColor c) 0 0 [] +asText :: (Widget, TextRenderInfo, FontIndex, Maybe [Action]) -> String +asText (Text s, _, _, _) = s +asText _ = "" + +parseStringAsText :: Config -> String -> IO String +parseStringAsText c s = do + chunks <- parseString c s + let txts = map asText chunks + return (concat txts) + allParsers :: TextRenderInfo -> FontIndex -> Maybe [Action] |