Basic Xmobar.App.TextEventLoop

3 files changed, 107 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]
diff --git a/xmobar.cabal b/xmobar.cabal
index 9c60b63..3f54975 100644
--- a/xmobar.cabal
+++ b/xmobar.cabal
@@ -115,6 +115,7 @@ library
                    Xmobar.Run.Runnable
                    Xmobar.App.CommandThreads,
                    Xmobar.App.EventLoop,
+                   Xmobar.App.TextEventLoop,
                    Xmobar.App.Config,
                    Xmobar.App.Main,
                    Xmobar.App.Opts,