ENH make xmobar check for dbus services before starting
This commit is contained in:
parent
d5d01308c2
commit
688d6ff405
257
bin/xmobar.hs
257
bin/xmobar.hs
|
@ -11,8 +11,12 @@ 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
|
||||||
|
@ -21,35 +25,186 @@ import Xmobar.Plugins.VPN
|
||||||
|
|
||||||
import XMonad (getXMonadDir)
|
import XMonad (getXMonadDir)
|
||||||
import XMonad.Hooks.DynamicLog (wrap, xmobarColor)
|
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 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"
|
|
||||||
]
|
]
|
||||||
fmtAliases = intercalate sep . map (wrap pSep pSep)
|
|
||||||
|
, 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 :: 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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue