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

@ -7,15 +7,18 @@
module Main (main) where
import Control.Concurrent
import Control.Monad (unless)
import Control.Monad (unless)
import Data.List
( isPrefixOf
, sortBy
, sortOn
)
import Data.Maybe (isJust, mapMaybe)
import Data.Monoid (All (..))
import Data.Maybe
( isJust
, mapMaybe
)
import Data.Monoid (All (..))
import Graphics.X11.Types
import Graphics.X11.Xlib.Atom
@ -45,35 +48,34 @@ import XMonad.Internal.Concurrent.ClientMessage
import XMonad.Internal.Concurrent.DynamicWorkspaces
import XMonad.Internal.Concurrent.Removable
import XMonad.Internal.DBus.Brightness.Common
import XMonad.Internal.DBus.Brightness.IntelBacklight
import XMonad.Internal.DBus.Control
import XMonad.Internal.DBus.Screensaver
import XMonad.Internal.Dependency
import XMonad.Internal.Process
import XMonad.Internal.Shell
import qualified XMonad.Internal.Theme as T
import qualified XMonad.Internal.Theme as T
import XMonad.Layout.MultiToggle
import XMonad.Layout.NoBorders
import XMonad.Layout.NoFrillsDecoration
import XMonad.Layout.PerWorkspace
import XMonad.Layout.Renamed
import XMonad.Layout.Tabbed
import qualified XMonad.Operations as O
import qualified XMonad.StackSet as W
import qualified XMonad.Operations as O
import qualified XMonad.StackSet as W
import XMonad.Util.Cursor
import XMonad.Util.EZConfig
import qualified XMonad.Util.ExtensibleState as E
import qualified XMonad.Util.ExtensibleState as E
import XMonad.Util.NamedActions
import XMonad.Util.WorkspaceCompare
main :: IO ()
main = do
DBusXMonad
{ dxClient = cl
, dxIntelBacklightCtrl = bc
, dxScreensaverCtrl = sc
} <- startXMonadService
cl <- startXMonadService
(h, p) <- spawnPipe "xmobar"
dbusActions <- mapM evalFeature [exportScreensaver cl, exportIntelBacklight cl]
depActions <- mapM evalFeature [runPowermon, runRemovableMon]
mapM_ whenInstalled dbusActions
mapM_ (mapM_ forkIO) depActions
_ <- forkIO $ runWorkspaceMon allDWs
let ts = ThreadState
@ -82,8 +84,8 @@ main = do
, childHandles = [h]
}
lock <- whenInstalled <$> evalFeature runScreenLock
ext <- evalExternal $ externalBindings bc sc ts lock
warnMissing $ externalToMissing ext ++ fmap (io <$>) depActions
ext <- evalExternal $ externalBindings ts lock
warnMissing $ externalToMissing ext ++ fmap (io <$>) (depActions ++ dbusActions)
-- IDK why this is necessary; nothing prior to this line will print if missing
hFlush stdout
launch
@ -496,9 +498,8 @@ flagKeyBinding k@KeyBinding{ kbDesc = d, kbAction = a } = case a of
(Right x) -> Just $ k{ kbAction = x }
(Left _) -> Just $ k{ kbDesc = "[!!!]" ++ d, kbAction = skip }
externalBindings :: BrightnessControls -> SSControls -> ThreadState -> X ()
-> [KeyGroup FeatureX]
externalBindings bc sc ts lock =
externalBindings :: ThreadState -> X () -> [KeyGroup FeatureX]
externalBindings ts lock =
[ KeyGroup "Launchers"
[ KeyBinding "<XF86Search>" "select/launch app" runAppMenu
, KeyBinding "M-g" "launch clipboard manager" runClipMenu
@ -543,10 +544,10 @@ externalBindings bc sc ts lock =
]
, KeyGroup "System"
[ KeyBinding "M-." "backlight up" $ ioFeature $ bctlInc bc
, KeyBinding "M-," "backlight down" $ ioFeature $ bctlDec bc
, KeyBinding "M-M1-," "backlight min" $ ioFeature $ bctlMin bc
, KeyBinding "M-M1-." "backlight max" $ ioFeature $ bctlMax bc
[ KeyBinding "M-." "backlight up" $ ioFeature $ bctlInc intelBacklightControls
, KeyBinding "M-," "backlight down" $ ioFeature $ bctlDec intelBacklightControls
, KeyBinding "M-M1-," "backlight min" $ ioFeature $ bctlMin intelBacklightControls
, KeyBinding "M-M1-." "backlight max" $ ioFeature $ bctlMax intelBacklightControls
, KeyBinding "M-<End>" "power menu" $ ConstFeature $ runPowerPrompt lock
, KeyBinding "M-<Home>" "quit xmonad" $ ConstFeature runQuitPrompt
, KeyBinding "M-<Delete>" "lock screen" runScreenLock
@ -558,7 +559,7 @@ externalBindings bc sc ts lock =
, KeyBinding "M-<F8>" "select autorandr profile" runAutorandrMenu
, KeyBinding "M-<F9>" "toggle ethernet" runToggleEthernet
, 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
]
]

View File

@ -4,7 +4,8 @@
module XMonad.Internal.DBus.Brightness.Common
( BrightnessConfig(..)
, BrightnessControls(..)
, exportBrightnessControls
, brightnessControls
, brightnessExporter
, callGetBrightness
, matchSignal
) where
@ -45,18 +46,16 @@ data BrightnessControls = BrightnessControls
, bctlDec :: FeatureIO
}
exportBrightnessControls :: RealFrac b => [Dependency] -> BrightnessConfig a b
-> Client -> IO BrightnessControls
exportBrightnessControls deps bc client =
initControls client (brightnessExporter deps bc) controls
brightnessControls :: BrightnessConfig a b -> BrightnessControls
brightnessControls BrightnessConfig { bcPath = p, bcInterface = i } =
BrightnessControls
{ bctlMax = cb memMax
, bctlMin = cb memMin
, bctlInc = cb memInc
, bctlDec = cb memDec
}
where
controls _ = let callBacklight' = callBacklight bc in
BrightnessControls
{ bctlMax = callBacklight' memMax
, bctlMin = callBacklight' memMin
, bctlInc = callBacklight' memInc
, bctlDec = callBacklight' memDec
}
cb = callBacklight p i
callGetBrightness :: Num c => BrightnessConfig a b -> IO (Maybe c)
callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } = do
@ -77,24 +76,8 @@ matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb = do
--------------------------------------------------------------------------------
-- | Internal DBus Crap
-- exportBrightnessControls' :: RealFrac b => BrightnessConfig a b -> Client -> IO ()
-- exportBrightnessControls' bc client = do
-- 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 :: RealFrac b => [Dependency] -> BrightnessConfig a b
-> Client -> FeatureIO
brightnessExporter deps bc client = Feature
{ ftrAction = exportBrightnessControls' bc client
, ftrSilent = False
@ -123,19 +106,13 @@ emitBrightness BrightnessConfig{ bcPath = p, bcInterface = i } client cur =
where
sig = signal p i memCur
-- callBacklight :: BrightnessConfig a b -> MemberName -> IO ()
-- callBacklight BrightnessConfig { bcPath = p, bcInterface = i } mem =
-- void $ callMethod $ methodCall p i mem
callBacklight :: BrightnessConfig a b -> MemberName -> FeatureIO
callBacklight BrightnessConfig { bcPath = p, bcInterface = i } mem =
callBacklight :: ObjectPath -> InterfaceName -> MemberName -> FeatureIO
callBacklight p i m =
Feature
{ ftrAction = void $ callMethod $ methodCall p i mem
{ ftrAction = void $ callMethod $ methodCall p i m
, ftrSilent = False
, ftrChildren = [mkDep mem]
, ftrChildren = [xDbusDep p i $ Method_ m]
}
where
mkDep = xDbusDep p i . Method_
bodyGetBrightness :: Num a => [Variant] -> Maybe a
bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)

View File

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

View File

@ -18,10 +18,10 @@ import DBus
import DBus.Client
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.Screensaver
import XMonad.Internal.Dependency
-- import XMonad.Internal.Dependency
introspectInterface :: InterfaceName
introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
@ -36,37 +36,47 @@ data DBusXMonad = DBusXMonad
, dxScreensaverCtrl :: SSControls
}
blankControls :: BrightnessControls
blankControls = BrightnessControls
{ bctlMax = BlankFeature
, bctlMin = BlankFeature
, bctlInc = BlankFeature
, bctlDec = BlankFeature
}
-- blankControls :: BrightnessControls
-- blankControls = BrightnessControls
-- { bctlMax = BlankFeature
-- , bctlMin = BlankFeature
-- , bctlInc = BlankFeature
-- , bctlDec = BlankFeature
-- }
blankSSToggle :: SSControls
blankSSToggle = SSControls { ssToggle = BlankFeature }
-- blankSSToggle :: SSControls
-- blankSSToggle = SSControls { ssToggle = BlankFeature }
startXMonadService :: IO DBusXMonad
-- xmonadService :: Feature (IO Client)
-- xmonadService = Feature
-- { ftrAction = undefined
-- , ftr
startXMonadService :: IO Client
startXMonadService = do
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
-- different
(i, s) <- if requestResult /= NamePrimaryOwner then do
putStrLn "Another service owns \"org.xmonad\""
return (blankControls, blankSSToggle)
else do
putStrLn "Started xmonad dbus client"
bc <- exportIntelBacklight client
sc <- exportScreensaver client
return (bc, sc)
return $ DBusXMonad
{ dxClient = client
, dxIntelBacklightCtrl = i
-- , dxClevoBacklightCtrl = c
, dxScreensaverCtrl = s
}
-- (i, s) <- if requestResult /= NamePrimaryOwner then do
-- putStrLn "Another service owns \"org.xmonad\""
-- return (blankControls, blankSSToggle)
-- else do
-- putStrLn "Started xmonad dbus client"
-- bc <- exportIntelBacklight client
-- sc <- exportScreensaver client
-- return (bc, sc)
return client
-- return $ DBusXMonad
-- { dxClient = client
-- , dxIntelBacklightCtrl = i
-- -- , dxClevoBacklightCtrl = c
-- , dxScreensaverCtrl = s
-- }
stopXMonadService :: Client -> IO ()
stopXMonadService client = do

View File

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

View File

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