From 23399ceab6ca3fe9938cf97b7aa726258512be98 Mon Sep 17 00:00:00 2001
From: jao <jao@gnu.org>
Date: Sat, 29 Jan 2022 01:59:17 +0000
Subject: Refactoring of the previous patch and its surroundings
---
src/Xmobar/App/CommandThreads.hs | 82 +++++++++++++++++++++++++++++++++++++---
src/Xmobar/App/EventLoop.hs | 31 +--------------
src/Xmobar/App/Main.hs | 55 ++++++---------------------
src/Xmobar/App/TextEventLoop.hs | 53 ++++++++------------------
4 files changed, 104 insertions(+), 117 deletions(-)
(limited to 'src/Xmobar/App')
diff --git a/src/Xmobar/App/CommandThreads.hs b/src/Xmobar/App/CommandThreads.hs
index 1de2936..931a072 100644
--- a/src/Xmobar/App/CommandThreads.hs
+++ b/src/Xmobar/App/CommandThreads.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
------------------------------------------------------------------------------
-- |
-- Module: Xmobar.App.CommandThreads
@@ -14,18 +16,29 @@
--
------------------------------------------------------------------------------
-module Xmobar.App.CommandThreads ( startCommand
+module Xmobar.App.CommandThreads ( initLoop
+ , loop
, newRefreshLock
- , refreshLock
- , refreshLockT) where
+ , refreshLock) where
+import Control.Concurrent (forkIO)
+import Control.Exception (bracket_, bracket, handle, SomeException(..))
import Control.Concurrent.STM
-import Control.Concurrent.Async (Async, async)
-import Control.Exception (bracket_)
+import Control.Concurrent.Async (Async, async, cancel)
+import Control.Monad (guard, void, unless)
+import Data.Maybe (isJust)
+import Data.Foldable (for_)
-import Xmobar.System.Signal (SignalType)
+import Xmobar.System.Signal
+import Xmobar.Config.Types
import Xmobar.Run.Runnable (Runnable)
import Xmobar.Run.Exec (start, trigger, alias)
+import Xmobar.Run.Template
+import Xmobar.App.Timer (withTimer)
+
+#ifdef DBUS
+import Xmobar.System.DBus
+#endif
newRefreshLock :: IO (TMVar ())
newRefreshLock = newTMVarIO ()
@@ -43,6 +56,45 @@ refreshLockT var action = do
putTMVar var ()
return r
+type StartFunction = TMVar SignalType
+ -> TMVar ()
+ -> [[([Async ()], TVar String)]]
+ -> IO ()
+
+loop :: Config -> StartFunction -> IO ()
+loop conf starter = withDeferSignals $ do
+ cls <- mapM (parseTemplate (commands conf) (sepChar conf))
+ (splitTemplate (alignSep conf) (template conf))
+ let confSig = unSignalChan (signal conf)
+ sig <- maybe newEmptyTMVarIO pure confSig
+ unless (isJust confSig) $ setupSignalHandler sig
+ refLock <- newRefreshLock
+ withTimer (refreshLock refLock) $
+ bracket (mapM (mapM $ startCommand sig) cls)
+ cleanupThreads
+ $ \vars -> do
+ starter sig refLock vars
+
+cleanupThreads :: [[([Async ()], a)]] -> IO ()
+cleanupThreads vars =
+ for_ (concat vars) $ \(asyncs, _) ->
+ for_ asyncs cancel
+
+-- | Initialises context for an event loop, returning a TVar that
+-- will hold the current list of values computed by commands.
+initLoop :: TMVar SignalType -> TMVar () -> [[([Async ()], TVar String)]]
+ -> IO (TVar [String])
+initLoop sig lock vs = do
+ tv <- newTVarIO ([] :: [String])
+ _ <- forkIO (handle (handler "checker") (checker tv [] vs sig lock))
+#ifdef DBUS
+ runIPC sig
+#endif
+ return tv
+ where
+ handler thing (SomeException e) =
+ void $ putStrLn ("Thread " ++ thing ++ " failed: " ++ show e)
+
-- | Runs a command as an independent thread and returns its Async handles
-- and the TVar the command will be writing to.
startCommand :: TMVar SignalType
@@ -59,3 +111,21 @@ startCommand sig (com,s,ss)
(atomically . putTMVar sig)
return ([a1, a2], var)
where is = s ++ "Updating..." ++ ss
+
+-- | 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 sig pauser = do
+ nval <- atomically $ refreshLockT pauser $ do
+ nv <- mapM concatV vs
+ guard (nv /= ov)
+ writeTVar tvar nv
+ return nv
+ atomically $ putTMVar sig Wakeup
+ checker tvar nval vs sig pauser
+ where
+ concatV = fmap concat . mapM (readTVar . snd)
diff --git a/src/Xmobar/App/EventLoop.hs b/src/Xmobar/App/EventLoop.hs
index 1764b1d..b1bd3ff 100644
--- a/src/Xmobar/App/EventLoop.hs
+++ b/src/Xmobar/App/EventLoop.hs
@@ -52,7 +52,7 @@ import Xmobar.X11.Bitmap as Bitmap
import Xmobar.X11.Types
import Xmobar.System.Utils (safeIndex)
-import Xmobar.App.CommandThreads (refreshLockT)
+import Xmobar.App.CommandThreads (initLoop)
#ifndef THREADED_RUNTIME
import Xmobar.X11.Events(nextEvent')
@@ -62,10 +62,6 @@ import Xmobar.X11.Events(nextEvent')
import Graphics.X11.Xft
#endif
-#ifdef DBUS
-import Xmobar.System.DBus
-#endif
-
runX :: XConf -> X () -> IO ()
runX xc f = runReaderT f xc
@@ -79,15 +75,11 @@ startLoop xcfg@(XConf _ _ w _ _ _ _) sig pauser vs = do
#ifdef XFT
xftInitFtLibrary
#endif
- tv <- newTVarIO []
- _ <- forkIO (handle (handler "checker") (checker tv [] vs sig pauser))
+ tv <- initLoop sig pauser vs
#ifdef THREADED_RUNTIME
_ <- forkOS (handle (handler "eventer") (eventer sig))
#else
_ <- forkIO (handle (handler "eventer") (eventer sig))
-#endif
-#ifdef DBUS
- runIPC sig
#endif
eventLoop tv xcfg [] sig
where
@@ -115,25 +107,6 @@ startLoop xcfg@(XConf _ _ w _ _ _ _) sig pauser vs = do
putTMVar signal (Action (ev_button ev) (fi $ ev_x ev))
_ -> return ()
--- | 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 :: TVar [String]
-> XConf
diff --git a/src/Xmobar/App/Main.hs b/src/Xmobar/App/Main.hs
index ead3249..7bcf3bd 100644
--- a/src/Xmobar/App/Main.hs
+++ b/src/Xmobar/App/Main.hs
@@ -17,37 +17,30 @@
module Xmobar.App.Main (xmobar, xmobarMain, configFromArgs) where
-import Control.Concurrent.Async (Async, cancel)
-import Control.Concurrent.STM (newEmptyTMVarIO)
-import Control.Exception (bracket)
-import Control.Monad (unless)
-
-import Data.Foldable (for_)
import qualified Data.Map as Map
import Data.List (intercalate)
-import Data.Maybe (isJust)
import System.Posix.Process (executeFile)
import System.Environment (getArgs)
import System.FilePath ((</>), takeBaseName, takeDirectory, takeExtension)
import Text.Parsec.Error (ParseError)
import Data.List.NonEmpty (NonEmpty(..))
+import Control.Monad (unless)
import Graphics.X11.Xlib
import Xmobar.Config.Types
import Xmobar.Config.Parse
-import Xmobar.System.Signal (setupSignalHandler, withDeferSignals)
-import Xmobar.Run.Template
+import Xmobar.System.Signal (withDeferSignals)
+
import Xmobar.X11.Types
import Xmobar.X11.Text
import Xmobar.X11.Window
import Xmobar.App.Opts (recompileFlag, verboseFlag, getOpts, doOpts)
-import Xmobar.App.CommandThreads (startCommand, newRefreshLock, refreshLock)
+import Xmobar.App.CommandThreads (loop)
import Xmobar.App.EventLoop (startLoop)
import Xmobar.App.TextEventLoop (startTextLoop)
import Xmobar.App.Compile (recompile, trace)
import Xmobar.App.Config
-import Xmobar.App.Timer (withTimer)
xXmobar :: Config -> IO ()
xXmobar conf = withDeferSignals $ do
@@ -55,36 +48,15 @@ xXmobar conf = withDeferSignals $ do
d <- openDisplay ""
fs <- initFont d (font conf)
fl <- mapM (initFont d) (additionalFonts conf)
- cls <- mapM (parseTemplate (commands conf) (sepChar conf))
- (splitTemplate (alignSep conf) (template conf))
- let confSig = unSignalChan (signal conf)
- sig <- maybe newEmptyTMVarIO pure confSig
- unless (isJust confSig) $ setupSignalHandler sig
- refLock <- newRefreshLock
- withTimer (refreshLock refLock) $
- bracket (mapM (mapM $ startCommand sig) cls)
- cleanupThreads
- $ \vars -> do
- (r,w) <- createWin d fs conf
- let ic = Map.empty
- to = textOffset conf
- ts = textOffsets conf ++ replicate (length fl) (-1)
- startLoop (XConf d r w (fs :| fl) (to :| ts) ic conf) sig refLock vars
+ let ic = Map.empty
+ to = textOffset conf
+ ts = textOffsets conf ++ replicate (length fl) (-1)
+ loop conf $ \sig lock vars -> do
+ (r,w) <- createWin d fs conf
+ startLoop (XConf d r w (fs :| fl) (to :| ts) ic conf) sig lock vars
textXmobar :: Config -> IO ()
-textXmobar conf = withDeferSignals $ do
- initThreads
- cls <- mapM (parseTemplate (commands conf) (sepChar conf))
- (splitTemplate (alignSep conf) (template conf))
- let confSig = unSignalChan (signal conf)
- sig <- maybe newEmptyTMVarIO pure confSig
- unless (isJust confSig) $ setupSignalHandler sig
- refLock <- newRefreshLock
- withTimer (refreshLock refLock) $
- bracket (mapM (mapM $ startCommand sig) cls)
- cleanupThreads
- $ \vars -> do
- startTextLoop conf sig refLock vars
+textXmobar conf = loop conf (startTextLoop conf)
xmobar :: Config -> IO ()
xmobar cfg = if textOutput cfg then textXmobar cfg else xXmobar cfg
@@ -92,11 +64,6 @@ xmobar cfg = if textOutput cfg then textXmobar cfg else xXmobar cfg
configFromArgs :: Config -> IO Config
configFromArgs cfg = getArgs >>= getOpts >>= doOpts cfg . fst
-cleanupThreads :: [[([Async ()], a)]] -> IO ()
-cleanupThreads vars =
- for_ (concat vars) $ \(asyncs, _) ->
- for_ asyncs cancel
-
buildLaunch :: [String] -> Bool -> Bool -> String -> ParseError -> IO ()
buildLaunch args verb force p e = do
let exec = takeBaseName p
diff --git a/src/Xmobar/App/TextEventLoop.hs b/src/Xmobar/App/TextEventLoop.hs
index 50ee17c..6135554 100644
--- a/src/Xmobar/App/TextEventLoop.hs
+++ b/src/Xmobar/App/TextEventLoop.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE CPP #-}
-
------------------------------------------------------------------------------
-- |
-- Module: Xmobar.App.TextEventLoop
@@ -21,21 +19,14 @@ module Xmobar.App.TextEventLoop (startTextLoop) where
import Prelude hiding (lookup)
import Control.Monad.Reader
-import Control.Concurrent
+
import Control.Concurrent.Async (Async)
import Control.Concurrent.STM
-import Control.Exception (handle, SomeException(..))
import Xmobar.System.Signal
import Xmobar.Config.Types (Config)
-
-import Xmobar.X11.Parsers (parseStringAsText)
-
-import Xmobar.App.CommandThreads (refreshLockT)
-
-#ifdef DBUS
-import Xmobar.System.DBus
-#endif
+import Xmobar.X11.Parsers (Segment, Widget(..), parseString)
+import Xmobar.App.CommandThreads (initLoop)
-- | Starts the main event loop and threads
startTextLoop :: Config
@@ -44,33 +35,8 @@ startTextLoop :: Config
-> [[([Async ()], TVar String)]]
-> IO ()
startTextLoop cfg sig pauser vs = do
- tv <- newTVarIO []
- _ <- forkIO (handle (handler "checker") (checker tv [] vs sig pauser))
-#ifdef DBUS
- runIPC sig
-#endif
+ tv <- initLoop sig pauser vs
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 ()
@@ -85,3 +51,14 @@ updateString conf v = do
s <- readTVarIO v
let l:c:r:_ = s ++ repeat ""
liftIO $ concat `fmap` mapM (parseStringAsText conf) [l, c, r]
+
+asText :: Segment -> String
+asText (Text s, _, _, _) = s
+asText (Hspace n, _, _, _) = replicate (fromIntegral n) ' '
+asText _ = ""
+
+parseStringAsText :: Config -> String -> IO String
+parseStringAsText c s = do
+ segments <- parseString c s
+ let txts = map asText segments
+ return (concat txts)
--
cgit v1.2.3