ENH decouple dbus controls from exporter

This commit is contained in:
Nathan Dwarshuis 2021-11-20 12:40:53 -05:00
parent f473e1f26d
commit 96108abc43
6 changed files with 93 additions and 109 deletions

View File

@ -14,7 +14,10 @@ import Data.List
, sortBy , sortBy
, sortOn , sortOn
) )
import Data.Maybe (isJust, mapMaybe) import Data.Maybe
( isJust
, mapMaybe
)
import Data.Monoid (All (..)) import Data.Monoid (All (..))
import Graphics.X11.Types import Graphics.X11.Types
@ -45,6 +48,7 @@ import XMonad.Internal.Concurrent.ClientMessage
import XMonad.Internal.Concurrent.DynamicWorkspaces import XMonad.Internal.Concurrent.DynamicWorkspaces
import XMonad.Internal.Concurrent.Removable import XMonad.Internal.Concurrent.Removable
import XMonad.Internal.DBus.Brightness.Common import XMonad.Internal.DBus.Brightness.Common
import XMonad.Internal.DBus.Brightness.IntelBacklight
import XMonad.Internal.DBus.Control import XMonad.Internal.DBus.Control
import XMonad.Internal.DBus.Screensaver import XMonad.Internal.DBus.Screensaver
import XMonad.Internal.Dependency import XMonad.Internal.Dependency
@ -67,13 +71,11 @@ import XMonad.Util.WorkspaceCompare
main :: IO () main :: IO ()
main = do main = do
DBusXMonad cl <- startXMonadService
{ dxClient = cl
, dxIntelBacklightCtrl = bc
, dxScreensaverCtrl = sc
} <- startXMonadService
(h, p) <- spawnPipe "xmobar" (h, p) <- spawnPipe "xmobar"
dbusActions <- mapM evalFeature [exportScreensaver cl, exportIntelBacklight cl]
depActions <- mapM evalFeature [runPowermon, runRemovableMon] depActions <- mapM evalFeature [runPowermon, runRemovableMon]
mapM_ whenInstalled dbusActions
mapM_ (mapM_ forkIO) depActions mapM_ (mapM_ forkIO) depActions
_ <- forkIO $ runWorkspaceMon allDWs _ <- forkIO $ runWorkspaceMon allDWs
let ts = ThreadState let ts = ThreadState
@ -82,8 +84,8 @@ main = do
, childHandles = [h] , childHandles = [h]
} }
lock <- whenInstalled <$> evalFeature runScreenLock lock <- whenInstalled <$> evalFeature runScreenLock
ext <- evalExternal $ externalBindings bc sc ts lock ext <- evalExternal $ externalBindings ts lock
warnMissing $ externalToMissing ext ++ fmap (io <$>) depActions warnMissing $ externalToMissing ext ++ fmap (io <$>) (depActions ++ dbusActions)
-- IDK why this is necessary; nothing prior to this line will print if missing -- IDK why this is necessary; nothing prior to this line will print if missing
hFlush stdout hFlush stdout
launch launch
@ -496,9 +498,8 @@ flagKeyBinding k@KeyBinding{ kbDesc = d, kbAction = a } = case a of
(Right x) -> Just $ k{ kbAction = x } (Right x) -> Just $ k{ kbAction = x }
(Left _) -> Just $ k{ kbDesc = "[!!!]" ++ d, kbAction = skip } (Left _) -> Just $ k{ kbDesc = "[!!!]" ++ d, kbAction = skip }
externalBindings :: BrightnessControls -> SSControls -> ThreadState -> X () externalBindings :: ThreadState -> X () -> [KeyGroup FeatureX]
-> [KeyGroup FeatureX] externalBindings ts lock =
externalBindings bc sc ts lock =
[ KeyGroup "Launchers" [ KeyGroup "Launchers"
[ KeyBinding "<XF86Search>" "select/launch app" runAppMenu [ KeyBinding "<XF86Search>" "select/launch app" runAppMenu
, KeyBinding "M-g" "launch clipboard manager" runClipMenu , KeyBinding "M-g" "launch clipboard manager" runClipMenu
@ -543,10 +544,10 @@ externalBindings bc sc ts lock =
] ]
, KeyGroup "System" , KeyGroup "System"
[ KeyBinding "M-." "backlight up" $ ioFeature $ bctlInc bc [ KeyBinding "M-." "backlight up" $ ioFeature $ bctlInc intelBacklightControls
, KeyBinding "M-," "backlight down" $ ioFeature $ bctlDec bc , KeyBinding "M-," "backlight down" $ ioFeature $ bctlDec intelBacklightControls
, KeyBinding "M-M1-," "backlight min" $ ioFeature $ bctlMin bc , KeyBinding "M-M1-," "backlight min" $ ioFeature $ bctlMin intelBacklightControls
, KeyBinding "M-M1-." "backlight max" $ ioFeature $ bctlMax bc , KeyBinding "M-M1-." "backlight max" $ ioFeature $ bctlMax intelBacklightControls
, KeyBinding "M-<End>" "power menu" $ ConstFeature $ runPowerPrompt lock , KeyBinding "M-<End>" "power menu" $ ConstFeature $ runPowerPrompt lock
, KeyBinding "M-<Home>" "quit xmonad" $ ConstFeature runQuitPrompt , KeyBinding "M-<Home>" "quit xmonad" $ ConstFeature runQuitPrompt
, KeyBinding "M-<Delete>" "lock screen" runScreenLock , KeyBinding "M-<Delete>" "lock screen" runScreenLock
@ -558,7 +559,7 @@ externalBindings bc sc ts lock =
, KeyBinding "M-<F8>" "select autorandr profile" runAutorandrMenu , KeyBinding "M-<F8>" "select autorandr profile" runAutorandrMenu
, KeyBinding "M-<F9>" "toggle ethernet" runToggleEthernet , KeyBinding "M-<F9>" "toggle ethernet" runToggleEthernet
, KeyBinding "M-<F10>" "toggle bluetooth" runToggleBluetooth , KeyBinding "M-<F10>" "toggle bluetooth" runToggleBluetooth
, KeyBinding "M-<F11>" "toggle screensaver" $ ioFeature $ ssToggle sc , KeyBinding "M-<F11>" "toggle screensaver" $ ioFeature callToggle
, KeyBinding "M-<F12>" "switch gpu" runOptimusPrompt , KeyBinding "M-<F12>" "switch gpu" runOptimusPrompt
] ]
] ]

