ndwarshuis
/
xmonad-config
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

ENH generalize common plugin interfaces

This commit is contained in:
Nathan Dwarshuis 2022-12-30 16:44:00 -05:00
parent 4aae54b90e
commit cc0465194a
1 changed files with 16 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
lib/Xmobar/Plugins/Common.hs
View File

@ -15,10 +15,10 @@ module Xmobar.Plugins.Common
) )
where where
import Control.Monad
import DBus import DBus
import DBus.Client import DBus.Client
import Data.Internal.DBus import Data.Internal.DBus
import RIO
import qualified RIO.Text as T import qualified RIO.Text as T
import XMonad.Hooks.DynamicLog (xmobarColor) import XMonad.Hooks.DynamicLog (xmobarColor)
@ -32,14 +32,14 @@ data Colors = Colors
deriving (Eq, Show, Read) deriving (Eq, Show, Read)
startListener startListener
:: (SafeClient c, IsVariant a) :: (MonadUnliftIO m, SafeClient c, IsVariant a)
=> MatchRule => MatchRule
-> (c -> IO [Variant]) -> (c -> m [Variant])
-> ([Variant] -> SignalMatch a) -> ([Variant] -> SignalMatch a)
-> (a -> IO T.Text) -> (a -> m T.Text)
-> Callback -> Callback
-> c -> c
-> IO () -> m ()
startListener rule getProp fromSignal toColor cb client = do startListener rule getProp fromSignal toColor cb client = do
reply <- getProp client reply <- getProp client
displayMaybe cb toColor $ fromSingletonVariant reply displayMaybe cb toColor $ fromSingletonVariant reply
@ -47,7 +47,8 @@ startListener rule getProp fromSignal toColor cb client = do
where where
procMatch = procSignalMatch cb toColor procMatch = procSignalMatch cb toColor
procSignalMatch :: Callback -> (a -> IO T.Text) -> SignalMatch a -> IO () procSignalMatch
:: MonadUnliftIO m => Callback -> (a -> m T.Text) -> SignalMatch a -> m ()
procSignalMatch cb f = withSignalMatch (displayMaybe cb f) procSignalMatch cb f = withSignalMatch (displayMaybe cb f)
colorText :: Colors -> Bool -> T.Text -> T.Text colorText :: Colors -> Bool -> T.Text -> T.Text
@ -60,11 +61,15 @@ xmobarFGColor c = T.pack . xmobarColor (T.unpack c) "" . T.unpack
na :: T.Text na :: T.Text
na = "N/A" na = "N/A"
displayMaybe :: Callback -> (a -> IO T.Text) -> Maybe a -> IO () displayMaybe :: MonadUnliftIO m => Callback -> (a -> m T.Text) -> Maybe a -> m ()
displayMaybe cb f = (cb . T.unpack) <=< maybe (return na) f displayMaybe cb f = (liftIO . cb . T.unpack) <=< maybe (return na) f
displayMaybe' :: Callback -> (a -> IO ()) -> Maybe a -> IO () displayMaybe' :: MonadUnliftIO m => Callback -> (a -> m ()) -> Maybe a -> m ()
displayMaybe' cb = maybe (cb $ T.unpack na) displayMaybe' cb = maybe (liftIO $ cb $ T.unpack na)
withDBusClientConnection :: SafeClient c => Callback -> (c -> IO ()) -> IO () withDBusClientConnection
:: (MonadUnliftIO m, SafeClient c)
=> Callback
-> (c -> m ())
-> m ()
withDBusClientConnection cb f = displayMaybe' cb f =<< getDBusClient withDBusClientConnection cb f = displayMaybe' cb f =<< getDBusClient