blob: ae3a9e3640be732b0cedec1f6057c2211038dcf8 (
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
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]
|
