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
)
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

View File

@ -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-<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

View File

@ -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

View File

@ -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]

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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