From 20b915631e5f7ef7e529f08a4f4daf2e55621633 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Wed, 24 Nov 2021 01:14:23 -0500
Subject: [PATCH] REF clean up code

---
 lib/Xmobar/Plugins/Common.hs | 24 ++++++++++++++++++++++--
 lib/Xmobar/Plugins/VPN.hs    | 22 +++++-----------------
 2 files changed, 27 insertions(+), 19 deletions(-)

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