ADD vpn xmobar indicator and make bluetooth indicator rate-based
This commit is contained in:
parent
89ac1304ab
commit
ecd7d0183b
|
@ -125,11 +125,11 @@ config confDir = defaultConfig
|
||||||
|
|
||||||
, Run $ Screensaver ("<fn=1>\xf254</fn>", T.fgColor, T.backdropFgColor)
|
, 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 UnsafeStdinReader
|
||||||
|
|
||||||
, Run $ NetworkManager ("VPN", T.fgColor, T.backdropFgColor)
|
, Run $ NetworkManager ("VPN", T.fgColor, T.backdropFgColor) 5
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -3,63 +3,32 @@
|
||||||
|
|
||||||
module Xmobar.Plugins.Bluetooth where
|
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
|
||||||
import DBus.Client
|
import DBus.Client
|
||||||
import DBus.Internal.Types
|
|
||||||
|
|
||||||
import Xmobar
|
import Xmobar
|
||||||
|
|
||||||
newtype Bluetooth = Bluetooth (String, String, String) deriving (Read, Show)
|
data Bluetooth = Bluetooth (String, String, String) Int
|
||||||
|
deriving (Read, Show)
|
||||||
|
|
||||||
path :: ObjectPath
|
callGetPowered :: Client -> IO (Either MethodError Variant)
|
||||||
path = "/org/bluez/hci0"
|
callGetPowered client =
|
||||||
|
getProperty client (methodCall "/org/bluez/hci0" "org.bluez.Adapter1" "Powered")
|
||||||
interface :: InterfaceName
|
{ methodCallDestination = Just "org.bluez" }
|
||||||
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]
|
|
||||||
|
|
||||||
instance Exec Bluetooth where
|
instance Exec Bluetooth where
|
||||||
alias (Bluetooth _) = "bluetooth"
|
alias (Bluetooth _ _) = "bluetooth"
|
||||||
start (Bluetooth (text, colorOn, colorOff)) cb = do
|
rate (Bluetooth _ r) = r
|
||||||
|
run (Bluetooth (text, colorOn, colorOff) _) = do
|
||||||
client <- connectSystem
|
client <- connectSystem
|
||||||
_ <- addMatch client rule $
|
reply <- callGetPowered client
|
||||||
cb . fmtState . lookupState . getProps . signalBody
|
disconnect client
|
||||||
reply <- callBT client
|
return $ fmtState $ procReply reply
|
||||||
-- TODO handle errors?
|
|
||||||
case reply of
|
|
||||||
Right ret -> cb $ fmtState $ fromVariant =<< fromVariant
|
|
||||||
=<< listToMaybe (methodReturnBody ret)
|
|
||||||
Left _ -> return ()
|
|
||||||
forever (threadDelay 5000000)
|
|
||||||
where
|
where
|
||||||
-- Assume that the data in the PropertiesChanged signal has the form
|
procReply = \case
|
||||||
-- [something, Map, something] where the Map in the middle has the
|
-- TODO handle errors?
|
||||||
-- "Powered" text key that we care about (among other things that change
|
Right r -> fromVariant r
|
||||||
-- when the bluetooth interface is powered on)
|
Left _ -> Nothing
|
||||||
getProps = \case
|
|
||||||
[_, Variant (ValueMap TypeString TypeVariant m), _] -> Just m
|
|
||||||
_ -> Nothing
|
|
||||||
lookupState m = fromVariant =<< fromValue
|
|
||||||
=<< M.lookup (AtomText "Powered") =<< m
|
|
||||||
fmtState = \case
|
fmtState = \case
|
||||||
Just s -> wrapColor text $ if s then colorOn else colorOff
|
Just s -> wrapColor text $ if s then colorOn else colorOff
|
||||||
Nothing -> "N/A"
|
Nothing -> "N/A"
|
||||||
|
|
|
@ -3,41 +3,33 @@
|
||||||
|
|
||||||
module Xmobar.Plugins.NetworkManager where
|
module Xmobar.Plugins.NetworkManager where
|
||||||
|
|
||||||
import Control.Concurrent
|
|
||||||
import Control.Monad
|
|
||||||
|
|
||||||
import DBus
|
import DBus
|
||||||
import DBus.Client
|
import DBus.Client
|
||||||
import DBus.Internal.Types
|
|
||||||
|
|
||||||
import Xmobar
|
import Xmobar
|
||||||
|
|
||||||
newtype NetworkManager = NetworkManager (String, String, String)
|
data NetworkManager = NetworkManager (String, String, String) Int
|
||||||
deriving (Read, Show)
|
deriving (Read, Show)
|
||||||
|
|
||||||
rule :: MatchRule
|
callConnectionType :: Client -> IO (Either MethodError Variant)
|
||||||
rule = matchAny
|
callConnectionType client =
|
||||||
{ matchInterface = Just "org.freedesktop.NetworkManager.VPN.Connection"
|
getProperty client (methodCall "/org/freedesktop/NetworkManager"
|
||||||
, matchMember = Just "VpnStateChanged"
|
"org.freedesktop.NetworkManager" "PrimaryConnectionType")
|
||||||
}
|
{ methodCallDestination = Just "org.freedesktop.NetworkManager" }
|
||||||
|
|
||||||
-- 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
|
|
||||||
|
|
||||||
instance Exec NetworkManager where
|
instance Exec NetworkManager where
|
||||||
alias (NetworkManager _) = "networkmanager"
|
alias (NetworkManager _ _) = "networkmanager"
|
||||||
start (NetworkManager (text, colorOn, colorOff)) cb = do
|
rate (NetworkManager _ r) = r
|
||||||
-- start (NetworkManager _) cb = do
|
run (NetworkManager (text, colorOn, colorOff) _) = do
|
||||||
client <- connectSystem
|
client <- connectSystem
|
||||||
-- TODO initialize
|
reply <- callConnectionType client
|
||||||
_ <- addMatch client rule $ cb . fmtState . getVPNState . signalBody
|
disconnect client
|
||||||
forever (threadDelay 5000000)
|
return $ fmtState $ procReply reply
|
||||||
where
|
where
|
||||||
getVPNState = \case
|
procReply = \case
|
||||||
[Variant (ValueAtom (AtomWord32 s)), _] -> Just s
|
Right r -> (fromVariant r :: Maybe String)
|
||||||
_ -> Nothing
|
Left _ -> Nothing
|
||||||
fmtState = \case
|
fmtState = \case
|
||||||
-- state = 5 means VPN is connected
|
Just s -> wrapColor text $ if s == "vpn" then colorOn else colorOff
|
||||||
Just s -> wrapColor text $ if s == 5 then colorOn else colorOff
|
|
||||||
Nothing -> "N/A"
|
Nothing -> "N/A"
|
||||||
wrapColor s c = "<fc=" ++ c ++ ">" ++ s ++ "</fc>"
|
wrapColor s c = "<fc=" ++ c ++ ">" ++ s ++ "</fc>"
|
||||||
|
|
Loading…
Reference in New Issue