ADD vpn xmobar indicator and make bluetooth indicator rate-based

This commit is contained in:
Nathan Dwarshuis 2020-03-22 01:10:02 -04:00
parent 89ac1304ab
commit ecd7d0183b
3 changed files with 35 additions and 74 deletions

View File

@ -125,11 +125,11 @@ config confDir = defaultConfig
, Run $ Screensaver ("<fn=1>\xf254</fn>", T.fgColor, T.backdropFgColor)
, Run $ Bluetooth ("<fn=1>\xf293</fn>", T.fgColor, T.backdropFgColor)
, Run $ Bluetooth ("<fn=1>\xf293</fn>", T.fgColor, T.backdropFgColor) 5
, Run UnsafeStdinReader
, Run $ NetworkManager ("VPN", T.fgColor, T.backdropFgColor)
, Run $ NetworkManager ("VPN", T.fgColor, T.backdropFgColor) 5
]
}

View File

@ -3,63 +3,32 @@
module Xmobar.Plugins.Bluetooth where
import Control.Concurrent
import Control.Monad
import qualified Data.Map.Lazy as M
import Data.Maybe
import DBus
import DBus.Client
import DBus.Internal.Types
import Xmobar
newtype Bluetooth = Bluetooth (String, String, String) deriving (Read, Show)
data Bluetooth = Bluetooth (String, String, String) Int
deriving (Read, Show)
path :: ObjectPath
path = "/org/bluez/hci0"
interface :: InterfaceName
interface = "org.freedesktop.DBus.Properties"
rule :: MatchRule
rule = matchAny
{ matchPath = Just path
, matchInterface = Just interface
, matchMember = Just "PropertiesChanged"
}
callBT :: Client -> IO (Either MethodError MethodReturn)
callBT client =
call client (methodCall path interface "Get")
{ methodCallDestination = Just "org.bluez", methodCallBody = body }
where
body = map toVariant ["org.bluez.Adapter1", "Powered" :: String]
callGetPowered :: Client -> IO (Either MethodError Variant)
callGetPowered client =
getProperty client (methodCall "/org/bluez/hci0" "org.bluez.Adapter1" "Powered")
{ methodCallDestination = Just "org.bluez" }
instance Exec Bluetooth where
alias (Bluetooth _) = "bluetooth"
start (Bluetooth (text, colorOn, colorOff)) cb = do
alias (Bluetooth _ _) = "bluetooth"
rate (Bluetooth _ r) = r
run (Bluetooth (text, colorOn, colorOff) _) = do
client <- connectSystem
_ <- addMatch client rule $
cb . fmtState . lookupState . getProps . signalBody
reply <- callBT client
-- TODO handle errors?
case reply of
Right ret -> cb $ fmtState $ fromVariant =<< fromVariant
=<< listToMaybe (methodReturnBody ret)
Left _ -> return ()
forever (threadDelay 5000000)
reply <- callGetPowered client
disconnect client
return $ fmtState $ procReply reply
where
-- Assume that the data in the PropertiesChanged signal has the form
-- [something, Map, something] where the Map in the middle has the
-- "Powered" text key that we care about (among other things that change
-- when the bluetooth interface is powered on)
getProps = \case
[_, Variant (ValueMap TypeString TypeVariant m), _] -> Just m
_ -> Nothing
lookupState m = fromVariant =<< fromValue
=<< M.lookup (AtomText "Powered") =<< m
procReply = \case
-- TODO handle errors?
Right r -> fromVariant r
Left _ -> Nothing
fmtState = \case
Just s -> wrapColor text $ if s then colorOn else colorOff
Nothing -> "N/A"

View File

@ -3,41 +3,33 @@
module Xmobar.Plugins.NetworkManager where
import Control.Concurrent
import Control.Monad
import DBus
import DBus.Client
import DBus.Internal.Types
import Xmobar
newtype NetworkManager = NetworkManager (String, String, String)
data NetworkManager = NetworkManager (String, String, String) Int
deriving (Read, Show)
rule :: MatchRule
rule = matchAny
{ matchInterface = Just "org.freedesktop.NetworkManager.VPN.Connection"
, matchMember = Just "VpnStateChanged"
}
-- TODO would polling be better for this? Using events means that we need
-- to catch all of them perfectly to stay synchronized...which *might* happen
callConnectionType :: Client -> IO (Either MethodError Variant)
callConnectionType client =
getProperty client (methodCall "/org/freedesktop/NetworkManager"
"org.freedesktop.NetworkManager" "PrimaryConnectionType")
{ methodCallDestination = Just "org.freedesktop.NetworkManager" }
instance Exec NetworkManager where
alias (NetworkManager _) = "networkmanager"
start (NetworkManager (text, colorOn, colorOff)) cb = do
-- start (NetworkManager _) cb = do
alias (NetworkManager _ _) = "networkmanager"
rate (NetworkManager _ r) = r
run (NetworkManager (text, colorOn, colorOff) _) = do
client <- connectSystem
-- TODO initialize
_ <- addMatch client rule $ cb . fmtState . getVPNState . signalBody
forever (threadDelay 5000000)
reply <- callConnectionType client
disconnect client
return $ fmtState $ procReply reply
where
getVPNState = \case
[Variant (ValueAtom (AtomWord32 s)), _] -> Just s
_ -> Nothing
procReply = \case
Right r -> (fromVariant r :: Maybe String)
Left _ -> Nothing
fmtState = \case
-- state = 5 means VPN is connected
Just s -> wrapColor text $ if s == 5 then colorOn else colorOff
Just s -> wrapColor text $ if s == "vpn" then colorOn else colorOff
Nothing -> "N/A"
wrapColor s c = "<fc=" ++ c ++ ">" ++ s ++ "</fc>"