2021-11-24 00:43:58 -05:00
|
|
|
|
|
|
|
module Xmobar.Plugins.Common
|
2021-11-24 01:14:23 -05:00
|
|
|
( chooseColor
|
|
|
|
, startListener
|
2021-11-26 23:35:03 -05:00
|
|
|
, procSignalMatch
|
2021-11-25 00:12:00 -05:00
|
|
|
, na
|
2021-11-26 23:35:03 -05:00
|
|
|
, fromSingletonVariant
|
|
|
|
, withDBusClientConnection
|
|
|
|
, Callback
|
2021-11-27 13:24:13 -05:00
|
|
|
, displayMaybe
|
|
|
|
, displayMaybe'
|
2021-11-24 01:14:23 -05:00
|
|
|
)
|
2021-11-24 00:43:58 -05:00
|
|
|
where
|
|
|
|
|
2021-11-26 23:35:03 -05:00
|
|
|
import Control.Monad
|
|
|
|
|
2021-11-24 01:14:23 -05:00
|
|
|
import DBus
|
|
|
|
import DBus.Client
|
2021-11-27 01:02:22 -05:00
|
|
|
import DBus.Internal
|
2021-11-24 01:14:23 -05:00
|
|
|
|
2021-11-27 01:02:22 -05:00
|
|
|
import XMonad.Hooks.DynamicLog (xmobarColor)
|
2021-11-24 01:14:23 -05:00
|
|
|
|
2021-11-26 23:35:03 -05:00
|
|
|
type Callback = String -> IO ()
|
|
|
|
|
2021-11-24 01:14:23 -05:00
|
|
|
startListener :: IsVariant a => MatchRule -> (Client -> IO [Variant])
|
2021-11-26 23:35:03 -05:00
|
|
|
-> ([Variant] -> SignalMatch a) -> (a -> IO String) -> Callback
|
2021-11-25 00:12:00 -05:00
|
|
|
-> Client -> IO ()
|
|
|
|
startListener rule getProp fromSignal toColor cb client = do
|
|
|
|
reply <- getProp client
|
2021-11-27 13:24:13 -05:00
|
|
|
displayMaybe cb toColor $ fromSingletonVariant reply
|
2021-11-26 23:35:03 -05:00
|
|
|
void $ addMatchCallback rule (procMatch . fromSignal) client
|
2021-11-24 01:14:23 -05:00
|
|
|
where
|
2021-11-26 23:35:03 -05:00
|
|
|
procMatch = procSignalMatch cb toColor
|
|
|
|
|
2021-11-27 13:24:13 -05:00
|
|
|
procSignalMatch :: Callback -> (a -> IO String) -> SignalMatch a -> IO ()
|
|
|
|
procSignalMatch cb f = withSignalMatch (displayMaybe cb f)
|
2021-11-24 00:43:58 -05:00
|
|
|
|
|
|
|
chooseColor :: String -> String -> String -> Bool -> String
|
|
|
|
chooseColor text colorOn colorOff state =
|
|
|
|
xmobarColor (if state then colorOn else colorOff) "" text
|
2021-11-25 00:12:00 -05:00
|
|
|
|
|
|
|
na :: String
|
|
|
|
na = "N/A"
|
2021-11-26 23:35:03 -05:00
|
|
|
|
2021-11-27 13:24:13 -05:00
|
|
|
displayMaybe :: Callback -> (a -> IO String) -> Maybe a -> IO ()
|
|
|
|
displayMaybe cb f = cb <=< maybe (return na) f
|
|
|
|
|
|
|
|
displayMaybe' :: Callback -> (a -> IO ()) -> Maybe a -> IO ()
|
|
|
|
displayMaybe' cb = maybe (cb na)
|
2021-11-26 23:35:03 -05:00
|
|
|
|
|
|
|
withDBusClientConnection :: Bool -> Callback -> (Client -> IO ()) -> IO ()
|
2021-11-27 13:24:13 -05:00
|
|
|
withDBusClientConnection sys cb f = displayMaybe' cb f =<< getDBusClient sys
|