diff --git a/bin/xmobar.hs b/bin/xmobar.hs index 6acbf57..1895c12 100644 --- a/bin/xmobar.hs +++ b/bin/xmobar.hs @@ -125,11 +125,11 @@ config confDir = defaultConfig , Run $ Screensaver ("\xf254", T.fgColor, T.backdropFgColor) - , Run $ Bluetooth ("\xf293", T.fgColor, T.backdropFgColor) + , Run $ Bluetooth ("\xf293", T.fgColor, T.backdropFgColor) 5 , Run UnsafeStdinReader - , Run $ NetworkManager ("VPN", T.fgColor, T.backdropFgColor) + , Run $ NetworkManager ("VPN", T.fgColor, T.backdropFgColor) 5 ] } diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs index c66fbb3..8bca35d 100644 --- a/lib/Xmobar/Plugins/Bluetooth.hs +++ b/lib/Xmobar/Plugins/Bluetooth.hs @@ -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" diff --git a/lib/Xmobar/Plugins/NetworkManager.hs b/lib/Xmobar/Plugins/NetworkManager.hs index 19deb7c..91b51e2 100644 --- a/lib/Xmobar/Plugins/NetworkManager.hs +++ b/lib/Xmobar/Plugins/NetworkManager.hs @@ -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) - deriving (Read, Show) +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 = "" ++ s ++ ""