ENH reuse client when possible

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

bin/xmonad.hs

@@ -468,8 +468,8 @@ mkNamedSubmap c KeyGroup { kgHeader = h, kgBindings = b } =
   <$> b
 
 data KeyBinding a = KeyBinding
-  { kbSyms   :: String
+  { kbSyms        :: String
-  , kbDesc   :: String
+  , kbDesc        :: String
   , kbMaybeAction :: a
   }
 
@@ -549,14 +549,14 @@ externalBindings ts lock =
     ]
 
   , KeyGroup "System"
-    [ KeyBinding "M-." "backlight up" $ ioFeature $ bctlInc intelBacklightControls
+    [ KeyBinding "M-." "backlight up" $ ib bctlInc
-    , KeyBinding "M-," "backlight down" $ ioFeature $ bctlDec intelBacklightControls
+    , KeyBinding "M-," "backlight down" $ ib bctlDec
-    , KeyBinding "M-M1-," "backlight min" $ ioFeature $ bctlMin intelBacklightControls
+    , KeyBinding "M-M1-," "backlight min" $ ib bctlMin
-    , KeyBinding "M-M1-." "backlight max" $ ioFeature $ bctlMax intelBacklightControls
+    , KeyBinding "M-M1-." "backlight max" $ ib bctlMax
-    , KeyBinding "M-S-." "keyboard up" $ ioFeature $ bctlInc clevoKeyboardControls
+    , KeyBinding "M-S-." "keyboard up" $ ck bctlInc
-    , KeyBinding "M-S-," "keyboard down" $ ioFeature $ bctlDec clevoKeyboardControls
+    , KeyBinding "M-S-," "keyboard down" $ ck bctlDec
-    , KeyBinding "M-S-M1-," "keyboard min" $ ioFeature $ bctlMin clevoKeyboardControls
+    , KeyBinding "M-S-M1-," "keyboard min" $ ck bctlMin
-    , KeyBinding "M-S-M1-." "keyboard max" $ ioFeature $ bctlMax clevoKeyboardControls
+    , KeyBinding "M-S-M1-." "keyboard max" $ ck bctlMax
     , KeyBinding "M-<End>" "power menu" $ ConstFeature $ runPowerPrompt lock
     , KeyBinding "M-<Home>" "quit xmonad" $ ConstFeature runQuitPrompt
     , KeyBinding "M-<Delete>" "lock screen" runScreenLock
@@ -568,7 +568,12 @@ externalBindings ts lock =
     , KeyBinding "M-<F8>" "select autorandr profile" runAutorandrMenu
     , KeyBinding "M-<F9>" "toggle ethernet" runToggleEthernet
     , KeyBinding "M-<F10>" "toggle bluetooth" runToggleBluetooth
-    , KeyBinding "M-<F11>" "toggle screensaver" $ ioFeature callToggle
+    , KeyBinding "M-<F11>" "toggle screensaver" $ maybe BlankFeature (ioFeature . callToggle) cl
     , KeyBinding "M-<F12>" "switch gpu" runOptimusPrompt
     ]
   ]
+  where
+    cl = tsClient ts
+    brightessControls ctl getter = maybe BlankFeature (ioFeature . getter . ctl) cl
+    ib = brightessControls intelBacklightControls
+    ck = brightessControls clevoKeyboardControls

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

lib/XMonad/Internal/DBus/Brightness/Common.hs

@@ -50,8 +50,8 @@ data BrightnessControls = BrightnessControls
   , bctlDec :: FeatureIO
   }
 
-brightnessControls :: BrightnessConfig a b -> BrightnessControls
+brightnessControls :: BrightnessConfig a b -> Client -> BrightnessControls
-brightnessControls bc =
+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 :: Num c => BrightnessConfig a b -> Client -> IO (Maybe c)
-callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } = do
+callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } client = do
-  reply <- callMethod xmonadBus p i memGet
+  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 :: Client -> BrightnessConfig a b -> String -> MemberName -> FeatureIO
-callBacklight BrightnessConfig { bcPath = p, bcInterface = i, bcName = n } controlName m =
+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]

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

lib/XMonad/Internal/DBus/Screensaver.hs

@@ -120,19 +120,19 @@ exportScreensaver client = Feature
         ]
       }
 
-callToggle :: FeatureIO
+callToggle :: Client -> FeatureIO
-callToggle = Feature
+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 :: Client -> IO (Maybe SSState)
-callQuery = do
+callQuery client = do
-  reply <- callMethod xmonadBus ssPath interface memQuery
+  reply <- callMethod client xmonadBusName ssPath interface memQuery
   -- return $ reply >>= bodyGetCurrentState
   return $ either (const Nothing) bodyGetCurrentState reply
 

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 :: Client -> BusName -> ObjectPath -> InterfaceName -> MemberName
-callMethod (Bus usesys bus) path iface mem = do
+  -> IO (Either String [Variant])
-  client <- if usesys then connectSystem else connectSession
+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
+endpointSatisfied (Bus u bus) (Endpoint objpath iface mem) = do
-  ret <- callMethod b objpath introspectInterface introspectMethod
+  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

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
+newtype ClevoKeyboard = ClevoKeyboard String deriving (Read, Show)
-  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

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

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)
+newtype Screensaver = Screensaver (String, String, String) deriving (Read, Show)
-    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