View File

@ -4,7 +4,8 @@
module XMonad.Internal.DBus.Brightness.Common module XMonad.Internal.DBus.Brightness.Common
( BrightnessConfig(..) ( BrightnessConfig(..)
, BrightnessControls(..) , BrightnessControls(..)
, exportBrightnessControls , brightnessControls
, brightnessExporter
, callGetBrightness , callGetBrightness
, matchSignal , matchSignal
) where ) where
@ -45,18 +46,16 @@ data BrightnessControls = BrightnessControls
, bctlDec :: FeatureIO , bctlDec :: FeatureIO
} }
exportBrightnessControls :: RealFrac b => [Dependency] -> BrightnessConfig a b brightnessControls :: BrightnessConfig a b -> BrightnessControls
-> Client -> IO BrightnessControls brightnessControls BrightnessConfig { bcPath = p, bcInterface = i } =
exportBrightnessControls deps bc client =
initControls client (brightnessExporter deps bc) controls
where
controls _ = let callBacklight' = callBacklight bc in
BrightnessControls BrightnessControls
{ bctlMax = callBacklight' memMax { bctlMax = cb memMax
, bctlMin = callBacklight' memMin , bctlMin = cb memMin
, bctlInc = callBacklight' memInc , bctlInc = cb memInc
, bctlDec = callBacklight' memDec , bctlDec = cb memDec
} }
where
cb = callBacklight p i
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
@ -77,24 +76,8 @@ matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb = do
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Internal DBus Crap -- | Internal DBus Crap
-- exportBrightnessControls' :: RealFrac b => BrightnessConfig a b -> Client -> IO () brightnessExporter :: RealFrac b => [Dependency] -> BrightnessConfig a b
-- exportBrightnessControls' bc client = do -> Client -> FeatureIO
-- maxval <- bcGetMax bc -- assume the max value will never change
-- let autoMethod' m f = autoMethod m $ emitBrightness bc client =<< f bc maxval
-- let funget = bcGet bc
-- export client (bcPath bc) defaultInterface
-- { interfaceName = bcInterface bc
-- , interfaceMethods =
-- [ autoMethod' memMax bcMax
-- , autoMethod' memMin bcMin
-- , autoMethod' memInc bcInc
-- , autoMethod' memDec bcDec
-- , autoMethod memGet (round <$> funget maxval :: IO Int32)
-- ]
-- }
brightnessExporter :: RealFrac b => [Dependency]
-> BrightnessConfig a b -> Client -> FeatureIO
brightnessExporter deps bc client = Feature brightnessExporter deps bc client = Feature
{ ftrAction = exportBrightnessControls' bc client { ftrAction = exportBrightnessControls' bc client
, ftrSilent = False , ftrSilent = False
@ -123,19 +106,13 @@ emitBrightness BrightnessConfig{ bcPath = p, bcInterface = i } client cur =
where where
sig = signal p i memCur sig = signal p i memCur
-- callBacklight :: BrightnessConfig a b -> MemberName -> IO () callBacklight :: ObjectPath -> InterfaceName -> MemberName -> FeatureIO
-- callBacklight BrightnessConfig { bcPath = p, bcInterface = i } mem = callBacklight p i m =
-- void $ callMethod $ methodCall p i mem
callBacklight :: BrightnessConfig a b -> MemberName -> FeatureIO
callBacklight BrightnessConfig { bcPath = p, bcInterface = i } mem =
Feature Feature
{ ftrAction = void $ callMethod $ methodCall p i mem { ftrAction = void $ callMethod $ methodCall p i m
, ftrSilent = False , ftrSilent = False
, ftrChildren = [mkDep mem] , ftrChildren = [xDbusDep p i $ Method_ m]
} }
where
mkDep = xDbusDep p i . Method_
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

@ -5,6 +5,7 @@ module XMonad.Internal.DBus.Brightness.IntelBacklight
( callGetBrightnessIB ( callGetBrightnessIB
, matchSignalIB , matchSignalIB
, exportIntelBacklight , exportIntelBacklight
, intelBacklightControls
, curFileDep , curFileDep
, maxFileDep , maxFileDep
, blPath , blPath
@ -88,9 +89,12 @@ curFileDep = pathRW curFile
maxFileDep :: Dependency maxFileDep :: Dependency
maxFileDep = pathR maxFile maxFileDep = pathR maxFile
exportIntelBacklight :: Client -> IO BrightnessControls exportIntelBacklight :: Client -> FeatureIO
exportIntelBacklight = exportIntelBacklight =
exportBrightnessControls [curFileDep, maxFileDep] intelBacklightConfig brightnessExporter [curFileDep, maxFileDep] intelBacklightConfig
intelBacklightControls :: BrightnessControls
intelBacklightControls = brightnessControls intelBacklightConfig
callGetBrightnessIB :: IO (Maybe Brightness) callGetBrightnessIB :: IO (Maybe Brightness)
callGetBrightnessIB = callGetBrightness intelBacklightConfig callGetBrightnessIB = callGetBrightness intelBacklightConfig

View File

@ -18,10 +18,10 @@ import DBus
import DBus.Client import DBus.Client
import XMonad.Internal.DBus.Brightness.Common import XMonad.Internal.DBus.Brightness.Common
import XMonad.Internal.DBus.Brightness.IntelBacklight -- import XMonad.Internal.DBus.Brightness.IntelBacklight
import XMonad.Internal.DBus.Common import XMonad.Internal.DBus.Common
import XMonad.Internal.DBus.Screensaver import XMonad.Internal.DBus.Screensaver
import XMonad.Internal.Dependency -- import XMonad.Internal.Dependency
introspectInterface :: InterfaceName introspectInterface :: InterfaceName
introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable" introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
@ -36,37 +36,47 @@ data DBusXMonad = DBusXMonad
, dxScreensaverCtrl :: SSControls , dxScreensaverCtrl :: SSControls
} }
blankControls :: BrightnessControls -- blankControls :: BrightnessControls
blankControls = BrightnessControls -- blankControls = BrightnessControls
{ bctlMax = BlankFeature -- { bctlMax = BlankFeature
, bctlMin = BlankFeature -- , bctlMin = BlankFeature
, bctlInc = BlankFeature -- , bctlInc = BlankFeature
, bctlDec = BlankFeature -- , bctlDec = BlankFeature
} -- }
blankSSToggle :: SSControls -- blankSSToggle :: SSControls
blankSSToggle = SSControls { ssToggle = BlankFeature } -- blankSSToggle = SSControls { ssToggle = BlankFeature }
startXMonadService :: IO DBusXMonad -- xmonadService :: Feature (IO Client)
-- xmonadService = Feature
-- { ftrAction = undefined
-- , ftr
startXMonadService :: IO Client
startXMonadService = do startXMonadService = do
client <- connectSession client <- connectSession
requestResult <- requestName client xmonadBus [] res <- requestName client xmonadBus []
case res of
NamePrimaryOwner -> return ()
_ -> putStrLn $ "error when requesting '" ++ formatBusName xmonadBus ++ "'"
-- TODO if the client is not released on shutdown the owner will be -- TODO if the client is not released on shutdown the owner will be
-- different -- different
(i, s) <- if requestResult /= NamePrimaryOwner then do -- (i, s) <- if requestResult /= NamePrimaryOwner then do
putStrLn "Another service owns \"org.xmonad\"" -- putStrLn "Another service owns \"org.xmonad\""
return (blankControls, blankSSToggle) -- return (blankControls, blankSSToggle)
else do -- else do
putStrLn "Started xmonad dbus client" -- putStrLn "Started xmonad dbus client"
bc <- exportIntelBacklight client -- bc <- exportIntelBacklight client
sc <- exportScreensaver client -- sc <- exportScreensaver client
return (bc, sc) -- return (bc, sc)
return $ DBusXMonad return client
{ dxClient = client -- return $ DBusXMonad
, dxIntelBacklightCtrl = i -- { dxClient = client
-- , dxClevoBacklightCtrl = c -- , dxIntelBacklightCtrl = i
, dxScreensaverCtrl = s -- -- , dxClevoBacklightCtrl = c
} -- , dxScreensaverCtrl = s
-- }
stopXMonadService :: Client -> IO () stopXMonadService :: Client -> IO ()
stopXMonadService client = do stopXMonadService client = do

View File

@ -99,13 +99,13 @@ bodyGetCurrentState _ = Nothing
newtype SSControls = SSControls { ssToggle :: FeatureIO } newtype SSControls = SSControls { ssToggle :: FeatureIO }
exportScreensaver :: Client -> IO SSControls -- exportScreensaver :: Client -> IO SSControls
exportScreensaver client = initControls client exportScreensaver' controls -- exportScreensaver client = initControls client exportScreensaver' controls
where -- where
controls _ = SSControls { ssToggle = callToggle } -- controls _ = SSControls { ssToggle = callToggle }
exportScreensaver' :: Client -> FeatureIO exportScreensaver :: Client -> FeatureIO
exportScreensaver' client = Feature exportScreensaver client = Feature
{ ftrAction = cmd { ftrAction = cmd
, ftrSilent = False , ftrSilent = False
, ftrChildren = [ssDep] , ftrChildren = [ssDep]
@ -123,11 +123,10 @@ callToggle :: FeatureIO
callToggle = Feature callToggle = Feature
{ ftrAction = cmd { ftrAction = cmd
, ftrSilent = False , ftrSilent = False
, ftrChildren = mkDep <$> [memQuery, memState, memToggle] , ftrChildren = [xDbusDep ssPath interface $ Method_ memToggle]
} }
where where
cmd = void $ callMethod $ methodCall ssPath interface memToggle cmd = void $ callMethod $ methodCall ssPath interface memToggle
mkDep = xDbusDep ssPath interface . Method_
callQuery :: IO (Maybe SSState) callQuery :: IO (Maybe SSState)
callQuery = do callQuery = do

View File

@ -55,7 +55,6 @@ data DBusMember = Method_ MemberName
| Property_ String | Property_ String
deriving (Eq, Show) deriving (Eq, Show)
-- data DependencyData = Executable String
data Dependency = Executable String data Dependency = Executable String
| AccessiblePath FilePath Bool Bool | AccessiblePath FilePath Bool Bool
| IOTest (IO (Maybe String)) | IOTest (IO (Maybe String))
@ -68,9 +67,6 @@ data Dependency = Executable String
} }
| Systemd UnitType String | Systemd UnitType String
-- data Dependency a = SubFeature (Feature a a)
-- | Dependency DependencyData
data Feature a = Feature data Feature a = Feature
{ ftrAction :: a { ftrAction :: a
, ftrSilent :: Bool , ftrSilent :: Bool
@ -102,17 +98,14 @@ evalFeature Feature { ftrAction = a, ftrSilent = s, ftrChildren = c } = do
exe :: String -> Dependency exe :: String -> Dependency
exe = Executable exe = Executable
path :: Bool -> Bool -> String -> Dependency
path r w n = AccessiblePath n r w
pathR :: String -> Dependency pathR :: String -> Dependency
pathR = path True False pathR n = AccessiblePath n True False
pathW :: String -> Dependency pathW :: String -> Dependency
pathW = path False True pathW n = AccessiblePath n False True
pathRW :: String -> Dependency pathRW :: String -> Dependency
pathRW = path True True pathRW n = AccessiblePath n True True
systemUnit :: String -> Dependency systemUnit :: String -> Dependency
systemUnit = Systemd SystemUnit systemUnit = Systemd SystemUnit