From 23399ceab6ca3fe9938cf97b7aa726258512be98 Mon Sep 17 00:00:00 2001 From: jao 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