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 ++ ""