ENH reuse client when possible
This commit is contained in:
parent
81543cbbbc
commit
be73dd64d3
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue