ENH make xmobar check for dbus services before starting
This commit is contained in:
parent
d5d01308c2
commit
688d6ff405
265
bin/xmobar.hs
265
bin/xmobar.hs
|
|
@ -11,45 +11,200 @@ module Main (main) where
|
|||
-- * Theme integration with xmonad (shared module imported below)
|
||||
-- * A custom Locks plugin from my own forked repo
|
||||
|
||||
import Control.Monad (filterM)
|
||||
|
||||
import Data.List
|
||||
|
||||
import DBus
|
||||
|
||||
import Xmobar.Plugins.Bluetooth
|
||||
import Xmobar.Plugins.Device
|
||||
import Xmobar.Plugins.IntelBacklight
|
||||
import Xmobar.Plugins.Screensaver
|
||||
import Xmobar.Plugins.VPN
|
||||
|
||||
import XMonad (getXMonadDir)
|
||||
import XMonad.Hooks.DynamicLog (wrap, xmobarColor)
|
||||
import qualified XMonad.Internal.Theme as T
|
||||
import XMonad (getXMonadDir)
|
||||
import XMonad.Hooks.DynamicLog (wrap, xmobarColor)
|
||||
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
|
||||
|
||||
sep :: String
|
||||
sep = xmobarColor T.backdropFgColor "" " : "
|
||||
|
||||
aSep :: String
|
||||
aSep = "}{"
|
||||
lSep :: Char
|
||||
lSep = '}'
|
||||
|
||||
rSep :: Char
|
||||
rSep = '{'
|
||||
|
||||
pSep :: String
|
||||
pSep = "%"
|
||||
|
||||
myTemplate :: String
|
||||
myTemplate = formatTemplate left right
|
||||
data BarRegions = BarRegions
|
||||
{ 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
|
||||
formatTemplate l r = fmtAliases l ++ aSep ++ fmtAliases r ++ " "
|
||||
left = [ "UnsafeStdinReader" ]
|
||||
right = [ "wlp0s20f3wi"
|
||||
, "enp7s0f1"
|
||||
, "vpn"
|
||||
, "bluetooth"
|
||||
, "alsa:default:Master"
|
||||
, "battery"
|
||||
, "intelbacklight"
|
||||
, "screensaver"
|
||||
, "locks"
|
||||
, "date"
|
||||
]
|
||||
fmtAliases = intercalate sep . map (wrap pSep pSep)
|
||||
exists DBusDepends { ddBus = b, ddPath = p, ddSys = s } = pathExists s b p
|
||||
|
||||
myCommands :: BarRegions
|
||||
myCommands = BarRegions
|
||||
{ brLeft =
|
||||
[ CmdSpec
|
||||
{ csAlias = "UnsafeStdinReader"
|
||||
, csDepends = Nothing
|
||||
, csRunnable = Run UnsafeStdinReader
|
||||
}
|
||||
]
|
||||
|
||||
, brCenter = []
|
||||
|
||||
, 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 = T.fmtFontXFT T.font
|
||||
|
|
@ -79,8 +234,8 @@ blockFont = T.fmtFontXFT T.font
|
|||
, T.weight = Just T.Bold
|
||||
}
|
||||
|
||||
config :: String -> Config
|
||||
config confDir = defaultConfig
|
||||
config :: BarRegions -> String -> Config
|
||||
config br confDir = defaultConfig
|
||||
{ font = barFont
|
||||
, additionalFonts = [ iconFont, iconFontLarge, blockFont ]
|
||||
, textOffset = 16
|
||||
|
|
@ -92,8 +247,8 @@ config confDir = defaultConfig
|
|||
, borderColor = T.bordersColor
|
||||
|
||||
, sepChar = pSep
|
||||
, alignSep = aSep
|
||||
, template = myTemplate
|
||||
, alignSep = [lSep, rSep]
|
||||
, template = fmtRegions br
|
||||
|
||||
, lowerOnStart = False
|
||||
, hideOnStart = False
|
||||
|
|
@ -104,61 +259,11 @@ config confDir = defaultConfig
|
|||
-- store the icons with the xmonad/xmobar stack project
|
||||
, iconRoot = confDir ++ "/icons"
|
||||
|
||||
, commands =
|
||||
[ 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
|
||||
]
|
||||
, commands = csRunnable <$> concatRegions br
|
||||
}
|
||||
|
||||
main :: IO ()
|
||||
main = xmobar . config =<< getXMonadDir
|
||||
main = do
|
||||
br <- mapRegionsM filterSpecs myCommands
|
||||
dir <- getXMonadDir
|
||||
xmobar $ config br dir
|
||||
|
|
|
|||
|
|
@ -1,26 +1,32 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Common internal DBus functions
|
||||
|
||||
module XMonad.Internal.DBus.Common
|
||||
( callMethod
|
||||
, callMethod'
|
||||
, addMatchCallback
|
||||
, xmonadBus
|
||||
) where
|
||||
|
||||
import DBus
|
||||
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
|
||||
callMethod :: MethodCall -> IO (Maybe [Variant])
|
||||
callMethod mc = do
|
||||
client <- connectSession
|
||||
-- TODO handle clienterrors here
|
||||
reply <- call client mc { methodCallDestination = Just "org.xmonad" }
|
||||
-- TODO not all methods warrent that we wait for a reply?
|
||||
r <- callMethod' client (Just xmonadBus) mc
|
||||
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
|
||||
Left _ -> Nothing
|
||||
Right ret -> Just $ methodReturnBody ret
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | High-level interface for managing XMonad's DBus
|
||||
|
|
@ -7,18 +7,30 @@ module XMonad.Internal.DBus.Control
|
|||
( Client
|
||||
, startXMonadService
|
||||
, stopXMonadService
|
||||
, pathExists
|
||||
, xmonadBus
|
||||
) where
|
||||
|
||||
import Data.Either
|
||||
|
||||
import DBus
|
||||
import DBus.Client
|
||||
|
||||
import XMonad.Internal.DBus.Common
|
||||
import XMonad.Internal.DBus.IntelBacklight
|
||||
import XMonad.Internal.DBus.Screensaver
|
||||
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 = do
|
||||
client <- connectSession
|
||||
requestResult <- requestName client "org.xmonad" []
|
||||
requestResult <- requestName client xmonadBus []
|
||||
-- TODO if the client is not released on shutdown the owner will be
|
||||
-- different
|
||||
if requestResult /= NamePrimaryOwner then do
|
||||
|
|
@ -32,7 +44,14 @@ startXMonadService = do
|
|||
|
||||
stopXMonadService :: Client -> IO ()
|
||||
stopXMonadService client = do
|
||||
_ <- releaseName client "org.xmonad"
|
||||
_ <- releaseName client xmonadBus
|
||||
disconnect client
|
||||
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
|
||||
|
|
|
|||
|
|
@ -1,5 +1,3 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | DBus module for Intel Backlight control
|
||||
|
||||
|
|
@ -12,6 +10,7 @@ module XMonad.Internal.DBus.IntelBacklight
|
|||
, exportIntelBacklight
|
||||
, matchSignal
|
||||
, hasBacklight
|
||||
, blPath
|
||||
, BacklightControls(..)
|
||||
) where
|
||||
|
||||
|
|
@ -149,43 +148,43 @@ hasBacklight = fromRight False <$> hasBacklight'
|
|||
-- integer and emit a signal with the same brightness value. Additionally, there
|
||||
-- is one method to get the current brightness.
|
||||
|
||||
path :: ObjectPath
|
||||
path = "/intelbacklight"
|
||||
blPath :: ObjectPath
|
||||
blPath = objectPath_ "/intelbacklight"
|
||||
|
||||
interface :: InterfaceName
|
||||
interface = "org.xmonad.Brightness"
|
||||
interface = interfaceName_ "org.xmonad.Brightness"
|
||||
|
||||
memCurrentBrightness :: MemberName
|
||||
memCurrentBrightness = "CurrentBrightness"
|
||||
memCurrentBrightness = memberName_ "CurrentBrightness"
|
||||
|
||||
memGetBrightness :: MemberName
|
||||
memGetBrightness = "GetBrightness"
|
||||
memGetBrightness = memberName_ "GetBrightness"
|
||||
|
||||
memMaxBrightness :: MemberName
|
||||
memMaxBrightness = "MaxBrightness"
|
||||
memMaxBrightness = memberName_ "MaxBrightness"
|
||||
|
||||
memMinBrightness :: MemberName
|
||||
memMinBrightness = "MinBrightness"
|
||||
memMinBrightness = memberName_ "MinBrightness"
|
||||
|
||||
memIncBrightness :: MemberName
|
||||
memIncBrightness = "IncBrightness"
|
||||
memIncBrightness = memberName_ "IncBrightness"
|
||||
|
||||
memDecBrightness :: MemberName
|
||||
memDecBrightness = "DecBrightness"
|
||||
memDecBrightness = memberName_ "DecBrightness"
|
||||
|
||||
brSignal :: Signal
|
||||
brSignal = signal path interface memCurrentBrightness
|
||||
brSignal = signal blPath interface memCurrentBrightness
|
||||
-- { signalDestination = Just "org.xmonad" }
|
||||
|
||||
brMatcher :: MatchRule
|
||||
brMatcher = matchAny
|
||||
{ matchPath = Just path
|
||||
{ matchPath = Just blPath
|
||||
, matchInterface = Just interface
|
||||
, matchMember = Just memCurrentBrightness
|
||||
}
|
||||
|
||||
callBacklight :: MemberName -> IO ()
|
||||
callBacklight method = void $ callMethod $ methodCall path interface method
|
||||
callBacklight method = void $ callMethod $ methodCall blPath interface method
|
||||
|
||||
bodyGetBrightness :: [Variant] -> Maybe Brightness
|
||||
bodyGetBrightness [b] = fromVariant b :: Maybe Brightness
|
||||
|
|
@ -211,7 +210,7 @@ exportIntelBacklight' client = do
|
|||
maxval <- getMaxRawBrightness -- assume the max value will never change
|
||||
let stepsize = maxBrightness `div` steps
|
||||
let emit' = emitBrightness client
|
||||
export client path defaultInterface
|
||||
export client blPath defaultInterface
|
||||
{ interfaceName = interface
|
||||
, interfaceMethods =
|
||||
[ autoMethod memMaxBrightness $ emit' =<< setBrightness maxval maxBrightness
|
||||
|
|
@ -245,7 +244,7 @@ callDecBrightness = callBacklight memDecBrightness
|
|||
|
||||
callGetBrightness :: IO (Maybe Brightness)
|
||||
callGetBrightness = do
|
||||
reply <- callMethod $ methodCall path interface memGetBrightness
|
||||
reply <- callMethod $ methodCall blPath interface memGetBrightness
|
||||
return $ reply >>= bodyGetBrightness
|
||||
|
||||
matchSignal :: (Maybe Brightness -> IO ()) -> IO SignalHandler
|
||||
|
|
|
|||
|
|
@ -1,5 +1,3 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | DBus module for X11 screensave/DPMS control
|
||||
|
||||
|
|
@ -8,6 +6,7 @@ module XMonad.Internal.DBus.Screensaver
|
|||
, callToggle
|
||||
, callQuery
|
||||
, matchSignal
|
||||
, ssPath
|
||||
, SSControls(..)
|
||||
) where
|
||||
|
||||
|
|
@ -56,27 +55,27 @@ query = do
|
|||
-- with the new state when called. Define another method to get the current
|
||||
-- state.
|
||||
|
||||
path :: ObjectPath
|
||||
path = "/screensaver"
|
||||
ssPath :: ObjectPath
|
||||
ssPath = objectPath_ "/screensaver"
|
||||
|
||||
interface :: InterfaceName
|
||||
interface = "org.xmonad.Screensaver"
|
||||
interface = interfaceName_ "org.xmonad.Screensaver"
|
||||
|
||||
memState :: MemberName
|
||||
memState = "State"
|
||||
memState = memberName_ "State"
|
||||
|
||||
memToggle :: MemberName
|
||||
memToggle = "Toggle"
|
||||
memToggle = memberName_ "Toggle"
|
||||
|
||||
memQuery :: MemberName
|
||||
memQuery = "Query"
|
||||
memQuery = memberName_ "Query"
|
||||
|
||||
sigCurrentState :: Signal
|
||||
sigCurrentState = signal path interface memState
|
||||
sigCurrentState = signal ssPath interface memState
|
||||
|
||||
ruleCurrentState :: MatchRule
|
||||
ruleCurrentState = matchAny
|
||||
{ matchPath = Just path
|
||||
{ matchPath = Just ssPath
|
||||
, matchInterface = Just interface
|
||||
, matchMember = Just memState
|
||||
}
|
||||
|
|
@ -103,7 +102,7 @@ exportScreensaver client = do
|
|||
|
||||
exportScreensaver' :: Client -> IO SSControls
|
||||
exportScreensaver' client = do
|
||||
export client path defaultInterface
|
||||
export client ssPath defaultInterface
|
||||
{ interfaceName = interface
|
||||
, interfaceMethods =
|
||||
[ autoMethod memToggle $ emitState client =<< toggle
|
||||
|
|
@ -113,11 +112,11 @@ exportScreensaver' client = do
|
|||
return $ SSControls { ssToggle = callToggle }
|
||||
|
||||
callToggle :: IO ()
|
||||
callToggle = void $ callMethod $ methodCall path interface memToggle
|
||||
callToggle = void $ callMethod $ methodCall ssPath interface memToggle
|
||||
|
||||
callQuery :: IO (Maybe SSState)
|
||||
callQuery = do
|
||||
reply <- callMethod $ methodCall path interface memQuery
|
||||
reply <- callMethod $ methodCall ssPath interface memQuery
|
||||
return $ reply >>= bodyGetCurrentState
|
||||
|
||||
matchSignal :: (Maybe SSState -> IO ()) -> IO SignalHandler
|
||||
|
|
|
|||
|
|
@ -6,7 +6,12 @@
|
|||
--
|
||||
-- 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.Client
|
||||
|
|
@ -19,11 +24,21 @@ data Bluetooth = Bluetooth (String, String, String) Int
|
|||
|
||||
callGetPowered :: Client -> IO (Either MethodError Variant)
|
||||
callGetPowered client =
|
||||
getProperty client (methodCall "/org/bluez/hci0" "org.bluez.Adapter1" "Powered")
|
||||
{ methodCallDestination = Just "org.bluez" }
|
||||
getProperty client (methodCall btPath "org.bluez.Adapter1" "Powered")
|
||||
{ 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
|
||||
alias (Bluetooth _ _) = "bluetooth"
|
||||
alias (Bluetooth _ _) = btAlias
|
||||
rate (Bluetooth _ r) = r
|
||||
run (Bluetooth (text, colorOn, colorOff) _) = do
|
||||
client <- connectSystem
|
||||
|
|
|
|||
|
|
@ -1,6 +1,10 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Xmobar.Plugins.Device where
|
||||
module Xmobar.Plugins.Device
|
||||
( Device(..)
|
||||
, devBus
|
||||
, devPath
|
||||
) where
|
||||
|
||||
-- TOOD this name can be more general
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -23,15 +27,18 @@ import Xmobar
|
|||
data Device = Device (String, String, String, String) Int
|
||||
deriving (Read, Show)
|
||||
|
||||
busName :: BusName
|
||||
busName = "org.freedesktop.NetworkManager"
|
||||
devBus :: BusName
|
||||
devBus = "org.freedesktop.NetworkManager"
|
||||
|
||||
devPath :: ObjectPath
|
||||
devPath = "/org/freedesktop/NetworkManager"
|
||||
|
||||
getDevice :: Client -> String -> IO (Maybe ObjectPath)
|
||||
getDevice client iface = do
|
||||
let mc = methodCall "/org/freedesktop/NetworkManager"
|
||||
let mc = methodCall devPath
|
||||
"org.freedesktop.NetworkManager" "GetDeviceByIpIface"
|
||||
reply <- call client $ mc { methodCallBody = [toVariant iface]
|
||||
, methodCallDestination = Just busName
|
||||
, methodCallDestination = Just devBus
|
||||
}
|
||||
return $ case reply of
|
||||
Left _ -> Nothing
|
||||
|
|
@ -45,7 +52,7 @@ getDeviceConnected client objectPath = do
|
|||
"org.freedesktop.NetworkManager.Device"
|
||||
"Ip4Connectivity"
|
||||
either (const Nothing) (fmap ((> 1) :: Word32 -> Bool) . fromVariant)
|
||||
<$> getProperty client mc { methodCallDestination = Just busName }
|
||||
<$> getProperty client mc { methodCallDestination = Just devBus }
|
||||
|
||||
instance Exec Device where
|
||||
alias (Device (iface, _, _, _) _) = iface
|
||||
|
|
|
|||
|
|
@ -6,7 +6,10 @@
|
|||
-- Use the custom DBus interface exported by the XMonad process so I can react
|
||||
-- to signals spawned by commands
|
||||
|
||||
module Xmobar.Plugins.IntelBacklight (IntelBacklight(..)) where
|
||||
module Xmobar.Plugins.IntelBacklight
|
||||
( IntelBacklight(..)
|
||||
, blAlias
|
||||
) where
|
||||
|
||||
import Control.Concurrent
|
||||
import Control.Monad
|
||||
|
|
@ -17,8 +20,11 @@ import XMonad.Internal.DBus.IntelBacklight
|
|||
|
||||
newtype IntelBacklight = IntelBacklight String deriving (Read, Show)
|
||||
|
||||
blAlias :: String
|
||||
blAlias = "intelbacklight"
|
||||
|
||||
instance Exec IntelBacklight where
|
||||
alias (IntelBacklight _) = "intelbacklight"
|
||||
alias (IntelBacklight _) = blAlias
|
||||
start (IntelBacklight icon) cb = do
|
||||
_ <- matchSignal $ cb . formatBrightness
|
||||
cb . formatBrightness =<< callGetBrightness
|
||||
|
|
|
|||
|
|
@ -6,7 +6,10 @@
|
|||
-- Use the custom DBus interface exported by the XMonad process so I can react
|
||||
-- to signals spawned by commands
|
||||
|
||||
module Xmobar.Plugins.Screensaver (Screensaver(..)) where
|
||||
module Xmobar.Plugins.Screensaver
|
||||
( Screensaver(..)
|
||||
, ssAlias
|
||||
) where
|
||||
|
||||
import Control.Concurrent
|
||||
import Control.Monad
|
||||
|
|
@ -19,8 +22,11 @@ import XMonad.Internal.DBus.Screensaver
|
|||
newtype Screensaver = Screensaver (String, String, String)
|
||||
deriving (Read, Show)
|
||||
|
||||
ssAlias :: String
|
||||
ssAlias = "screensaver"
|
||||
|
||||
instance Exec Screensaver where
|
||||
alias (Screensaver _) = "screensaver"
|
||||
alias (Screensaver _) = ssAlias
|
||||
start (Screensaver (text, colorOn, colorOff)) cb = do
|
||||
_ <- matchSignal $ cb . fmtState
|
||||
cb . fmtState =<< callQuery
|
||||
|
|
|
|||
|
|
@ -6,7 +6,12 @@
|
|||
--
|
||||
-- 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.Client
|
||||
|
|
@ -19,12 +24,21 @@ data VPN = VPN (String, String, String) Int
|
|||
|
||||
callConnectionType :: Client -> IO (Either MethodError Variant)
|
||||
callConnectionType client =
|
||||
getProperty client (methodCall "/org/freedesktop/NetworkManager"
|
||||
getProperty client (methodCall vpnPath
|
||||
"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
|
||||
alias (VPN _ _) = "vpn"
|
||||
alias (VPN _ _) = vpnAlias
|
||||
rate (VPN _ r) = r
|
||||
run (VPN (text, colorOn, colorOff) _) = do
|
||||
client <- connectSystem
|
||||
|
|
|
|||
Loading…
Reference in New Issue