ENH decouple dbus controls from exporter
This commit is contained in:
parent
f473e1f26d
commit
96108abc43
|
@ -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
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue