REF consolidate method call functions

This commit is contained in:
Nathan Dwarshuis 2021-11-21 16:58:01 -05:00
parent da1e4a1c79
commit 81543cbbbc
4 changed files with 28 additions and 35 deletions

View File

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

View File

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

View File

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

View File

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