From be73dd64d3ab5ebb58bf549e8e501d8879aa93bd Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Sun, 21 Nov 2021 17:54:00 -0500 Subject: [PATCH] ENH reuse client when possible --- bin/xmobar.hs | 11 +++++++- bin/xmonad.hs | 27 +++++++++++-------- .../Internal/DBus/Brightness/ClevoKeyboard.hs | 4 +-- lib/XMonad/Internal/DBus/Brightness/Common.hs | 18 ++++++------- .../DBus/Brightness/IntelBacklight.hs | 4 +-- lib/XMonad/Internal/DBus/Screensaver.hs | 12 ++++----- lib/XMonad/Internal/Dependency.hs | 17 +++++++----- lib/Xmobar/Plugins/ClevoKeyboard.hs | 9 ++++--- lib/Xmobar/Plugins/IntelBacklight.hs | 4 ++- lib/Xmobar/Plugins/Screensaver.hs | 7 ++--- 10 files changed, 68 insertions(+), 45 deletions(-) diff --git a/bin/xmobar.hs b/bin/xmobar.hs index e1719a0..ac22d4f 100644 --- a/bin/xmobar.hs +++ b/bin/xmobar.hs @@ -39,6 +39,7 @@ import XMonad.Hooks.DynamicLog , xmobarColor ) import XMonad.Internal.Command.Power (hasBattery) +import XMonad.Internal.DBus.Brightness.ClevoKeyboard import XMonad.Internal.DBus.Brightness.IntelBacklight import XMonad.Internal.Shell -- import XMonad.Internal.DBus.Common (xmonadBus) @@ -273,7 +274,7 @@ rightPlugins = , evalFeature getAlsa , evalFeature getBattery , evalFeature getBl - , nocheck ckCmd + , evalFeature getCk , evalFeature getSs , nocheck lockCmd , nocheck dateCmd @@ -340,6 +341,14 @@ getBl = Feature , ftrChildren = [intelBacklightSignalDep] } +getCk :: BarFeature +getCk = Feature + { ftrMaybeAction = ckCmd + , ftrName = "Clevo keyboard indicator" + , ftrWarning = Default + , ftrChildren = [clevoKeyboardSignalDep] + } + getSs :: BarFeature getSs = Feature { ftrMaybeAction = ssCmd diff --git a/bin/xmonad.hs b/bin/xmonad.hs index 3738976..217a0ef 100644 --- a/bin/xmonad.hs +++ b/bin/xmonad.hs @@ -468,8 +468,8 @@ mkNamedSubmap c KeyGroup { kgHeader = h, kgBindings = b } = <$> b data KeyBinding a = KeyBinding - { kbSyms :: String - , kbDesc :: String + { kbSyms :: String + , kbDesc :: String , kbMaybeAction :: a } @@ -549,14 +549,14 @@ externalBindings ts lock = ] , KeyGroup "System" - [ KeyBinding "M-." "backlight up" $ ioFeature $ bctlInc intelBacklightControls - , KeyBinding "M-," "backlight down" $ ioFeature $ bctlDec intelBacklightControls - , KeyBinding "M-M1-," "backlight min" $ ioFeature $ bctlMin intelBacklightControls - , KeyBinding "M-M1-." "backlight max" $ ioFeature $ bctlMax intelBacklightControls - , KeyBinding "M-S-." "keyboard up" $ ioFeature $ bctlInc clevoKeyboardControls - , KeyBinding "M-S-," "keyboard down" $ ioFeature $ bctlDec clevoKeyboardControls - , KeyBinding "M-S-M1-," "keyboard min" $ ioFeature $ bctlMin clevoKeyboardControls - , KeyBinding "M-S-M1-." "keyboard max" $ ioFeature $ bctlMax clevoKeyboardControls + [ KeyBinding "M-." "backlight up" $ ib bctlInc + , KeyBinding "M-," "backlight down" $ ib bctlDec + , KeyBinding "M-M1-," "backlight min" $ ib bctlMin + , KeyBinding "M-M1-." "backlight max" $ ib bctlMax + , KeyBinding "M-S-." "keyboard up" $ ck bctlInc + , KeyBinding "M-S-," "keyboard down" $ ck bctlDec + , KeyBinding "M-S-M1-," "keyboard min" $ ck bctlMin + , KeyBinding "M-S-M1-." "keyboard max" $ ck bctlMax , KeyBinding "M-" "power menu" $ ConstFeature $ runPowerPrompt lock , KeyBinding "M-" "quit xmonad" $ ConstFeature runQuitPrompt , KeyBinding "M-" "lock screen" runScreenLock @@ -568,7 +568,12 @@ externalBindings ts lock = , KeyBinding "M-" "select autorandr profile" runAutorandrMenu , KeyBinding "M-" "toggle ethernet" runToggleEthernet , KeyBinding "M-" "toggle bluetooth" runToggleBluetooth - , KeyBinding "M-" "toggle screensaver" $ ioFeature callToggle + , KeyBinding "M-" "toggle screensaver" $ maybe BlankFeature (ioFeature . callToggle) cl , KeyBinding "M-" "switch gpu" runOptimusPrompt ] ] + where + cl = tsClient ts + brightessControls ctl getter = maybe BlankFeature (ioFeature . getter . ctl) cl + ib = brightessControls intelBacklightControls + ck = brightessControls clevoKeyboardControls diff --git a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs index b4c8949..8e15252 100644 --- a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs +++ b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs @@ -120,10 +120,10 @@ exportClevoKeyboard :: Client -> FeatureIO exportClevoKeyboard = brightnessExporter [stateFileDep, brightnessFileDep] clevoKeyboardConfig -clevoKeyboardControls :: BrightnessControls +clevoKeyboardControls :: Client -> BrightnessControls clevoKeyboardControls = brightnessControls clevoKeyboardConfig -callGetBrightnessCK :: IO (Maybe Brightness) +callGetBrightnessCK :: Client -> IO (Maybe Brightness) callGetBrightnessCK = callGetBrightness clevoKeyboardConfig matchSignalCK :: (Maybe Brightness -> IO ()) -> IO SignalHandler diff --git a/lib/XMonad/Internal/DBus/Brightness/Common.hs b/lib/XMonad/Internal/DBus/Brightness/Common.hs index aafc29e..48d2c4a 100644 --- a/lib/XMonad/Internal/DBus/Brightness/Common.hs +++ b/lib/XMonad/Internal/DBus/Brightness/Common.hs @@ -50,8 +50,8 @@ data BrightnessControls = BrightnessControls , bctlDec :: FeatureIO } -brightnessControls :: BrightnessConfig a b -> BrightnessControls -brightnessControls bc = +brightnessControls :: BrightnessConfig a b -> Client -> BrightnessControls +brightnessControls bc client = BrightnessControls { bctlMax = cb "max brightness" memMax , bctlMin = cb "min brightness" memMin @@ -59,12 +59,12 @@ brightnessControls bc = , bctlDec = cb "decrease brightness" memDec } where - cb = callBacklight bc + cb = callBacklight client bc -- TODO not dry -callGetBrightness :: Num c => BrightnessConfig a b -> IO (Maybe c) -callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } = do - reply <- callMethod xmonadBus p i memGet +callGetBrightness :: Num c => BrightnessConfig a b -> Client -> IO (Maybe c) +callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } client = do + reply <- callMethod client xmonadBusName p i memGet return $ either (const Nothing) bodyGetBrightness reply signalDep :: BrightnessConfig a b -> Dependency @@ -131,10 +131,10 @@ emitBrightness BrightnessConfig{ bcPath = p, bcInterface = i } client cur = where sig = signal p i memCur -callBacklight :: BrightnessConfig a b -> String -> MemberName -> FeatureIO -callBacklight BrightnessConfig { bcPath = p, bcInterface = i, bcName = n } controlName m = +callBacklight :: Client -> BrightnessConfig a b -> String -> MemberName -> FeatureIO +callBacklight client BrightnessConfig { bcPath = p, bcInterface = i, bcName = n } controlName m = Feature - { ftrMaybeAction = void $ callMethod xmonadBus p i m + { ftrMaybeAction = void $ callMethod client xmonadBusName p i m , ftrName = unwords [n, controlName] , ftrWarning = Default , ftrChildren = [xDbusDep p i $ Method_ m] diff --git a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs index 29f5a32..aad4d6c 100644 --- a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs +++ b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs @@ -102,10 +102,10 @@ exportIntelBacklight :: Client -> FeatureIO exportIntelBacklight = brightnessExporter [curFileDep, maxFileDep] intelBacklightConfig -intelBacklightControls :: BrightnessControls +intelBacklightControls :: Client -> BrightnessControls intelBacklightControls = brightnessControls intelBacklightConfig -callGetBrightnessIB :: IO (Maybe Brightness) +callGetBrightnessIB :: Client -> IO (Maybe Brightness) callGetBrightnessIB = callGetBrightness intelBacklightConfig matchSignalIB :: (Maybe Brightness -> IO ()) -> IO SignalHandler diff --git a/lib/XMonad/Internal/DBus/Screensaver.hs b/lib/XMonad/Internal/DBus/Screensaver.hs index 67c6dbd..5d6371c 100644 --- a/lib/XMonad/Internal/DBus/Screensaver.hs +++ b/lib/XMonad/Internal/DBus/Screensaver.hs @@ -120,19 +120,19 @@ exportScreensaver client = Feature ] } -callToggle :: FeatureIO -callToggle = Feature +callToggle :: Client -> FeatureIO +callToggle client = Feature { ftrMaybeAction = cmd , ftrName = "screensaver toggle" , ftrWarning = Default , ftrChildren = [xDbusDep ssPath interface $ Method_ memToggle] } where - cmd = void $ callMethod xmonadBus ssPath interface memToggle + cmd = void $ callMethod client xmonadBusName ssPath interface memToggle -callQuery :: IO (Maybe SSState) -callQuery = do - reply <- callMethod xmonadBus ssPath interface memQuery +callQuery :: Client -> IO (Maybe SSState) +callQuery client = do + reply <- callMethod client xmonadBusName ssPath interface memQuery -- return $ reply >>= bodyGetCurrentState return $ either (const Nothing) bodyGetCurrentState reply diff --git a/lib/XMonad/Internal/Dependency.hs b/lib/XMonad/Internal/Dependency.hs index 40a99ac..7311259 100644 --- a/lib/XMonad/Internal/Dependency.hs +++ b/lib/XMonad/Internal/Dependency.hs @@ -245,17 +245,18 @@ introspectMethod :: MemberName introspectMethod = memberName_ "Introspect" -- TODO this belongs somewhere else, IDK where tho for now -callMethod :: Bus -> ObjectPath -> InterfaceName -> MemberName -> IO (Either String [Variant]) -callMethod (Bus usesys bus) path iface mem = do - client <- if usesys then connectSystem else connectSession +callMethod :: Client -> BusName -> ObjectPath -> InterfaceName -> MemberName + -> IO (Either String [Variant]) +callMethod client bus path iface mem = do reply <- call client (methodCall path iface mem) { methodCallDestination = Just bus } - disconnect client return $ bimap methodErrorMessage methodReturnBody reply busSatisfied :: Bus -> IO (Maybe String) busSatisfied (Bus usesystem bus) = do - ret <- callMethod (Bus usesystem queryBus) queryPath queryIface queryMem + client <- if usesystem then connectSystem else connectSession + ret <- callMethod client queryBus queryPath queryIface queryMem + disconnect client return $ case ret of Left e -> Just e Right b -> let ns = bodyGetNames b in @@ -271,8 +272,10 @@ busSatisfied (Bus usesystem bus) = do bodyGetNames _ = [] endpointSatisfied :: Bus -> Endpoint -> IO (Maybe String) -endpointSatisfied b@(Bus _ bus) (Endpoint objpath iface mem) = do - ret <- callMethod b objpath introspectInterface introspectMethod +endpointSatisfied (Bus u bus) (Endpoint objpath iface mem) = do + client <- if u then connectSystem else connectSession + ret <- callMethod client bus objpath introspectInterface introspectMethod + disconnect client return $ case ret of Left e -> Just e Right body -> procBody body diff --git a/lib/Xmobar/Plugins/ClevoKeyboard.hs b/lib/Xmobar/Plugins/ClevoKeyboard.hs index 7b59f2b..56ab64a 100644 --- a/lib/Xmobar/Plugins/ClevoKeyboard.hs +++ b/lib/Xmobar/Plugins/ClevoKeyboard.hs @@ -14,12 +14,13 @@ module Xmobar.Plugins.ClevoKeyboard import Control.Concurrent import Control.Monad +import DBus.Client + import Xmobar import XMonad.Internal.DBus.Brightness.ClevoKeyboard -data ClevoKeyboard = ClevoKeyboard String - deriving (Read, Show) +newtype ClevoKeyboard = ClevoKeyboard String deriving (Read, Show) ckAlias :: String ckAlias = "clevokeyboard" @@ -28,7 +29,9 @@ instance Exec ClevoKeyboard where alias (ClevoKeyboard _) = ckAlias start (ClevoKeyboard icon) cb = do _ <- matchSignalCK $ cb . formatBrightness - cb . formatBrightness =<< callGetBrightnessCK + -- TODO this could fail, and also should try to reuse client objects when + -- possible + cb . formatBrightness =<< callGetBrightnessCK =<< connectSession forever (threadDelay 5000000) where formatBrightness = \case diff --git a/lib/Xmobar/Plugins/IntelBacklight.hs b/lib/Xmobar/Plugins/IntelBacklight.hs index aef6dbf..750aa7a 100644 --- a/lib/Xmobar/Plugins/IntelBacklight.hs +++ b/lib/Xmobar/Plugins/IntelBacklight.hs @@ -14,6 +14,8 @@ module Xmobar.Plugins.IntelBacklight import Control.Concurrent import Control.Monad +import DBus.Client + import Xmobar import XMonad.Internal.DBus.Brightness.IntelBacklight @@ -27,7 +29,7 @@ instance Exec IntelBacklight where alias (IntelBacklight _) = blAlias start (IntelBacklight icon) cb = do _ <- matchSignalIB $ cb . formatBrightness - cb . formatBrightness =<< callGetBrightnessIB + cb . formatBrightness =<< callGetBrightnessIB =<< connectSession forever (threadDelay 5000000) where formatBrightness = \case diff --git a/lib/Xmobar/Plugins/Screensaver.hs b/lib/Xmobar/Plugins/Screensaver.hs index 5025ba8..48774e3 100644 --- a/lib/Xmobar/Plugins/Screensaver.hs +++ b/lib/Xmobar/Plugins/Screensaver.hs @@ -14,13 +14,14 @@ module Xmobar.Plugins.Screensaver import Control.Concurrent import Control.Monad +import DBus.Client + import Xmobar import XMonad.Hooks.DynamicLog (xmobarColor) import XMonad.Internal.DBus.Screensaver -newtype Screensaver = Screensaver (String, String, String) - deriving (Read, Show) +newtype Screensaver = Screensaver (String, String, String) deriving (Read, Show) ssAlias :: String ssAlias = "screensaver" @@ -29,7 +30,7 @@ instance Exec Screensaver where alias (Screensaver _) = ssAlias start (Screensaver (text, colorOn, colorOff)) cb = do _ <- matchSignal $ cb . fmtState - cb . fmtState =<< callQuery + cb . fmtState =<< callQuery =<< connectSession forever (threadDelay 5000000) where fmtState = \case