REF consolidate method call functions
This commit is contained in:
parent
da1e4a1c79
commit
81543cbbbc
|
@ -61,10 +61,11 @@ brightnessControls bc =
|
|||
where
|
||||
cb = callBacklight bc
|
||||
|
||||
-- TODO not dry
|
||||
callGetBrightness :: Num c => BrightnessConfig a b -> IO (Maybe c)
|
||||
callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } = do
|
||||
reply <- callMethod $ methodCall p i memGet
|
||||
return $ reply >>= bodyGetBrightness
|
||||
reply <- callMethod xmonadBus p i memGet
|
||||
return $ either (const Nothing) bodyGetBrightness reply
|
||||
|
||||
signalDep :: BrightnessConfig a b -> Dependency
|
||||
signalDep BrightnessConfig { bcPath = p, bcInterface = i } =
|
||||
|
@ -133,7 +134,7 @@ emitBrightness BrightnessConfig{ bcPath = p, bcInterface = i } client cur =
|
|||
callBacklight :: BrightnessConfig a b -> String -> MemberName -> FeatureIO
|
||||
callBacklight BrightnessConfig { bcPath = p, bcInterface = i, bcName = n } controlName m =
|
||||
Feature
|
||||
{ ftrMaybeAction = void $ callMethod $ methodCall p i m
|
||||
{ ftrMaybeAction = void $ callMethod xmonadBus p i m
|
||||
, ftrName = unwords [n, controlName]
|
||||
, ftrWarning = Default
|
||||
, ftrChildren = [xDbusDep p i $ Method_ m]
|
||||
|
|
|
@ -2,9 +2,9 @@
|
|||
-- | Common internal DBus functions
|
||||
|
||||
module XMonad.Internal.DBus.Common
|
||||
( callMethod
|
||||
, callMethod'
|
||||
, addMatchCallback
|
||||
-- ( callMethod
|
||||
-- , callMethod'
|
||||
( addMatchCallback
|
||||
, xmonadBus
|
||||
, xmonadBusName
|
||||
, xDbusDep
|
||||
|
@ -25,36 +25,25 @@ xmonadBus = Bus False xmonadBusName
|
|||
xDbusDep :: ObjectPath -> InterfaceName -> DBusMember -> Dependency
|
||||
xDbusDep o i m = DBusEndpoint xmonadBus $ Endpoint o i m
|
||||
|
||||
-- connectBus :: Bus -> IO (Maybe Client)
|
||||
-- -- | Call a method and return its result if successful
|
||||
-- callMethod :: MethodCall -> IO (Maybe [Variant])
|
||||
-- callMethod mc = do
|
||||
-- client <- connectSession
|
||||
-- r <- callMethod' client (Just xmonadBusName) mc
|
||||
-- disconnect client
|
||||
-- return r
|
||||
|
||||
-- | Call a method and return its result if successful
|
||||
callMethod :: MethodCall -> IO (Maybe [Variant])
|
||||
callMethod mc = do
|
||||
client <- connectSession
|
||||
r <- callMethod' client (Just xmonadBusName) mc
|
||||
disconnect client
|
||||
return r
|
||||
|
||||
callMethod' :: Client -> Maybe BusName -> MethodCall -> IO (Maybe [Variant])
|
||||
callMethod' client bn mc = do
|
||||
-- TODO handle clienterrors here
|
||||
reply <- call client mc { methodCallDestination = bn }
|
||||
-- TODO not all methods warrant that we wait for a reply? (see callNoReply)
|
||||
return $ case reply of
|
||||
Left _ -> Nothing
|
||||
Right ret -> Just $ methodReturnBody ret
|
||||
-- callMethod' :: Client -> Maybe BusName -> MethodCall -> IO (Maybe [Variant])
|
||||
-- callMethod' client bn mc = do
|
||||
-- -- TODO handle clienterrors here
|
||||
-- reply <- call client mc { methodCallDestination = bn }
|
||||
-- -- TODO not all methods warrant that we wait for a reply? (see callNoReply)
|
||||
-- return $ case reply of
|
||||
-- Left _ -> Nothing
|
||||
-- Right ret -> Just $ methodReturnBody ret
|
||||
|
||||
-- | Bind a callback to a signal match rule
|
||||
addMatchCallback :: MatchRule -> ([Variant] -> IO ()) -> IO SignalHandler
|
||||
addMatchCallback rule cb = do
|
||||
client <- connectSession
|
||||
addMatch client rule $ cb . signalBody
|
||||
|
||||
-- initControls :: Client -> (Client -> FeatureIO) -> (FeatureIO -> a) -> IO a
|
||||
-- initControls client exporter controls = do
|
||||
-- let x = exporter client
|
||||
-- e <- evalFeature x
|
||||
-- case e of
|
||||
-- (Right c) -> c
|
||||
-- _ -> return ()
|
||||
-- return $ controls x
|
||||
|
|
|
@ -128,12 +128,13 @@ callToggle = Feature
|
|||
, ftrChildren = [xDbusDep ssPath interface $ Method_ memToggle]
|
||||
}
|
||||
where
|
||||
cmd = void $ callMethod $ methodCall ssPath interface memToggle
|
||||
cmd = void $ callMethod xmonadBus ssPath interface memToggle
|
||||
|
||||
callQuery :: IO (Maybe SSState)
|
||||
callQuery = do
|
||||
reply <- callMethod $ methodCall ssPath interface memQuery
|
||||
return $ reply >>= bodyGetCurrentState
|
||||
reply <- callMethod xmonadBus ssPath interface memQuery
|
||||
-- return $ reply >>= bodyGetCurrentState
|
||||
return $ either (const Nothing) bodyGetCurrentState reply
|
||||
|
||||
matchSignal :: (Maybe SSState -> IO ()) -> IO SignalHandler
|
||||
matchSignal cb = addMatchCallback ruleCurrentState $ cb . bodyGetCurrentState
|
||||
|
|
|
@ -30,6 +30,7 @@ module XMonad.Internal.Dependency
|
|||
, executeFeature_
|
||||
, applyFeature
|
||||
, applyFeature_
|
||||
, callMethod
|
||||
) where
|
||||
|
||||
import Control.Monad.IO.Class
|
||||
|
@ -243,6 +244,7 @@ introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
|
|||
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
|
||||
|
|
Loading…
Reference in New Issue