From 06e5c61ff84bae540ce16ca17abb94c703546acd Mon Sep 17 00:00:00 2001 From: jao Date: Fri, 28 Jan 2022 03:45:03 +0000 Subject: Xmobar.App.CommandThreads --- src/Xmobar/App/CommandThreads.hs | 61 ++++++++++++++++++++++++++++++++++++++++ src/Xmobar/App/EventLoop.hs | 59 ++++++++------------------------------ src/Xmobar/App/Main.hs | 3 +- 3 files changed, 75 insertions(+), 48 deletions(-) create mode 100644 src/Xmobar/App/CommandThreads.hs (limited to 'src') diff --git a/src/Xmobar/App/CommandThreads.hs b/src/Xmobar/App/CommandThreads.hs new file mode 100644 index 0000000..1de2936 --- /dev/null +++ b/src/Xmobar/App/CommandThreads.hs @@ -0,0 +1,61 @@ +------------------------------------------------------------------------------ +-- | +-- Module: Xmobar.App.CommandThreads +-- 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 03:20 +-- +-- +-- Running a thread for each defined Command +-- +------------------------------------------------------------------------------ + +module Xmobar.App.CommandThreads ( startCommand + , newRefreshLock + , refreshLock + , refreshLockT) where + +import Control.Concurrent.STM +import Control.Concurrent.Async (Async, async) +import Control.Exception (bracket_) + +import Xmobar.System.Signal (SignalType) +import Xmobar.Run.Runnable (Runnable) +import Xmobar.Run.Exec (start, trigger, alias) + +newRefreshLock :: IO (TMVar ()) +newRefreshLock = newTMVarIO () + +refreshLock :: TMVar () -> IO a -> IO a +refreshLock var = bracket_ lock unlock + where + lock = atomically $ takeTMVar var + unlock = atomically $ putTMVar var () + +refreshLockT :: TMVar () -> STM a -> STM a +refreshLockT var action = do + takeTMVar var + r <- action + putTMVar var () + return r + +-- | Runs a command as an independent thread and returns its Async handles +-- and the TVar the command will be writing to. +startCommand :: TMVar SignalType + -> (Runnable,String,String) + -> IO ([Async ()], TVar String) +startCommand sig (com,s,ss) + | alias com == "" = do var <- newTVarIO is + atomically $ writeTVar var (s ++ ss) + return ([], var) + | otherwise = do var <- newTVarIO is + let cb str = atomically $ writeTVar var (s ++ str ++ ss) + a1 <- async $ start com cb + a2 <- async $ trigger com $ maybe (return ()) + (atomically . putTMVar sig) + return ([a1, a2], var) + where is = s ++ "Updating..." ++ ss diff --git a/src/Xmobar/App/EventLoop.hs b/src/Xmobar/App/EventLoop.hs index f046647..1764b1d 100644 --- a/src/Xmobar/App/EventLoop.hs +++ b/src/Xmobar/App/EventLoop.hs @@ -16,13 +16,7 @@ -- ------------------------------------------------------------------------------ - -module Xmobar.App.EventLoop - ( startLoop - , startCommand - , newRefreshLock - , refreshLock - ) where +module Xmobar.App.EventLoop (startLoop) where import Prelude hiding (lookup) import Graphics.X11.Xlib hiding (textExtents, textWidth) @@ -33,18 +27,22 @@ import Graphics.X11.Xrandr import Control.Arrow ((&&&)) import Control.Monad.Reader import Control.Concurrent -import Control.Concurrent.Async (Async, async) +import Control.Concurrent.Async (Async) import Control.Concurrent.STM -import Control.Exception (bracket_, handle, SomeException(..)) +import Control.Exception (handle, SomeException(..)) import Data.Bits import Data.Map hiding (foldr, map, filter) import Data.Maybe (fromJust, isJust) import qualified Data.List.NonEmpty as NE import Xmobar.System.Signal -import Xmobar.Config.Types (persistent, position, iconRoot, Config, Align(..), XPosition(..)) -import Xmobar.Run.Exec -import Xmobar.Run.Runnable +import Xmobar.Config.Types (persistent + , position + , iconRoot + , Config + , Align(..) + , XPosition(..)) + import Xmobar.X11.Actions import Xmobar.X11.Parsers import Xmobar.X11.Window @@ -54,6 +52,8 @@ import Xmobar.X11.Bitmap as Bitmap import Xmobar.X11.Types import Xmobar.System.Utils (safeIndex) +import Xmobar.App.CommandThreads (refreshLockT) + #ifndef THREADED_RUNTIME import Xmobar.X11.Events(nextEvent') #endif @@ -69,22 +69,6 @@ import Xmobar.System.DBus runX :: XConf -> X () -> IO () runX xc f = runReaderT f xc -newRefreshLock :: IO (TMVar ()) -newRefreshLock = newTMVarIO () - -refreshLock :: TMVar () -> IO a -> IO a -refreshLock var = bracket_ lock unlock - where - lock = atomically $ takeTMVar var - unlock = atomically $ putTMVar var () - -refreshLockT :: TMVar () -> STM a -> STM a -refreshLockT var action = do - takeTMVar var - r <- action - putTMVar var () - return r - -- | Starts the main event loop and threads startLoop :: XConf -> TMVar SignalType @@ -230,25 +214,6 @@ eventLoop tv xc@(XConf d r w fs vos is cfg) as signal = do filter (\(_, from, to) -> x >= from && x <= to) as eventLoop tv xc as signal --- $command - --- | Runs a command as an independent thread and returns its Async handles --- and the TVar the command will be writing to. -startCommand :: TMVar SignalType - -> (Runnable,String,String) - -> IO ([Async ()], TVar String) -startCommand sig (com,s,ss) - | alias com == "" = do var <- newTVarIO is - atomically $ writeTVar var (s ++ ss) - return ([], var) - | otherwise = do var <- newTVarIO is - let cb str = atomically $ writeTVar var (s ++ str ++ ss) - a1 <- async $ start com cb - a2 <- async $ trigger com $ maybe (return ()) - (atomically . putTMVar sig) - return ([a1, a2], var) - where is = s ++ "Updating..." ++ ss - updateString :: Config -> TVar [String] -> IO [[(Widget, TextRenderInfo, Int, Maybe [Action])]] diff --git a/src/Xmobar/App/Main.hs b/src/Xmobar/App/Main.hs index 6a3203f..b67012d 100644 --- a/src/Xmobar/App/Main.hs +++ b/src/Xmobar/App/Main.hs @@ -42,7 +42,8 @@ import Xmobar.X11.Types import Xmobar.X11.Text import Xmobar.X11.Window import Xmobar.App.Opts (recompileFlag, verboseFlag, getOpts, doOpts) -import Xmobar.App.EventLoop (startLoop, startCommand, newRefreshLock, refreshLock) +import Xmobar.App.EventLoop (startLoop) +import Xmobar.App.CommandThreads (startCommand, newRefreshLock, refreshLock) import Xmobar.App.Compile (recompile, trace) import Xmobar.App.Config import Xmobar.App.Timer (withTimer) -- cgit v1.2.3