ENH reuse client when possible

This commit is contained in:
Nathan Dwarshuis 2021-11-21 17:54:00 -05:00
parent 81543cbbbc
commit be73dd64d3
10 changed files with 68 additions and 45 deletions

View File

@ -39,6 +39,7 @@ import XMonad.Hooks.DynamicLog
, xmobarColor , xmobarColor
) )
import XMonad.Internal.Command.Power (hasBattery) import XMonad.Internal.Command.Power (hasBattery)
import XMonad.Internal.DBus.Brightness.ClevoKeyboard
import XMonad.Internal.DBus.Brightness.IntelBacklight import XMonad.Internal.DBus.Brightness.IntelBacklight
import XMonad.Internal.Shell import XMonad.Internal.Shell
-- import XMonad.Internal.DBus.Common (xmonadBus) -- import XMonad.Internal.DBus.Common (xmonadBus)
@ -273,7 +274,7 @@ rightPlugins =
, evalFeature getAlsa , evalFeature getAlsa
, evalFeature getBattery , evalFeature getBattery
, evalFeature getBl , evalFeature getBl
, nocheck ckCmd , evalFeature getCk
, evalFeature getSs , evalFeature getSs
, nocheck lockCmd , nocheck lockCmd
, nocheck dateCmd , nocheck dateCmd
@ -340,6 +341,14 @@ getBl = Feature
, ftrChildren = [intelBacklightSignalDep] , ftrChildren = [intelBacklightSignalDep]
} }
getCk :: BarFeature
getCk = Feature
{ ftrMaybeAction = ckCmd
, ftrName = "Clevo keyboard indicator"
, ftrWarning = Default
, ftrChildren = [clevoKeyboardSignalDep]
}
getSs :: BarFeature getSs :: BarFeature
getSs = Feature getSs = Feature
{ ftrMaybeAction = ssCmd { ftrMaybeAction = ssCmd

View File

@ -549,14 +549,14 @@ externalBindings ts lock =
] ]
, KeyGroup "System" , 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-<End>" "power menu" $ ConstFeature $ runPowerPrompt lock
, KeyBinding "M-<Home>" "quit xmonad" $ ConstFeature runQuitPrompt , KeyBinding "M-<Home>" "quit xmonad" $ ConstFeature runQuitPrompt
, KeyBinding "M-<Delete>" "lock screen" runScreenLock , KeyBinding "M-<Delete>" "lock screen" runScreenLock
@ -568,7 +568,12 @@ externalBindings ts lock =
, KeyBinding "M-<F8>" "select autorandr profile" runAutorandrMenu , KeyBinding "M-<F8>" "select autorandr profile" runAutorandrMenu
, KeyBinding "M-<F9>" "toggle ethernet" runToggleEthernet , KeyBinding "M-<F9>" "toggle ethernet" runToggleEthernet
, KeyBinding "M-<F10>" "toggle bluetooth" runToggleBluetooth , 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 , 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

View File

@ -120,10 +120,10 @@ exportClevoKeyboard :: Client -> FeatureIO
exportClevoKeyboard = exportClevoKeyboard =
brightnessExporter [stateFileDep, brightnessFileDep] clevoKeyboardConfig brightnessExporter [stateFileDep, brightnessFileDep] clevoKeyboardConfig
clevoKeyboardControls :: BrightnessControls clevoKeyboardControls :: Client -> BrightnessControls
clevoKeyboardControls = brightnessControls clevoKeyboardConfig clevoKeyboardControls = brightnessControls clevoKeyboardConfig
callGetBrightnessCK :: IO (Maybe Brightness) callGetBrightnessCK :: Client -> IO (Maybe Brightness)
callGetBrightnessCK = callGetBrightness clevoKeyboardConfig callGetBrightnessCK = callGetBrightness clevoKeyboardConfig
matchSignalCK :: (Maybe Brightness -> IO ()) -> IO SignalHandler matchSignalCK :: (Maybe Brightness -> IO ()) -> IO SignalHandler

