blob: 50ee17c49d5c117fecb51d81ffd62b21ffc6e040 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
{-# 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 (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
-- | Starts the main event loop and threads
startTextLoop :: Config
-> TMVar SignalType
-> TMVar ()
-> [[([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
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]
|
