ENH make xmobar check for dbus services before starting

This commit is contained in:
Nathan Dwarshuis 2021-06-21 23:41:57 -04:00
parent d5d01308c2
commit 688d6ff405
10 changed files with 312 additions and 136 deletions

View File

@ -11,45 +11,200 @@ module Main (main) where
-- * Theme integration with xmonad (shared module imported below) -- * Theme integration with xmonad (shared module imported below)
-- * A custom Locks plugin from my own forked repo -- * A custom Locks plugin from my own forked repo
import Control.Monad (filterM)
import Data.List import Data.List
import DBus
import Xmobar.Plugins.Bluetooth import Xmobar.Plugins.Bluetooth
import Xmobar.Plugins.Device import Xmobar.Plugins.Device
import Xmobar.Plugins.IntelBacklight import Xmobar.Plugins.IntelBacklight
import Xmobar.Plugins.Screensaver import Xmobar.Plugins.Screensaver
import Xmobar.Plugins.VPN import Xmobar.Plugins.VPN
import XMonad (getXMonadDir) import XMonad (getXMonadDir)
import XMonad.Hooks.DynamicLog (wrap, xmobarColor) import XMonad.Hooks.DynamicLog (wrap, xmobarColor)
import qualified XMonad.Internal.Theme as T import XMonad.Internal.DBus.Common (xmonadBus)
import XMonad.Internal.DBus.Control (pathExists)
import XMonad.Internal.DBus.IntelBacklight (blPath)
import XMonad.Internal.DBus.Screensaver (ssPath)
import qualified XMonad.Internal.Theme as T
import Xmobar import Xmobar
sep :: String sep :: String
sep = xmobarColor T.backdropFgColor "" " : " sep = xmobarColor T.backdropFgColor "" " : "
aSep :: String lSep :: Char
aSep = "}{" lSep = '}'
rSep :: Char
rSep = '{'
pSep :: String pSep :: String
pSep = "%" pSep = "%"
myTemplate :: String data BarRegions = BarRegions
myTemplate = formatTemplate left right { brLeft :: [CmdSpec]
, brCenter :: [CmdSpec]
, brRight :: [CmdSpec]
} deriving Show
data CmdSpec = CmdSpec
{ csAlias :: String
, csDepends :: Maybe DBusDepends
, csRunnable :: Runnable
} deriving Show
data DBusDepends = DBusDepends
{ ddBus :: BusName
, ddPath :: ObjectPath
, ddSys :: Bool
} deriving Show
sysDepends :: BusName -> ObjectPath -> DBusDepends
sysDepends b p = DBusDepends b p True
sesDepends :: BusName -> ObjectPath -> DBusDepends
sesDepends b p = DBusDepends b p False
concatRegions :: BarRegions -> [CmdSpec]
concatRegions (BarRegions l c r) = l ++ c ++ r
mapRegionsM :: Monad m => ([CmdSpec] -> m [CmdSpec]) -> BarRegions -> m BarRegions
mapRegionsM f (BarRegions l c r) = do
l' <- f l
c' <- f c
r' <- f r
return $ BarRegions l' c' r'
filterSpecs :: [CmdSpec] -> IO [CmdSpec]
filterSpecs = filterM (maybe (return True) exists . csDepends)
where where
formatTemplate l r = fmtAliases l ++ aSep ++ fmtAliases r ++ " " exists DBusDepends { ddBus = b, ddPath = p, ddSys = s } = pathExists s b p
left = [ "UnsafeStdinReader" ]
right = [ "wlp0s20f3wi" myCommands :: BarRegions
, "enp7s0f1" myCommands = BarRegions
, "vpn" { brLeft =
, "bluetooth" [ CmdSpec
, "alsa:default:Master" { csAlias = "UnsafeStdinReader"
, "battery" , csDepends = Nothing
, "intelbacklight" , csRunnable = Run UnsafeStdinReader
, "screensaver" }
, "locks" ]
, "date"
] , brCenter = []
fmtAliases = intercalate sep . map (wrap pSep pSep)
, brRight =
[ CmdSpec
{ csAlias = "wlp0s20f3wi"
, csDepends = Nothing
, csRunnable = Run
$ Wireless "wlp0s20f3"
[ "-t", "<qualityipat><essid>"
, "--"
, "--quality-icon-pattern", "<icon=wifi_%%.xpm/>"
] 5
}
, CmdSpec
{ csAlias = "enp7s0f1"
, csDepends = Just $ sysDepends devBus devPath
, csRunnable = Run
$ Device ("enp7s0f1", "<fn=2>\xf0e8</fn>", T.fgColor, T.backdropFgColor) 5
}
, CmdSpec
{ csAlias = vpnAlias
, csDepends = Just $ sysDepends vpnBus vpnPath
, csRunnable = Run
$ VPN ("<fn=2>\xf023</fn>", T.fgColor, T.backdropFgColor) 5
}
, CmdSpec
{ csAlias = btAlias
, csDepends = Just $ sysDepends btBus btPath
, csRunnable = Run
$ Bluetooth ("<fn=2>\xf293</fn>", T.fgColor, T.backdropFgColor) 5
}
, CmdSpec
{ csAlias = "alsa:default:Master"
, csDepends = Nothing
, csRunnable = Run
$ Alsa "default" "Master"
[ "-t", "<status><volume>%"
, "--"
, "-O", "<fn=1>\xf028</fn>"
, "-o", "<fn=1>\xf026 </fn>"
, "-c", T.fgColor
, "-C", T.fgColor
]
}
, CmdSpec
{ csAlias = "battery"
, csDepends = Nothing
, csRunnable = Run
$ Battery
[ "--template", "<acstatus><left>"
, "--Low", "10"
, "--High", "80"
, "--low", "red"
, "--normal", T.fgColor
, "--high", T.fgColor
, "--"
, "-P"
, "-o" , "<fn=1>\xf0e7</fn>"
, "-O" , "<fn=1>\xf1e6</fn>"
, "-i" , "<fn=1>\xf1e6</fn>"
] 50
}
, CmdSpec
{ csAlias = "intelbacklight"
, csDepends = Just $ sesDepends xmonadBus blPath
, csRunnable = Run $ IntelBacklight "<fn=1>\xf185</fn>"
}
, CmdSpec
{ csAlias = ssAlias
, csDepends = Just $ sesDepends xmonadBus ssPath
, csRunnable = Run
$ Screensaver ("<fn=1>\xf254</fn>", T.fgColor, T.backdropFgColor)
}
, CmdSpec
{ csAlias = "locks"
, csDepends = Nothing
, csRunnable = Run
$ Locks
[ "-N", "<fn=3>\x1f13d</fn>"
, "-n", xmobarColor T.backdropFgColor "" "<fn=3>\x1f13d</fn>"
, "-C", "<fn=3>\x1f132</fn>"
, "-c", xmobarColor T.backdropFgColor "" "<fn=3>\x1f132</fn>"
, "-s", ""
, "-S", ""
, "-d", "<fn=3> </fn>"
]
}
, CmdSpec
{ csAlias = "date"
, csDepends = Nothing
, csRunnable = Run $ Date "%Y-%m-%d %H:%M:%S " "date" 10
}
]
}
fmtSpecs :: [CmdSpec] -> String
fmtSpecs = intercalate sep . fmap go
where
go CmdSpec { csAlias = a } = wrap pSep pSep a
fmtRegions :: BarRegions -> String
fmtRegions BarRegions { brLeft = l, brCenter = c, brRight = r } =
fmtSpecs l ++ [lSep] ++ fmtSpecs c ++ [rSep] ++ fmtSpecs r
barFont :: String barFont :: String
barFont = T.fmtFontXFT T.font barFont = T.fmtFontXFT T.font
@ -79,8 +234,8 @@ blockFont = T.fmtFontXFT T.font
, T.weight = Just T.Bold , T.weight = Just T.Bold
} }
config :: String -> Config config :: BarRegions -> String -> Config
config confDir = defaultConfig config br confDir = defaultConfig
{ font = barFont { font = barFont
, additionalFonts = [ iconFont, iconFontLarge, blockFont ] , additionalFonts = [ iconFont, iconFontLarge, blockFont ]
, textOffset = 16 , textOffset = 16
@ -92,8 +247,8 @@ config confDir = defaultConfig
, borderColor = T.bordersColor , borderColor = T.bordersColor
, sepChar = pSep , sepChar = pSep
, alignSep = aSep , alignSep = [lSep, rSep]
, template = myTemplate , template = fmtRegions br
, lowerOnStart = False , lowerOnStart = False
, hideOnStart = False , hideOnStart = False
@ -104,61 +259,11 @@ config confDir = defaultConfig
-- store the icons with the xmonad/xmobar stack project -- store the icons with the xmonad/xmobar stack project
, iconRoot = confDir ++ "/icons" , iconRoot = confDir ++ "/icons"
, commands = , commands = csRunnable <$> concatRegions br
[ Run $ Alsa "default" "Master"
[ "-t", "<status><volume>%"
, "--"
, "-O", "<fn=1>\xf028</fn>"
, "-o", "<fn=1>\xf026 </fn>"
, "-c", T.fgColor
, "-C", T.fgColor
]
, Run $ Battery [ "--template", "<acstatus><left>"
, "--Low", "10"
, "--High", "80"
, "--low", "red"
, "--normal", T.fgColor
, "--high", T.fgColor
, "--"
, "-P"
, "-o" , "<fn=1>\xf0e7</fn>"
, "-O" , "<fn=1>\xf1e6</fn>"
, "-i" , "<fn=1>\xf1e6</fn>"
] 50
, Run $ IntelBacklight "<fn=1>\xf185</fn>"
, Run $ Wireless "wlp0s20f3"
[ "-t", "<qualityipat><essid>"
, "--"
, "--quality-icon-pattern", "<icon=wifi_%%.xpm/>"
] 5
, Run $ Device
("enp7s0f1", "<fn=2>\xf0e8</fn>", T.fgColor, T.backdropFgColor) 5
, Run $ Locks
[ "-N", "<fn=3>\x1f13d</fn>"
, "-n", xmobarColor T.backdropFgColor "" "<fn=3>\x1f13d</fn>"
, "-C", "<fn=3>\x1f132</fn>"
, "-c", xmobarColor T.backdropFgColor "" "<fn=3>\x1f132</fn>"
, "-s", ""
, "-S", ""
, "-d", "<fn=3> </fn>"
]
, Run $ Date "%Y-%m-%d %H:%M:%S" "date" 10
, Run $ Screensaver ("<fn=1>\xf254</fn>", T.fgColor, T.backdropFgColor)
, Run $ Bluetooth ("<fn=2>\xf293</fn>", T.fgColor, T.backdropFgColor) 5
, Run UnsafeStdinReader
, Run $ VPN ("<fn=2>\xf023</fn>", T.fgColor, T.backdropFgColor) 5
]
} }
main :: IO () main :: IO ()
main = xmobar . config =<< getXMonadDir main = do
br <- mapRegionsM filterSpecs myCommands
dir <- getXMonadDir
xmobar $ config br dir