View File

@ -50,8 +50,8 @@ data BrightnessControls = BrightnessControls
, bctlDec :: FeatureIO , bctlDec :: FeatureIO
} }
brightnessControls :: BrightnessConfig a b -> BrightnessControls brightnessControls :: BrightnessConfig a b -> Client -> BrightnessControls
brightnessControls bc = brightnessControls bc client =
BrightnessControls BrightnessControls
{ bctlMax = cb "max brightness" memMax { bctlMax = cb "max brightness" memMax
, bctlMin = cb "min brightness" memMin , bctlMin = cb "min brightness" memMin
@ -59,12 +59,12 @@ brightnessControls bc =
, bctlDec = cb "decrease brightness" memDec , bctlDec = cb "decrease brightness" memDec
} }
where where
cb = callBacklight bc cb = callBacklight client bc
-- TODO not dry -- 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 return $ either (const Nothing) bodyGetBrightness reply
signalDep :: BrightnessConfig a b -> Dependency signalDep :: BrightnessConfig a b -> Dependency
@ -131,10 +131,10 @@ emitBrightness BrightnessConfig{ bcPath = p, bcInterface = i } client cur =
where where
sig = signal p i memCur 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 Feature
{ ftrMaybeAction = void $ callMethod xmonadBus p i m { ftrMaybeAction = void $ callMethod client xmonadBusName p i m
, ftrName = unwords [n, controlName] , ftrName = unwords [n, controlName]
, ftrWarning = Default , ftrWarning = Default
, ftrChildren = [xDbusDep p i $ Method_ m] , ftrChildren = [xDbusDep p i $ Method_ m]

View File

@ -102,10 +102,10 @@ exportIntelBacklight :: Client -> FeatureIO
exportIntelBacklight = exportIntelBacklight =
brightnessExporter [curFileDep, maxFileDep] intelBacklightConfig brightnessExporter [curFileDep, maxFileDep] intelBacklightConfig
intelBacklightControls :: BrightnessControls intelBacklightControls :: Client -> BrightnessControls
intelBacklightControls = brightnessControls intelBacklightConfig intelBacklightControls = brightnessControls intelBacklightConfig
callGetBrightnessIB :: IO (Maybe Brightness) callGetBrightnessIB :: Client -> IO (Maybe Brightness)
callGetBrightnessIB = callGetBrightness intelBacklightConfig callGetBrightnessIB = callGetBrightness intelBacklightConfig
matchSignalIB :: (Maybe Brightness -> IO ()) -> IO SignalHandler matchSignalIB :: (Maybe Brightness -> IO ()) -> IO SignalHandler

View File

@ -120,19 +120,19 @@ exportScreensaver client = Feature
] ]
} }
callToggle :: FeatureIO callToggle :: Client -> FeatureIO
callToggle = Feature callToggle client = Feature
{ ftrMaybeAction = cmd { ftrMaybeAction = cmd
, ftrName = "screensaver toggle" , ftrName = "screensaver toggle"
, ftrWarning = Default , ftrWarning = Default
, ftrChildren = [xDbusDep ssPath interface $ Method_ memToggle] , ftrChildren = [xDbusDep ssPath interface $ Method_ memToggle]
} }
where 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 $ reply >>= bodyGetCurrentState
return $ either (const Nothing) bodyGetCurrentState reply return $ either (const Nothing) bodyGetCurrentState reply

View File

@ -245,17 +245,18 @@ introspectMethod :: MemberName
introspectMethod = memberName_ "Introspect" introspectMethod = memberName_ "Introspect"
-- TODO this belongs somewhere else, IDK where tho for now -- 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) reply <- call client (methodCall path iface mem)
{ methodCallDestination = Just bus } { methodCallDestination = Just bus }
disconnect client
return $ bimap methodErrorMessage methodReturnBody reply return $ bimap methodErrorMessage methodReturnBody reply
busSatisfied :: Bus -> IO (Maybe String) busSatisfied :: Bus -> IO (Maybe String)
busSatisfied (Bus usesystem bus) = do 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 return $ case ret of
Left e -> Just e Left e -> Just e
Right b -> let ns = bodyGetNames b in Right b -> let ns = bodyGetNames b in
@ -271,8 +272,10 @@ busSatisfied (Bus usesystem bus) = do
bodyGetNames _ = [] bodyGetNames _ = []
endpointSatisfied :: Bus -> Endpoint -> IO (Maybe String) 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 return $ case ret of
Left e -> Just e Left e -> Just e
Right body -> procBody body Right body -> procBody body

View File

@ -14,12 +14,13 @@ module Xmobar.Plugins.ClevoKeyboard
import Control.Concurrent import Control.Concurrent
import Control.Monad import Control.Monad
import DBus.Client
import Xmobar import Xmobar
import XMonad.Internal.DBus.Brightness.ClevoKeyboard import XMonad.Internal.DBus.Brightness.ClevoKeyboard
data ClevoKeyboard = ClevoKeyboard String newtype ClevoKeyboard = ClevoKeyboard String deriving (Read, Show)
deriving (Read, Show)
ckAlias :: String ckAlias :: String
ckAlias = "clevokeyboard" ckAlias = "clevokeyboard"
@ -28,7 +29,9 @@ instance Exec ClevoKeyboard where
alias (ClevoKeyboard _) = ckAlias alias (ClevoKeyboard _) = ckAlias
start (ClevoKeyboard icon) cb = do start (ClevoKeyboard icon) cb = do
_ <- matchSignalCK $ cb . formatBrightness _ <- 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) forever (threadDelay 5000000)
where where
formatBrightness = \case formatBrightness = \case

View File

@ -14,6 +14,8 @@ module Xmobar.Plugins.IntelBacklight
import Control.Concurrent import Control.Concurrent
import Control.Monad import Control.Monad
import DBus.Client
import Xmobar import Xmobar
import XMonad.Internal.DBus.Brightness.IntelBacklight import XMonad.Internal.DBus.Brightness.IntelBacklight
@ -27,7 +29,7 @@ instance Exec IntelBacklight where
alias (IntelBacklight _) = blAlias alias (IntelBacklight _) = blAlias
start (IntelBacklight icon) cb = do start (IntelBacklight icon) cb = do
_ <- matchSignalIB $ cb . formatBrightness _ <- matchSignalIB $ cb . formatBrightness
cb . formatBrightness =<< callGetBrightnessIB cb . formatBrightness =<< callGetBrightnessIB =<< connectSession
forever (threadDelay 5000000) forever (threadDelay 5000000)
where where
formatBrightness = \case formatBrightness = \case

View File

@ -14,13 +14,14 @@ module Xmobar.Plugins.Screensaver
import Control.Concurrent import Control.Concurrent
import Control.Monad import Control.Monad
import DBus.Client
import Xmobar import Xmobar
import XMonad.Hooks.DynamicLog (xmobarColor) import XMonad.Hooks.DynamicLog (xmobarColor)
import XMonad.Internal.DBus.Screensaver 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 :: String
ssAlias = "screensaver" ssAlias = "screensaver"
@ -29,7 +30,7 @@ instance Exec Screensaver where
alias (Screensaver _) = ssAlias alias (Screensaver _) = ssAlias
start (Screensaver (text, colorOn, colorOff)) cb = do start (Screensaver (text, colorOn, colorOff)) cb = do
_ <- matchSignal $ cb . fmtState _ <- matchSignal $ cb . fmtState
cb . fmtState =<< callQuery cb . fmtState =<< callQuery =<< connectSession
forever (threadDelay 5000000) forever (threadDelay 5000000)
where where
fmtState = \case fmtState = \case