78 lines
2.0 KiB
Haskell
78 lines
2.0 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Xmobar.Plugins.Common
|
|
( colorText
|
|
, startListener
|
|
, procSignalMatch
|
|
, na
|
|
, fromSingletonVariant
|
|
, withDBusClientConnection
|
|
, Callback
|
|
, Colors(..)
|
|
, displayMaybe
|
|
, displayMaybe_
|
|
, xmobarFGColor
|
|
)
|
|
where
|
|
|
|
import Data.Internal.DBus
|
|
|
|
import DBus
|
|
import DBus.Client
|
|
|
|
import RIO
|
|
import qualified RIO.Text as T
|
|
|
|
import XMonad.Hooks.DynamicLog (xmobarColor)
|
|
|
|
-- use string here since all the callbacks in xmobar use strings :(
|
|
type Callback = String -> IO ()
|
|
|
|
data Colors = Colors
|
|
{ colorsOn :: T.Text
|
|
, colorsOff :: T.Text
|
|
}
|
|
deriving (Eq, Show, Read)
|
|
|
|
startListener :: (MonadIO m, SafeClient c, IsVariant a) => MatchRule -> (c -> m [Variant])
|
|
-> ([Variant] -> SignalMatch a) -> (a -> IO T.Text) -> Callback
|
|
-> c -> m ()
|
|
startListener rule getProp fromSignal toColor cb client = do
|
|
reply <- getProp client
|
|
displayMaybe cb (liftIO . toColor) $ fromSingletonVariant reply
|
|
void $ addMatchCallback rule (procMatch . fromSignal) client
|
|
where
|
|
procMatch = procSignalMatch cb toColor
|
|
|
|
procSignalMatch
|
|
:: Callback
|
|
-> (a -> IO T.Text)
|
|
-> SignalMatch a
|
|
-> IO ()
|
|
procSignalMatch cb f = withSignalMatch (displayMaybe cb f)
|
|
|
|
colorText :: Colors -> Bool -> T.Text -> T.Text
|
|
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
|
|
|
|
na :: T.Text
|
|
na = "N/A"
|
|
|
|
displayMaybe :: (MonadIO m) => Callback -> (a -> m T.Text) -> Maybe a -> m ()
|
|
displayMaybe cb f = (liftIO . cb . T.unpack) <=< maybe (return na) f
|
|
|
|
displayMaybe_ :: MonadIO m => Callback -> (a -> m ()) -> Maybe a -> m ()
|
|
displayMaybe_ cb = maybe (liftIO $ cb $ T.unpack na)
|
|
|
|
withDBusClientConnection
|
|
:: (SafeClient c)
|
|
=> Callback
|
|
-> (c -> RIO SimpleApp ())
|
|
-> IO ()
|
|
withDBusClientConnection cb f = do
|
|
-- TODO be more sophisticated
|
|
runSimpleApp $ withDBusClient_ $ displayMaybe_ cb f . Just
|