ADD vpn xmobar indicator and make bluetooth indicator rate-based

bin/xmobar.hs

@@ -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
       ]
   }
 

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"

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