ENH make vpn plugin listen to property changed signal

This commit is contained in:
Nathan Dwarshuis 2021-11-24 00:43:58 -05:00
parent 0fe36fcccb
commit d2268da188
5 changed files with 46 additions and 40 deletions

View File

@ -43,7 +43,6 @@ import XMonad.Internal.Command.Power (hasBattery)
import XMonad.Internal.DBus.Brightness.ClevoKeyboard
import XMonad.Internal.DBus.Brightness.IntelBacklight
import XMonad.Internal.DBus.Common
-- import XMonad.Internal.DBus.Control
import XMonad.Internal.DBus.Screensaver (ssSignalDep)
import XMonad.Internal.Dependency
import XMonad.Internal.Shell
@ -155,8 +154,7 @@ batteryCmd = CmdSpec
vpnCmd :: CmdSpec
vpnCmd = CmdSpec
{ csAlias = vpnAlias
, csRunnable = Run
$ VPN ("<fn=2>\xf023</fn>", T.fgColor, T.backdropFgColor) 5
, csRunnable = Run $ VPN ("<fn=2>\xf023</fn>", T.fgColor, T.backdropFgColor)
}
btCmd :: CmdSpec
@ -307,12 +305,11 @@ type BarFeature = Feature CmdSpec
getVPN :: Maybe Client -> BarFeature
getVPN client = Feature
{ ftrDepTree = DBusTree (Single (const vpnCmd)) client [ep] [dp]
{ ftrDepTree = DBusTree (Single (const vpnCmd)) client [vpnDep] [dp]
, ftrName = "VPN status indicator"
, ftrWarning = Default
}
where
ep = Endpoint vpnBus vpnPath vpnInterface $ Property_ vpnConnType
dp = IOTest vpnPresent
getBt :: Maybe Client -> BarFeature

View File

@ -14,10 +14,10 @@ import Data.Maybe
import DBus
import DBus.Client
import XMonad.Hooks.DynamicLog (xmobarColor)
import XMonad.Internal.DBus.Common
import XMonad.Internal.Dependency
import Xmobar
import Xmobar.Plugins.Common
newtype Bluetooth = Bluetooth (String, String, String) deriving (Read, Show)
@ -54,10 +54,10 @@ instance Exec Bluetooth where
start (Bluetooth (text, colorOn, colorOff)) cb = do
withDBusClientConnection_ True $ \c -> do
reply <- callGetPowered c
cb $ maybe "N/A" chooseColor $ fromVariant =<< listToMaybe reply
cb $ maybe "N/A" chooseColor' $ fromVariant =<< listToMaybe reply
addMatchCallback (matchProperty btPath) (procMatch cb . matchPowered) c
where
procMatch f (Match on) = f $ chooseColor on
procMatch f (Match on) = f $ chooseColor' on
procMatch f Failure = f "N/A"
procMatch _ NoMatch = return ()
chooseColor state = xmobarColor (if state then colorOn else colorOff) "" text
chooseColor' = chooseColor text colorOn colorOff

View File

@ -0,0 +1,10 @@
module Xmobar.Plugins.Common
(chooseColor)
where
import XMonad.Hooks.DynamicLog (xmobarColor)
chooseColor :: String -> String -> String -> Bool -> String
chooseColor text colorOn colorOff state =
xmobarColor (if state then colorOn else colorOff) "" text

View File

@ -1,6 +1,3 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
-- | VPN plugin
--
@ -9,34 +6,29 @@
module Xmobar.Plugins.VPN
( VPN(..)
, vpnAlias
, vpnBus
, vpnPath
, vpnInterface
, vpnConnType
, vpnDep
) where
import Data.Maybe
import DBus
import DBus.Client
import XMonad.Hooks.DynamicLog (xmobarColor)
import XMonad.Internal.DBus.Common
import XMonad.Internal.Dependency
import Xmobar
import Xmobar.Plugins.Common
data VPN = VPN (String, String, String) Int
deriving (Read, Show)
callConnectionType :: Client -> IO (Either MethodError Variant)
callConnectionType client =
getProperty client (methodCall vpnPath vpnInterface $ memberName_ vpnConnType)
{ methodCallDestination = Just vpnBus }
newtype VPN = VPN (String, String, String) deriving (Read, Show)
vpnBus :: BusName
vpnBus = "org.freedesktop.NetworkManager"
vpnBus = busName_ "org.freedesktop.NetworkManager"
vpnPath :: ObjectPath
vpnPath = "/org/freedesktop/NetworkManager"
vpnPath = objectPath_ "/org/freedesktop/NetworkManager"
vpnInterface :: InterfaceName
vpnInterface = "org.freedesktop.NetworkManager"
vpnInterface = interfaceName_ "org.freedesktop.NetworkManager"
vpnConnType :: String
vpnConnType = "PrimaryConnectionType"
@ -44,18 +36,24 @@ vpnConnType = "PrimaryConnectionType"
vpnAlias :: String
vpnAlias = "vpn"
vpnDep :: DBusDep
vpnDep = Endpoint vpnBus vpnPath vpnInterface $ Property_ vpnConnType
matchConnType :: [Variant] -> SignalMatch String
matchConnType = matchPropertyChanged vpnInterface vpnConnType fromVariant
callGetConnectionType :: Client -> IO [Variant]
callGetConnectionType = callPropertyGet vpnBus vpnPath vpnInterface vpnConnType
instance Exec VPN where
alias (VPN _ _) = vpnAlias
rate (VPN _ r) = r
run (VPN (text, colorOn, colorOff) _) = do
client <- connectSystem
reply <- callConnectionType client
disconnect client
return $ fmtState $ procReply reply
alias (VPN _) = vpnAlias
start (VPN (text, colorOn, colorOff)) cb = do
withDBusClientConnection_ True $ \c -> do
reply <- callGetConnectionType c
cb $ maybe "N/A" chooseColor' $ fromVariant =<< listToMaybe reply
addMatchCallback (matchProperty vpnPath) (procMatch cb . matchConnType) c
where
procReply = \case
Right r -> (fromVariant r :: Maybe String)
Left _ -> Nothing
fmtState = \case
Just s -> xmobarColor (if s == "vpn" then colorOn else colorOff) "" text
Nothing -> "N/A"
procMatch f (Match t) = f $ chooseColor' t
procMatch f Failure = f "N/A"
procMatch _ NoMatch = return ()
chooseColor' = chooseColor text colorOn colorOff . ("vpn" ==)

View File

@ -24,6 +24,7 @@ library
, XMonad.Internal.DBus.Control
, XMonad.Internal.DBus.Screensaver
, XMonad.Internal.Process
, Xmobar.Plugins.Common
, Xmobar.Plugins.BacklightCommon
, Xmobar.Plugins.Bluetooth
, Xmobar.Plugins.ClevoKeyboard