summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2022-01-28 03:46:49 +0000
committerjao <jao@gnu.org>2022-01-29 06:42:29 +0000
commit93da696658061e1c14fdca70b6c0f04c412b1fd8 (patch)
treec53b24ab8cf60419d2a224fe279dfc2e9ac2ac71 /src/Xmobar
parent06e5c61ff84bae540ce16ca17abb94c703546acd (diff)
downloadxmobar-93da696658061e1c14fdca70b6c0f04c412b1fd8.tar.gz
xmobar-93da696658061e1c14fdca70b6c0f04c412b1fd8.tar.bz2
Basic Xmobar.App.TextEventLoop
Diffstat (limited to 'src/Xmobar')
-rw-r--r--src/Xmobar/App/TextEventLoop.hs88
-rw-r--r--src/Xmobar/X11/Parsers.hs20
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]