diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index 2af40c9..653d2ee 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -43,7 +43,6 @@ import XMonad.Internal.Command.Power (hasBattery)
import XMonad.Internal.DBus.Brightness.ClevoKeyboard
import XMonad.Internal.DBus.Brightness.IntelBacklight
import XMonad.Internal.DBus.Common
--- import XMonad.Internal.DBus.Control
import XMonad.Internal.DBus.Screensaver (ssSignalDep)
import XMonad.Internal.Dependency
import XMonad.Internal.Shell
@@ -155,8 +154,7 @@ batteryCmd = CmdSpec
vpnCmd :: CmdSpec
vpnCmd = CmdSpec
{ csAlias = vpnAlias
- , csRunnable = Run
- $ VPN ("\xf023", T.fgColor, T.backdropFgColor) 5
+ , csRunnable = Run $ VPN ("\xf023", T.fgColor, T.backdropFgColor)
}
btCmd :: CmdSpec
@@ -307,12 +305,11 @@ type BarFeature = Feature CmdSpec
getVPN :: Maybe Client -> BarFeature
getVPN client = Feature
- { ftrDepTree = DBusTree (Single (const vpnCmd)) client [ep] [dp]
+ { ftrDepTree = DBusTree (Single (const vpnCmd)) client [vpnDep] [dp]
, ftrName = "VPN status indicator"
, ftrWarning = Default
}
where
- ep = Endpoint vpnBus vpnPath vpnInterface $ Property_ vpnConnType
dp = IOTest vpnPresent
getBt :: Maybe Client -> BarFeature
diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs
index d9c54b5..cf08f5c 100644
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@@ -14,10 +14,10 @@ import Data.Maybe
import DBus
import DBus.Client
-import XMonad.Hooks.DynamicLog (xmobarColor)
import XMonad.Internal.DBus.Common
import XMonad.Internal.Dependency
import Xmobar
+import Xmobar.Plugins.Common
newtype Bluetooth = Bluetooth (String, String, String) deriving (Read, Show)
@@ -54,10 +54,10 @@ instance Exec Bluetooth where
start (Bluetooth (text, colorOn, colorOff)) cb = do
withDBusClientConnection_ True $ \c -> do
reply <- callGetPowered c
- cb $ maybe "N/A" chooseColor $ fromVariant =<< listToMaybe reply
+ cb $ maybe "N/A" chooseColor' $ fromVariant =<< listToMaybe reply
addMatchCallback (matchProperty btPath) (procMatch cb . matchPowered) c
where
- procMatch f (Match on) = f $ chooseColor on
+ procMatch f (Match on) = f $ chooseColor' on
procMatch f Failure = f "N/A"
procMatch _ NoMatch = return ()
- chooseColor state = xmobarColor (if state then colorOn else colorOff) "" text
+ chooseColor' = chooseColor text colorOn colorOff
diff --git a/lib/Xmobar/Plugins/Common.hs b/lib/Xmobar/Plugins/Common.hs
new file mode 100644
index 0000000..85f1538
--- /dev/null
+++ b/lib/Xmobar/Plugins/Common.hs
@@ -0,0 +1,10 @@
+
+module Xmobar.Plugins.Common
+ (chooseColor)
+ where
+
+import XMonad.Hooks.DynamicLog (xmobarColor)
+
+chooseColor :: String -> String -> String -> Bool -> String
+chooseColor text colorOn colorOff state =
+ xmobarColor (if state then colorOn else colorOff) "" text
diff --git a/lib/Xmobar/Plugins/VPN.hs b/lib/Xmobar/Plugins/VPN.hs
index f5a5dbe..1907ab4 100644
--- a/lib/Xmobar/Plugins/VPN.hs
+++ b/lib/Xmobar/Plugins/VPN.hs
@@ -1,6 +1,3 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-
--------------------------------------------------------------------------------
-- | VPN plugin
--
@@ -9,34 +6,29 @@
module Xmobar.Plugins.VPN
( VPN(..)
, vpnAlias
- , vpnBus
- , vpnPath
- , vpnInterface
- , vpnConnType
+ , vpnDep
) where
+import Data.Maybe
+
import DBus
import DBus.Client
-import XMonad.Hooks.DynamicLog (xmobarColor)
+import XMonad.Internal.DBus.Common
+import XMonad.Internal.Dependency
import Xmobar
+import Xmobar.Plugins.Common
-data VPN = VPN (String, String, String) Int
- deriving (Read, Show)
-
-callConnectionType :: Client -> IO (Either MethodError Variant)
-callConnectionType client =
- getProperty client (methodCall vpnPath vpnInterface $ memberName_ vpnConnType)
- { methodCallDestination = Just vpnBus }
+newtype VPN = VPN (String, String, String) deriving (Read, Show)
vpnBus :: BusName
-vpnBus = "org.freedesktop.NetworkManager"
+vpnBus = busName_ "org.freedesktop.NetworkManager"
vpnPath :: ObjectPath
-vpnPath = "/org/freedesktop/NetworkManager"
+vpnPath = objectPath_ "/org/freedesktop/NetworkManager"
vpnInterface :: InterfaceName
-vpnInterface = "org.freedesktop.NetworkManager"
+vpnInterface = interfaceName_ "org.freedesktop.NetworkManager"
vpnConnType :: String
vpnConnType = "PrimaryConnectionType"
@@ -44,18 +36,24 @@ vpnConnType = "PrimaryConnectionType"
vpnAlias :: String
vpnAlias = "vpn"
+vpnDep :: DBusDep
+vpnDep = Endpoint vpnBus vpnPath vpnInterface $ Property_ vpnConnType
+
+matchConnType :: [Variant] -> SignalMatch String
+matchConnType = matchPropertyChanged vpnInterface vpnConnType fromVariant
+
+callGetConnectionType :: Client -> IO [Variant]
+callGetConnectionType = callPropertyGet vpnBus vpnPath vpnInterface vpnConnType
+
instance Exec VPN where
- alias (VPN _ _) = vpnAlias
- rate (VPN _ r) = r
- run (VPN (text, colorOn, colorOff) _) = do
- client <- connectSystem
- reply <- callConnectionType client
- disconnect client
- return $ fmtState $ procReply reply
+ alias (VPN _) = vpnAlias
+ start (VPN (text, colorOn, colorOff)) cb = do
+ withDBusClientConnection_ True $ \c -> do
+ reply <- callGetConnectionType c
+ cb $ maybe "N/A" chooseColor' $ fromVariant =<< listToMaybe reply
+ addMatchCallback (matchProperty vpnPath) (procMatch cb . matchConnType) c
where
- procReply = \case
- Right r -> (fromVariant r :: Maybe String)
- Left _ -> Nothing
- fmtState = \case
- Just s -> xmobarColor (if s == "vpn" then colorOn else colorOff) "" text
- Nothing -> "N/A"
+ procMatch f (Match t) = f $ chooseColor' t
+ procMatch f Failure = f "N/A"
+ procMatch _ NoMatch = return ()
+ chooseColor' = chooseColor text colorOn colorOff . ("vpn" ==)
diff --git a/my-xmonad.cabal b/my-xmonad.cabal
index 0015084..f66fbe8 100644
--- a/my-xmonad.cabal
+++ b/my-xmonad.cabal
@@ -24,6 +24,7 @@ library
, XMonad.Internal.DBus.Control
, XMonad.Internal.DBus.Screensaver
, XMonad.Internal.Process
+ , Xmobar.Plugins.Common
, Xmobar.Plugins.BacklightCommon
, Xmobar.Plugins.Bluetooth
, Xmobar.Plugins.ClevoKeyboard