summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/App/CommandThreads.hs
blob: 1de2936df59f239b97bc5820e867be7e17338a29 (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
------------------------------------------------------------------------------
-- |
-- 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