REF consolidate method call functions
This commit is contained in:
parent
da1e4a1c79
commit
81543cbbbc
|
@ -61,10 +61,11 @@ brightnessControls bc =
|
||||||
where
|
where
|
||||||
cb = callBacklight bc
|
cb = callBacklight bc
|
||||||
|
|
||||||
|
-- TODO not dry
|
||||||
callGetBrightness :: Num c => BrightnessConfig a b -> IO (Maybe c)
|
callGetBrightness :: Num c => BrightnessConfig a b -> IO (Maybe c)
|
||||||
callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } = do
|
callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } = do
|
||||||
reply <- callMethod $ methodCall p i memGet
|
reply <- callMethod xmonadBus p i memGet
|
||||||
return $ reply >>= bodyGetBrightness
|
return $ either (const Nothing) bodyGetBrightness reply
|
||||||
|
|
||||||
signalDep :: BrightnessConfig a b -> Dependency
|
signalDep :: BrightnessConfig a b -> Dependency
|
||||||
signalDep BrightnessConfig { bcPath = p, bcInterface = i } =
|
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 a b -> String -> MemberName -> FeatureIO
|
||||||
callBacklight BrightnessConfig { bcPath = p, bcInterface = i, bcName = n } controlName m =
|
callBacklight BrightnessConfig { bcPath = p, bcInterface = i, bcName = n } controlName m =
|
||||||
Feature
|
Feature
|
||||||
{ ftrMaybeAction = void $ callMethod $ methodCall p i m
|
{ ftrMaybeAction = void $ callMethod xmonadBus 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]
|
||||||
|
|
|
@ -2,9 +2,9 @@
|
||||||
-- | Common internal DBus functions
|
-- | Common internal DBus functions
|
||||||
|
|
||||||
module XMonad.Internal.DBus.Common
|
module XMonad.Internal.DBus.Common
|
||||||
( callMethod
|
-- ( callMethod
|
||||||
, callMethod'
|
-- , callMethod'
|
||||||
, addMatchCallback
|
( addMatchCallback
|
||||||
, xmonadBus
|
, xmonadBus
|
||||||
, xmonadBusName
|
, xmonadBusName
|
||||||
, xDbusDep
|
, xDbusDep
|
||||||
|
@ -25,36 +25,25 @@ xmonadBus = Bus False xmonadBusName
|
||||||
xDbusDep :: ObjectPath -> InterfaceName -> DBusMember -> Dependency
|
xDbusDep :: ObjectPath -> InterfaceName -> DBusMember -> Dependency
|
||||||
xDbusDep o i m = DBusEndpoint xmonadBus $ Endpoint o i m
|
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' :: Client -> Maybe BusName -> MethodCall -> IO (Maybe [Variant])
|
||||||
callMethod :: MethodCall -> IO (Maybe [Variant])
|
-- callMethod' client bn mc = do
|
||||||
callMethod mc = do
|
-- -- TODO handle clienterrors here
|
||||||
client <- connectSession
|
-- reply <- call client mc { methodCallDestination = bn }
|
||||||
r <- callMethod' client (Just xmonadBusName) mc
|
-- -- TODO not all methods warrant that we wait for a reply? (see callNoReply)
|
||||||
disconnect client
|
-- return $ case reply of
|
||||||
return r
|
-- 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
|
-- | Bind a callback to a signal match rule
|
||||||
addMatchCallback :: MatchRule -> ([Variant] -> IO ()) -> IO SignalHandler
|
addMatchCallback :: MatchRule -> ([Variant] -> IO ()) -> IO SignalHandler
|
||||||
addMatchCallback rule cb = do
|
addMatchCallback rule cb = do
|
||||||
client <- connectSession
|
client <- connectSession
|
||||||
addMatch client rule $ cb . signalBody
|
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]
|
, ftrChildren = [xDbusDep ssPath interface $ Method_ memToggle]
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
cmd = void $ callMethod $ methodCall ssPath interface memToggle
|
cmd = void $ callMethod xmonadBus ssPath interface memToggle
|
||||||
|
|
||||||
callQuery :: IO (Maybe SSState)
|
callQuery :: IO (Maybe SSState)
|
||||||
callQuery = do
|
callQuery = do
|
||||||
reply <- callMethod $ methodCall ssPath interface memQuery
|
reply <- callMethod xmonadBus ssPath interface memQuery
|
||||||
return $ reply >>= bodyGetCurrentState
|
-- return $ reply >>= bodyGetCurrentState
|
||||||
|
return $ either (const Nothing) bodyGetCurrentState reply
|
||||||
|
|
||||||
matchSignal :: (Maybe SSState -> IO ()) -> IO SignalHandler
|
matchSignal :: (Maybe SSState -> IO ()) -> IO SignalHandler
|
||||||
matchSignal cb = addMatchCallback ruleCurrentState $ cb . bodyGetCurrentState
|
matchSignal cb = addMatchCallback ruleCurrentState $ cb . bodyGetCurrentState
|
||||||
|
|
|
@ -30,6 +30,7 @@ module XMonad.Internal.Dependency
|
||||||
, executeFeature_
|
, executeFeature_
|
||||||
, applyFeature
|
, applyFeature
|
||||||
, applyFeature_
|
, applyFeature_
|
||||||
|
, callMethod
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
|
@ -243,6 +244,7 @@ introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
|
||||||
introspectMethod :: MemberName
|
introspectMethod :: MemberName
|
||||||
introspectMethod = memberName_ "Introspect"
|
introspectMethod = memberName_ "Introspect"
|
||||||
|
|
||||||
|
-- TODO this belongs somewhere else, IDK where tho for now
|
||||||
callMethod :: Bus -> ObjectPath -> InterfaceName -> MemberName -> IO (Either String [Variant])
|
callMethod :: Bus -> ObjectPath -> InterfaceName -> MemberName -> IO (Either String [Variant])
|
||||||
callMethod (Bus usesys bus) path iface mem = do
|
callMethod (Bus usesys bus) path iface mem = do
|
||||||
client <- if usesys then connectSystem else connectSession
|
client <- if usesys then connectSystem else connectSession
|
||||||
|
|
Loading…
Reference in New Issue