xmonad-config/lib/Xmobar/Plugins/Common.hs

69 lines
1.9 KiB
Haskell
Raw Normal View History

{-# LANGUAGE OverloadedStrings #-}
module Xmobar.Plugins.Common
2021-11-27 17:33:02 -05:00
( colorText
2021-11-24 01:14:23 -05:00
, startListener
, procSignalMatch
2021-11-25 00:12:00 -05:00
, na
, fromSingletonVariant
, withDBusClientConnection
, Callback
2021-11-27 17:33:02 -05:00
, Colors(..)
2021-11-27 13:24:13 -05:00
, displayMaybe
, displayMaybe'
2021-11-27 17:33:02 -05:00
, xmobarFGColor
2021-11-24 01:14:23 -05:00
)
where
import Control.Monad
2022-07-09 17:44:14 -04:00
import Data.Internal.DBus
2021-11-24 01:14:23 -05:00
import DBus
import DBus.Client
import qualified RIO.Text as T
2022-07-09 17:44:14 -04:00
import XMonad.Hooks.DynamicLog (xmobarColor)
2021-11-24 01:14:23 -05:00
-- use string here since all the callbacks in xmobar use strings :(
type Callback = String -> IO ()
2021-11-27 17:33:02 -05:00
data Colors = Colors
{ colorsOn :: T.Text
, colorsOff :: T.Text
2021-11-27 17:33:02 -05:00
}
deriving (Eq, Show, Read)
startListener :: (SafeClient c, IsVariant a) => MatchRule -> (c -> IO [Variant])
-> ([Variant] -> SignalMatch a) -> (a -> IO T.Text) -> Callback
-> c -> IO ()
2021-11-25 00:12:00 -05:00
startListener rule getProp fromSignal toColor cb client = do
reply <- getProp client
displayMaybe cb toColor $ fromSingletonVariant reply
void $ addMatchCallback rule (procMatch . fromSignal) client
2021-11-24 01:14:23 -05:00
where
procMatch = procSignalMatch cb toColor
procSignalMatch :: Callback -> (a -> IO T.Text) -> SignalMatch a -> IO ()
2021-11-27 13:24:13 -05:00
procSignalMatch cb f = withSignalMatch (displayMaybe cb f)
colorText :: Colors -> Bool -> T.Text -> T.Text
2021-11-27 17:33:02 -05:00
colorText Colors { colorsOn = c } True = xmobarFGColor c
colorText Colors { colorsOff = c } False = xmobarFGColor c
xmobarFGColor :: T.Text -> T.Text -> T.Text
xmobarFGColor c = T.pack . xmobarColor (T.unpack c) "" . T.unpack
2021-11-25 00:12:00 -05:00
na :: T.Text
2021-11-25 00:12:00 -05:00
na = "N/A"
displayMaybe :: Callback -> (a -> IO T.Text) -> Maybe a -> IO ()
displayMaybe cb f = (cb . T.unpack) <=< maybe (return na) f
2021-11-27 13:24:13 -05:00
displayMaybe' :: Callback -> (a -> IO ()) -> Maybe a -> IO ()
displayMaybe' cb = maybe (cb $ T.unpack na)
withDBusClientConnection :: SafeClient c => Callback -> (c -> IO ()) -> IO ()
withDBusClientConnection cb f = displayMaybe' cb f =<< getDBusClient