View File

@ -1,26 +1,32 @@
{-# LANGUAGE OverloadedStrings #-}
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Common internal DBus functions -- | Common internal DBus functions
module XMonad.Internal.DBus.Common module XMonad.Internal.DBus.Common
( callMethod ( callMethod
, callMethod'
, addMatchCallback , addMatchCallback
, xmonadBus
) where ) where
import DBus import DBus
import DBus.Client import DBus.Client
-- TODO export the bus name (org.xmonad) xmonadBus :: BusName
xmonadBus = busName_ "org.xmonad"
-- | Call a method and return its result if successful -- | Call a method and return its result if successful
callMethod :: MethodCall -> IO (Maybe [Variant]) callMethod :: MethodCall -> IO (Maybe [Variant])
callMethod mc = do callMethod mc = do
client <- connectSession client <- connectSession
-- TODO handle clienterrors here r <- callMethod' client (Just xmonadBus) mc
reply <- call client mc { methodCallDestination = Just "org.xmonad" }
-- TODO not all methods warrent that we wait for a reply?
disconnect client 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 return $ case reply of
Left _ -> Nothing Left _ -> Nothing
Right ret -> Just $ methodReturnBody ret Right ret -> Just $ methodReturnBody ret

View File

@ -1,4 +1,4 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | High-level interface for managing XMonad's DBus -- | High-level interface for managing XMonad's DBus
@ -7,18 +7,30 @@ module XMonad.Internal.DBus.Control
( Client ( Client
, startXMonadService , startXMonadService
, stopXMonadService , stopXMonadService
, pathExists
, xmonadBus
) where ) where
import Data.Either
import DBus
import DBus.Client import DBus.Client
import XMonad.Internal.DBus.Common
import XMonad.Internal.DBus.IntelBacklight import XMonad.Internal.DBus.IntelBacklight
import XMonad.Internal.DBus.Screensaver import XMonad.Internal.DBus.Screensaver
import XMonad.Internal.Shell import XMonad.Internal.Shell
introspectInterface :: InterfaceName
introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
introspectMethod :: MemberName
introspectMethod = memberName_ "Introspect"
startXMonadService :: IO (Client, Maybe BacklightControls, MaybeExe SSControls) startXMonadService :: IO (Client, Maybe BacklightControls, MaybeExe SSControls)
startXMonadService = do startXMonadService = do
client <- connectSession client <- connectSession
requestResult <- requestName client "org.xmonad" [] requestResult <- requestName client 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
if requestResult /= NamePrimaryOwner then do if requestResult /= NamePrimaryOwner then do
@ -32,7 +44,14 @@ startXMonadService = do
stopXMonadService :: Client -> IO () stopXMonadService :: Client -> IO ()
stopXMonadService client = do stopXMonadService client = do
_ <- releaseName client "org.xmonad" _ <- releaseName client xmonadBus
disconnect client disconnect client
return () return ()
pathExists :: Bool -> BusName -> ObjectPath -> IO Bool
pathExists sysbus n p = do
client <- if sysbus then connectSystem else connectSession
r <- call client (methodCall p introspectInterface introspectMethod)
{ methodCallDestination = Just n }
disconnect client
return $ isRight r

View File

@ -1,5 +1,3 @@
{-# LANGUAGE OverloadedStrings #-}
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | DBus module for Intel Backlight control -- | DBus module for Intel Backlight control
@ -12,6 +10,7 @@ module XMonad.Internal.DBus.IntelBacklight
, exportIntelBacklight , exportIntelBacklight
, matchSignal , matchSignal
, hasBacklight , hasBacklight
, blPath
, BacklightControls(..) , BacklightControls(..)
) where ) where
@ -149,43 +148,43 @@ hasBacklight = fromRight False <$> hasBacklight'
-- integer and emit a signal with the same brightness value. Additionally, there -- integer and emit a signal with the same brightness value. Additionally, there
-- is one method to get the current brightness. -- is one method to get the current brightness.
path :: ObjectPath blPath :: ObjectPath
path = "/intelbacklight" blPath = objectPath_ "/intelbacklight"
interface :: InterfaceName interface :: InterfaceName
interface = "org.xmonad.Brightness" interface = interfaceName_ "org.xmonad.Brightness"
memCurrentBrightness :: MemberName memCurrentBrightness :: MemberName
memCurrentBrightness = "CurrentBrightness" memCurrentBrightness = memberName_ "CurrentBrightness"
memGetBrightness :: MemberName memGetBrightness :: MemberName
memGetBrightness = "GetBrightness" memGetBrightness = memberName_ "GetBrightness"
memMaxBrightness :: MemberName memMaxBrightness :: MemberName
memMaxBrightness = "MaxBrightness" memMaxBrightness = memberName_ "MaxBrightness"
memMinBrightness :: MemberName memMinBrightness :: MemberName
memMinBrightness = "MinBrightness" memMinBrightness = memberName_ "MinBrightness"
memIncBrightness :: MemberName memIncBrightness :: MemberName
memIncBrightness = "IncBrightness" memIncBrightness = memberName_ "IncBrightness"
memDecBrightness :: MemberName memDecBrightness :: MemberName
memDecBrightness = "DecBrightness" memDecBrightness = memberName_ "DecBrightness"
brSignal :: Signal brSignal :: Signal
brSignal = signal path interface memCurrentBrightness brSignal = signal blPath interface memCurrentBrightness
-- { signalDestination = Just "org.xmonad" } -- { signalDestination = Just "org.xmonad" }
brMatcher :: MatchRule brMatcher :: MatchRule
brMatcher = matchAny brMatcher = matchAny
{ matchPath = Just path { matchPath = Just blPath
, matchInterface = Just interface , matchInterface = Just interface
, matchMember = Just memCurrentBrightness , matchMember = Just memCurrentBrightness
} }
callBacklight :: MemberName -> IO () callBacklight :: MemberName -> IO ()
callBacklight method = void $ callMethod $ methodCall path interface method callBacklight method = void $ callMethod $ methodCall blPath interface method
bodyGetBrightness :: [Variant] -> Maybe Brightness bodyGetBrightness :: [Variant] -> Maybe Brightness
bodyGetBrightness [b] = fromVariant b :: Maybe Brightness bodyGetBrightness [b] = fromVariant b :: Maybe Brightness
@ -211,7 +210,7 @@ exportIntelBacklight' client = do
maxval <- getMaxRawBrightness -- assume the max value will never change maxval <- getMaxRawBrightness -- assume the max value will never change
let stepsize = maxBrightness `div` steps let stepsize = maxBrightness `div` steps
let emit' = emitBrightness client let emit' = emitBrightness client
export client path defaultInterface export client blPath defaultInterface
{ interfaceName = interface { interfaceName = interface
, interfaceMethods = , interfaceMethods =
[ autoMethod memMaxBrightness $ emit' =<< setBrightness maxval maxBrightness [ autoMethod memMaxBrightness $ emit' =<< setBrightness maxval maxBrightness
@ -245,7 +244,7 @@ callDecBrightness = callBacklight memDecBrightness
callGetBrightness :: IO (Maybe Brightness) callGetBrightness :: IO (Maybe Brightness)
callGetBrightness = do callGetBrightness = do
reply <- callMethod $ methodCall path interface memGetBrightness reply <- callMethod $ methodCall blPath interface memGetBrightness
return $ reply >>= bodyGetBrightness return $ reply >>= bodyGetBrightness
matchSignal :: (Maybe Brightness -> IO ()) -> IO SignalHandler matchSignal :: (Maybe Brightness -> IO ()) -> IO SignalHandler

View File

@ -1,5 +1,3 @@
{-# LANGUAGE OverloadedStrings #-}
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | DBus module for X11 screensave/DPMS control -- | DBus module for X11 screensave/DPMS control
@ -8,6 +6,7 @@ module XMonad.Internal.DBus.Screensaver
, callToggle , callToggle
, callQuery , callQuery
, matchSignal , matchSignal
, ssPath
, SSControls(..) , SSControls(..)
) where ) where
@ -56,27 +55,27 @@ query = do
-- with the new state when called. Define another method to get the current -- with the new state when called. Define another method to get the current
-- state. -- state.
path :: ObjectPath ssPath :: ObjectPath
path = "/screensaver" ssPath = objectPath_ "/screensaver"
interface :: InterfaceName interface :: InterfaceName
interface = "org.xmonad.Screensaver" interface = interfaceName_ "org.xmonad.Screensaver"
memState :: MemberName memState :: MemberName
memState = "State" memState = memberName_ "State"
memToggle :: MemberName memToggle :: MemberName
memToggle = "Toggle" memToggle = memberName_ "Toggle"
memQuery :: MemberName memQuery :: MemberName
memQuery = "Query" memQuery = memberName_ "Query"
sigCurrentState :: Signal sigCurrentState :: Signal
sigCurrentState = signal path interface memState sigCurrentState = signal ssPath interface memState
ruleCurrentState :: MatchRule ruleCurrentState :: MatchRule
ruleCurrentState = matchAny ruleCurrentState = matchAny
{ matchPath = Just path { matchPath = Just ssPath
, matchInterface = Just interface , matchInterface = Just interface
, matchMember = Just memState , matchMember = Just memState
} }
@ -103,7 +102,7 @@ exportScreensaver client = do
exportScreensaver' :: Client -> IO SSControls exportScreensaver' :: Client -> IO SSControls
exportScreensaver' client = do exportScreensaver' client = do
export client path defaultInterface export client ssPath defaultInterface
{ interfaceName = interface { interfaceName = interface
, interfaceMethods = , interfaceMethods =
[ autoMethod memToggle $ emitState client =<< toggle [ autoMethod memToggle $ emitState client =<< toggle
@ -113,11 +112,11 @@ exportScreensaver' client = do
return $ SSControls { ssToggle = callToggle } return $ SSControls { ssToggle = callToggle }
callToggle :: IO () callToggle :: IO ()
callToggle = void $ callMethod $ methodCall path interface memToggle callToggle = void $ callMethod $ methodCall ssPath interface memToggle
callQuery :: IO (Maybe SSState) callQuery :: IO (Maybe SSState)
callQuery = do callQuery = do
reply <- callMethod $ methodCall path interface memQuery reply <- callMethod $ methodCall ssPath interface memQuery
return $ reply >>= bodyGetCurrentState return $ reply >>= bodyGetCurrentState
matchSignal :: (Maybe SSState -> IO ()) -> IO SignalHandler matchSignal :: (Maybe SSState -> IO ()) -> IO SignalHandler

View File

@ -6,7 +6,12 @@
-- --
-- Use the bluez interface on DBus to check status -- Use the bluez interface on DBus to check status
module Xmobar.Plugins.Bluetooth (Bluetooth(..)) where module Xmobar.Plugins.Bluetooth
( Bluetooth(..)
, btAlias
, btBus
, btPath
) where
import DBus import DBus
import DBus.Client import DBus.Client
@ -19,11 +24,21 @@ data Bluetooth = Bluetooth (String, String, String) Int
callGetPowered :: Client -> IO (Either MethodError Variant) callGetPowered :: Client -> IO (Either MethodError Variant)
callGetPowered client = callGetPowered client =
getProperty client (methodCall "/org/bluez/hci0" "org.bluez.Adapter1" "Powered") getProperty client (methodCall btPath "org.bluez.Adapter1" "Powered")
{ methodCallDestination = Just "org.bluez" } { methodCallDestination = Just btBus }
btBus :: BusName
btBus = "org.bluez"
-- TODO this feels like something that shouldn't be hardcoded
btPath :: ObjectPath
btPath = "/org/bluez/hci0"
btAlias :: String
btAlias = "bluetooth"
instance Exec Bluetooth where instance Exec Bluetooth where
alias (Bluetooth _ _) = "bluetooth" alias (Bluetooth _ _) = btAlias
rate (Bluetooth _ r) = r rate (Bluetooth _ r) = r
run (Bluetooth (text, colorOn, colorOff) _) = do run (Bluetooth (text, colorOn, colorOff) _) = do
client <- connectSystem client <- connectSystem

View File

@ -1,6 +1,10 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Xmobar.Plugins.Device where module Xmobar.Plugins.Device
( Device(..)
, devBus
, devPath
) where
-- TOOD this name can be more general -- TOOD this name can be more general
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -23,15 +27,18 @@ import Xmobar
data Device = Device (String, String, String, String) Int data Device = Device (String, String, String, String) Int
deriving (Read, Show) deriving (Read, Show)
busName :: BusName devBus :: BusName
busName = "org.freedesktop.NetworkManager" devBus = "org.freedesktop.NetworkManager"
devPath :: ObjectPath
devPath = "/org/freedesktop/NetworkManager"
getDevice :: Client -> String -> IO (Maybe ObjectPath) getDevice :: Client -> String -> IO (Maybe ObjectPath)
getDevice client iface = do getDevice client iface = do
let mc = methodCall "/org/freedesktop/NetworkManager" let mc = methodCall devPath
"org.freedesktop.NetworkManager" "GetDeviceByIpIface" "org.freedesktop.NetworkManager" "GetDeviceByIpIface"
reply <- call client $ mc { methodCallBody = [toVariant iface] reply <- call client $ mc { methodCallBody = [toVariant iface]
, methodCallDestination = Just busName , methodCallDestination = Just devBus
} }
return $ case reply of return $ case reply of
Left _ -> Nothing Left _ -> Nothing
@ -45,7 +52,7 @@ getDeviceConnected client objectPath = do
"org.freedesktop.NetworkManager.Device" "org.freedesktop.NetworkManager.Device"
"Ip4Connectivity" "Ip4Connectivity"
either (const Nothing) (fmap ((> 1) :: Word32 -> Bool) . fromVariant) either (const Nothing) (fmap ((> 1) :: Word32 -> Bool) . fromVariant)
<$> getProperty client mc { methodCallDestination = Just busName } <$> getProperty client mc { methodCallDestination = Just devBus }
instance Exec Device where instance Exec Device where
alias (Device (iface, _, _, _) _) = iface alias (Device (iface, _, _, _) _) = iface

View File

@ -6,7 +6,10 @@
-- Use the custom DBus interface exported by the XMonad process so I can react -- Use the custom DBus interface exported by the XMonad process so I can react
-- to signals spawned by commands -- to signals spawned by commands
module Xmobar.Plugins.IntelBacklight (IntelBacklight(..)) where module Xmobar.Plugins.IntelBacklight
( IntelBacklight(..)
, blAlias
) where
import Control.Concurrent import Control.Concurrent
import Control.Monad import Control.Monad
@ -17,8 +20,11 @@ import XMonad.Internal.DBus.IntelBacklight
newtype IntelBacklight = IntelBacklight String deriving (Read, Show) newtype IntelBacklight = IntelBacklight String deriving (Read, Show)
blAlias :: String
blAlias = "intelbacklight"
instance Exec IntelBacklight where instance Exec IntelBacklight where
alias (IntelBacklight _) = "intelbacklight" alias (IntelBacklight _) = blAlias
start (IntelBacklight icon) cb = do start (IntelBacklight icon) cb = do
_ <- matchSignal $ cb . formatBrightness _ <- matchSignal $ cb . formatBrightness
cb . formatBrightness =<< callGetBrightness cb . formatBrightness =<< callGetBrightness

View File

@ -6,7 +6,10 @@
-- Use the custom DBus interface exported by the XMonad process so I can react -- Use the custom DBus interface exported by the XMonad process so I can react
-- to signals spawned by commands -- to signals spawned by commands
module Xmobar.Plugins.Screensaver (Screensaver(..)) where module Xmobar.Plugins.Screensaver
( Screensaver(..)
, ssAlias
) where
import Control.Concurrent import Control.Concurrent
import Control.Monad import Control.Monad
@ -19,8 +22,11 @@ import XMonad.Internal.DBus.Screensaver
newtype Screensaver = Screensaver (String, String, String) newtype Screensaver = Screensaver (String, String, String)
deriving (Read, Show) deriving (Read, Show)
ssAlias :: String
ssAlias = "screensaver"
instance Exec Screensaver where instance Exec Screensaver where
alias (Screensaver _) = "screensaver" alias (Screensaver _) = ssAlias
start (Screensaver (text, colorOn, colorOff)) cb = do start (Screensaver (text, colorOn, colorOff)) cb = do
_ <- matchSignal $ cb . fmtState _ <- matchSignal $ cb . fmtState
cb . fmtState =<< callQuery cb . fmtState =<< callQuery

View File

@ -6,7 +6,12 @@
-- --
-- Use the NetworkManger interface on DBus to check status -- Use the NetworkManger interface on DBus to check status
module Xmobar.Plugins.VPN (VPN(..)) where module Xmobar.Plugins.VPN
( VPN(..)
, vpnAlias
, vpnBus
, vpnPath
) where
import DBus import DBus
import DBus.Client import DBus.Client
@ -19,12 +24,21 @@ data VPN = VPN (String, String, String) Int
callConnectionType :: Client -> IO (Either MethodError Variant) callConnectionType :: Client -> IO (Either MethodError Variant)
callConnectionType client = callConnectionType client =
getProperty client (methodCall "/org/freedesktop/NetworkManager" getProperty client (methodCall vpnPath
"org.freedesktop.NetworkManager" "PrimaryConnectionType") "org.freedesktop.NetworkManager" "PrimaryConnectionType")
{ methodCallDestination = Just "org.freedesktop.NetworkManager" } { methodCallDestination = Just vpnBus }
vpnBus :: BusName
vpnBus = "org.freedesktop.NetworkManager"
vpnPath :: ObjectPath
vpnPath = "/org/freedesktop/NetworkManager"
vpnAlias :: String
vpnAlias = "vpn"
instance Exec VPN where instance Exec VPN where
alias (VPN _ _) = "vpn" alias (VPN _ _) = vpnAlias
rate (VPN _ r) = r rate (VPN _ r) = r
run (VPN (text, colorOn, colorOff) _) = do run (VPN (text, colorOn, colorOff) _) = do
client <- connectSystem client <- connectSystem