diff --git a/lib/Xmobar/Plugins/Common.hs b/lib/Xmobar/Plugins/Common.hs index 85f1538..b79da01 100644 --- a/lib/Xmobar/Plugins/Common.hs +++ b/lib/Xmobar/Plugins/Common.hs @@ -1,9 +1,29 @@ module Xmobar.Plugins.Common - (chooseColor) + ( chooseColor + , startListener + ) where -import XMonad.Hooks.DynamicLog (xmobarColor) +import DBus +import DBus.Client + +import Data.Maybe + +import XMonad.Hooks.DynamicLog (xmobarColor) +import XMonad.Internal.DBus.Common + +startListener :: IsVariant a => MatchRule -> (Client -> IO [Variant]) + -> ([Variant] -> SignalMatch a) -> (a -> String) -> (String -> IO ()) -> IO () +startListener rule getProp fromSignal toColor cb = do + withDBusClientConnection_ True $ \c -> do + reply <- getProp c + procMatch $ maybe Failure Match $ fromVariant =<< listToMaybe reply + addMatchCallback rule (procMatch . fromSignal) c + where + procMatch (Match t) = cb $ toColor t + procMatch Failure = cb "N/A" + procMatch NoMatch = return () chooseColor :: String -> String -> String -> Bool -> String chooseColor text colorOn colorOff state = diff --git a/lib/Xmobar/Plugins/VPN.hs b/lib/Xmobar/Plugins/VPN.hs index 1907ab4..2b3304b 100644 --- a/lib/Xmobar/Plugins/VPN.hs +++ b/lib/Xmobar/Plugins/VPN.hs @@ -9,10 +9,7 @@ module Xmobar.Plugins.VPN , vpnDep ) where -import Data.Maybe - import DBus -import DBus.Client import XMonad.Internal.DBus.Common import XMonad.Internal.Dependency @@ -39,21 +36,12 @@ 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 - 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 + start (VPN (text, colorOn, colorOff)) cb = + startListener rule getProp fromSignal chooseColor' cb where - procMatch f (Match t) = f $ chooseColor' t - procMatch f Failure = f "N/A" - procMatch _ NoMatch = return () + rule = matchProperty vpnPath + getProp = callPropertyGet vpnBus vpnPath vpnInterface vpnConnType + fromSignal = matchPropertyChanged vpnInterface vpnConnType fromVariant chooseColor' = chooseColor text colorOn colorOff . ("vpn" ==)