REF use function to abstract dbus endpoint dependencies

This commit is contained in:
Nathan Dwarshuis 2021-11-21 18:18:09 -05:00
parent be73dd64d3
commit 7e5a4a57cd
3 changed files with 34 additions and 16 deletions

View File

@ -11,7 +11,7 @@ module XMonad.Internal.DBus.Brightness.Common
, signalDep , signalDep
) where ) where
import Control.Monad (void) -- import Control.Monad (void)
import Data.Int (Int32) import Data.Int (Int32)
@ -133,12 +133,14 @@ emitBrightness BrightnessConfig{ bcPath = p, bcInterface = i } client cur =
callBacklight :: Client -> BrightnessConfig a b -> String -> MemberName -> FeatureIO callBacklight :: Client -> BrightnessConfig a b -> String -> MemberName -> FeatureIO
callBacklight client BrightnessConfig { bcPath = p, bcInterface = i, bcName = n } controlName m = callBacklight client BrightnessConfig { bcPath = p, bcInterface = i, bcName = n } controlName m =
Feature (featureEndpoint xmonadBusName p i m client)
{ ftrMaybeAction = void $ callMethod client xmonadBusName p i m { ftrName = unwords [n, controlName] }
, ftrName = unwords [n, controlName] -- Feature
, ftrWarning = Default -- { ftrMaybeAction = void $ callMethod client xmonadBusName p i m
, ftrChildren = [xDbusDep p i $ Method_ m] -- , ftrName = unwords [n, controlName]
} -- , ftrWarning = Default
-- , ftrChildren = [xDbusDep p i $ Method_ m]
-- }
bodyGetBrightness :: Num a => [Variant] -> Maybe a bodyGetBrightness :: Num a => [Variant] -> Maybe a
bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32) bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)

View File

@ -121,19 +121,21 @@ exportScreensaver client = Feature
} }
callToggle :: Client -> FeatureIO callToggle :: Client -> FeatureIO
callToggle client = Feature callToggle client =
{ ftrMaybeAction = cmd (featureEndpoint xmonadBusName ssPath interface memToggle client)
, ftrName = "screensaver toggle" { ftrName = "screensaver toggle" }
, ftrWarning = Default -- callToggle client = Feature
, ftrChildren = [xDbusDep ssPath interface $ Method_ memToggle] -- { ftrMaybeAction = cmd
} -- , ftrName = "screensaver toggle"
where -- , ftrWarning = Default
cmd = void $ callMethod client xmonadBusName ssPath interface memToggle -- , ftrChildren = [xDbusDep ssPath interface $ Method_ memToggle]
-- }
-- where
-- cmd = void $ callMethod client xmonadBusName ssPath interface memToggle
callQuery :: Client -> IO (Maybe SSState) callQuery :: Client -> IO (Maybe SSState)
callQuery client = do callQuery client = do
reply <- callMethod client xmonadBusName ssPath interface memQuery reply <- callMethod client xmonadBusName ssPath interface memQuery
-- return $ reply >>= bodyGetCurrentState
return $ either (const Nothing) bodyGetCurrentState reply return $ either (const Nothing) bodyGetCurrentState reply
matchSignal :: (Maybe SSState -> IO ()) -> IO SignalHandler matchSignal :: (Maybe SSState -> IO ()) -> IO SignalHandler

View File

@ -23,6 +23,7 @@ module XMonad.Internal.Dependency
, featureDefault , featureDefault
, featureExeArgs , featureExeArgs
, featureExe , featureExe
, featureEndpoint
, warnMissing , warnMissing
, whenSatisfied , whenSatisfied
, ifSatisfied , ifSatisfied
@ -33,6 +34,7 @@ module XMonad.Internal.Dependency
, callMethod , callMethod
) where ) where
import Control.Monad (void)
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Data.Bifunctor (bimap) import Data.Bifunctor (bimap)
@ -102,6 +104,18 @@ featureExeArgs :: MonadIO m => String -> String -> [String] -> Feature (m ())
featureExeArgs n cmd args = featureExeArgs n cmd args =
featureDefault n [Executable cmd] $ spawnCmd cmd args featureDefault n [Executable cmd] $ spawnCmd cmd args
-- TODO the bus and client might refer to different things
featureEndpoint :: BusName -> ObjectPath -> InterfaceName -> MemberName
-> Client -> FeatureIO
featureEndpoint busname path iface mem client = Feature
{ ftrMaybeAction = cmd
, ftrName = "screensaver toggle"
, ftrWarning = Default
, ftrChildren = [DBusEndpoint (Bus False busname) $ Endpoint path iface $ Method_ mem]
}
where
cmd = void $ callMethod client busname path iface mem
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Feature evaluation -- | Feature evaluation
-- --