ENH make xmobar check for dbus services before starting

bin/xmobar.hs

@@ -11,8 +11,12 @@ module Main (main) where
 -- * Theme integration with xmonad (shared module imported below)
 -- * A custom Locks plugin from my own forked repo
 
+import           Control.Monad                       (filterM)
+
 import           Data.List
 
+import           DBus
+
 import           Xmobar.Plugins.Bluetooth
 import           Xmobar.Plugins.Device
 import           Xmobar.Plugins.IntelBacklight
@@ -21,35 +25,186 @@ import           Xmobar.Plugins.VPN
 
 import           XMonad                              (getXMonadDir)
 import           XMonad.Hooks.DynamicLog             (wrap, xmobarColor)
+import           XMonad.Internal.DBus.Common         (xmonadBus)
+import           XMonad.Internal.DBus.Control        (pathExists)
+import           XMonad.Internal.DBus.IntelBacklight (blPath)
+import           XMonad.Internal.DBus.Screensaver    (ssPath)
 import qualified XMonad.Internal.Theme               as T
 import           Xmobar
 
 sep :: String
 sep = xmobarColor T.backdropFgColor "" " : "
 
-aSep :: String
+lSep :: Char
-aSep = "}{"
+lSep = '}'
+
+rSep :: Char
+rSep = '{'
 
 pSep :: String
 pSep = "%"
 
-myTemplate :: String
+data BarRegions = BarRegions
-myTemplate = formatTemplate left right
+  { brLeft   :: [CmdSpec]
+  , brCenter :: [CmdSpec]
+  , brRight  :: [CmdSpec]
+  } deriving Show
+
+data CmdSpec = CmdSpec
+  { csAlias    :: String
+  , csDepends  :: Maybe DBusDepends
+  , csRunnable :: Runnable
+  } deriving Show
+
+data DBusDepends = DBusDepends
+  { ddBus  :: BusName
+  , ddPath :: ObjectPath
+  , ddSys  :: Bool
+  } deriving Show
+
+sysDepends :: BusName -> ObjectPath -> DBusDepends
+sysDepends b p = DBusDepends b p True
+
+sesDepends :: BusName -> ObjectPath -> DBusDepends
+sesDepends b p = DBusDepends b p False
+
+concatRegions :: BarRegions -> [CmdSpec]
+concatRegions (BarRegions l c r) = l ++ c ++ r
+
+mapRegionsM :: Monad m => ([CmdSpec] -> m [CmdSpec]) -> BarRegions -> m BarRegions
+mapRegionsM f (BarRegions l c r) = do
+  l' <- f l
+  c' <- f c
+  r' <- f r
+  return $ BarRegions l' c' r'
+
+filterSpecs :: [CmdSpec] -> IO [CmdSpec]
+filterSpecs = filterM (maybe (return True) exists . csDepends)
   where
-    formatTemplate l r = fmtAliases l ++ aSep ++ fmtAliases r ++ " "
+    exists DBusDepends { ddBus = b, ddPath = p, ddSys = s } = pathExists s b p
-    left = [ "UnsafeStdinReader" ]
+
-    right = [ "wlp0s20f3wi"
+myCommands :: BarRegions
-            , "enp7s0f1"
+myCommands = BarRegions
-            , "vpn"
+  { brLeft =
-            , "bluetooth"
+    [ CmdSpec
-            , "alsa:default:Master"
+      { csAlias = "UnsafeStdinReader"
-            , "battery"
+      , csDepends = Nothing
-            , "intelbacklight"
+      , csRunnable = Run UnsafeStdinReader
-            , "screensaver"
+      }
-            , "locks"
-            , "date"
     ]
-    fmtAliases = intercalate sep . map (wrap pSep pSep)
+
+  , brCenter = []
+
+  , brRight =
+    [ CmdSpec
+      { csAlias = "wlp0s20f3wi"
+      , csDepends = Nothing
+      , csRunnable = Run
+        $ Wireless "wlp0s20f3"
+        [ "-t", "<qualityipat><essid>"
+        , "--"
+        , "--quality-icon-pattern", "<icon=wifi_%%.xpm/>"
+        ] 5
+      }
+
+    , CmdSpec
+      { csAlias = "enp7s0f1"
+      , csDepends = Just $ sysDepends devBus devPath
+      , csRunnable = Run
+        $ Device ("enp7s0f1", "<fn=2>\xf0e8</fn>", T.fgColor, T.backdropFgColor) 5
+      }
+
+    , CmdSpec
+      { csAlias = vpnAlias
+      , csDepends = Just $ sysDepends vpnBus vpnPath
+      , csRunnable = Run
+        $ VPN ("<fn=2>\xf023</fn>", T.fgColor, T.backdropFgColor) 5
+      }
+
+    , CmdSpec
+      { csAlias = btAlias
+      , csDepends = Just $ sysDepends btBus btPath
+      , csRunnable = Run
+        $ Bluetooth ("<fn=2>\xf293</fn>", T.fgColor, T.backdropFgColor) 5
+      }
+
+    , CmdSpec
+      { csAlias = "alsa:default:Master"
+      , csDepends = Nothing
+      , csRunnable = Run
+        $ Alsa "default" "Master"
+        [ "-t", "<status><volume>%"
+        , "--"
+        , "-O", "<fn=1>\xf028</fn>"
+        , "-o", "<fn=1>\xf026 </fn>"
+        , "-c", T.fgColor
+        , "-C", T.fgColor
+        ]
+      }
+
+    , CmdSpec
+      { csAlias = "battery"
+      , csDepends = Nothing
+      , csRunnable = Run
+        $ Battery
+        [ "--template", "<acstatus><left>"
+        , "--Low", "10"
+        , "--High", "80"
+        , "--low", "red"
+        , "--normal", T.fgColor
+        , "--high", T.fgColor
+        , "--"
+        , "-P"
+        , "-o" , "<fn=1>\xf0e7</fn>"
+        , "-O" , "<fn=1>\xf1e6</fn>"
+        , "-i" , "<fn=1>\xf1e6</fn>"
+        ] 50
+      }
+
+    , CmdSpec
+      { csAlias = "intelbacklight"
+      , csDepends = Just $ sesDepends xmonadBus blPath
+      , csRunnable = Run $ IntelBacklight "<fn=1>\xf185</fn>"
+      }
+
+    , CmdSpec
+      { csAlias = ssAlias
+      , csDepends = Just $ sesDepends xmonadBus ssPath
+      , csRunnable = Run
+        $ Screensaver ("<fn=1>\xf254</fn>", T.fgColor, T.backdropFgColor)
+      }
+
+    , CmdSpec
+      { csAlias = "locks"
+      , csDepends = Nothing
+      , csRunnable = Run
+        $ Locks
+        [ "-N", "<fn=3>\x1f13d</fn>"
+        , "-n", xmobarColor T.backdropFgColor "" "<fn=3>\x1f13d</fn>"
+        , "-C", "<fn=3>\x1f132</fn>"
+        , "-c", xmobarColor T.backdropFgColor "" "<fn=3>\x1f132</fn>"
+        , "-s", ""
+        , "-S", ""
+        , "-d", "<fn=3> </fn>"
+        ]
+      }
+
+    , CmdSpec
+      { csAlias = "date"
+      , csDepends = Nothing
+      , csRunnable = Run $ Date "%Y-%m-%d %H:%M:%S " "date" 10
+      }
+    ]
+  }
+
+fmtSpecs :: [CmdSpec] -> String
+fmtSpecs = intercalate sep . fmap go
+  where
+    go CmdSpec { csAlias = a } = wrap pSep pSep a
+
+fmtRegions :: BarRegions -> String
+fmtRegions BarRegions { brLeft = l, brCenter = c, brRight = r } =
+  fmtSpecs l ++ [lSep] ++ fmtSpecs c ++ [rSep] ++ fmtSpecs r
 
 barFont :: String
 barFont = T.fmtFontXFT T.font
@@ -79,8 +234,8 @@ blockFont = T.fmtFontXFT T.font
   , T.weight = Just T.Bold
   }
 
-config :: String -> Config
+config :: BarRegions -> String -> Config
-config confDir = defaultConfig
+config br confDir = defaultConfig
   { font = barFont
   , additionalFonts = [ iconFont, iconFontLarge, blockFont ]
   , textOffset = 16
@@ -92,8 +247,8 @@ config confDir = defaultConfig
   , borderColor = T.bordersColor
 
   , sepChar = pSep
-  , alignSep = aSep
+  , alignSep = [lSep, rSep]
-  , template = myTemplate
+  , template = fmtRegions br
 
   , lowerOnStart = False
   , hideOnStart = False
@@ -104,61 +259,11 @@ config confDir = defaultConfig
   -- store the icons with the xmonad/xmobar stack project
   , iconRoot = confDir ++ "/icons"
 
-  , commands =
+  , commands = csRunnable <$> concatRegions br
-      [ Run $ Alsa "default" "Master"
-        [ "-t", "<status><volume>%"
-        , "--"
-        , "-O", "<fn=1>\xf028</fn>"
-        , "-o", "<fn=1>\xf026 </fn>"
-        , "-c", T.fgColor
-        , "-C", T.fgColor
-        ]
-
-      , Run $ Battery [ "--template", "<acstatus><left>"
-                    , "--Low", "10"
-                    , "--High", "80"
-                    , "--low", "red"
-                    , "--normal", T.fgColor
-                    , "--high", T.fgColor
-                    , "--"
-                    , "-P"
-                    , "-o" , "<fn=1>\xf0e7</fn>"
-                    , "-O" , "<fn=1>\xf1e6</fn>"
-                    , "-i" , "<fn=1>\xf1e6</fn>"
-                    ] 50
-
-      , Run $ IntelBacklight "<fn=1>\xf185</fn>"
-
-      , Run $ Wireless "wlp0s20f3"
-        [ "-t", "<qualityipat><essid>"
-        , "--"
-        , "--quality-icon-pattern", "<icon=wifi_%%.xpm/>"
-        ] 5
-
-      , Run $ Device
-        ("enp7s0f1", "<fn=2>\xf0e8</fn>", T.fgColor, T.backdropFgColor) 5
-
-      , Run $ Locks
-        [ "-N", "<fn=3>\x1f13d</fn>"
-        , "-n", xmobarColor T.backdropFgColor "" "<fn=3>\x1f13d</fn>"
-        , "-C", "<fn=3>\x1f132</fn>"
-        , "-c", xmobarColor T.backdropFgColor "" "<fn=3>\x1f132</fn>"
-        , "-s", ""
-        , "-S", ""
-        , "-d", "<fn=3> </fn>"
-        ]
-
-      , Run $ Date "%Y-%m-%d %H:%M:%S" "date" 10
-
-      , Run $ Screensaver ("<fn=1>\xf254</fn>", T.fgColor, T.backdropFgColor)
-
-      , Run $ Bluetooth ("<fn=2>\xf293</fn>", T.fgColor, T.backdropFgColor) 5
-
-      , Run UnsafeStdinReader
-
-      , Run $ VPN ("<fn=2>\xf023</fn>", T.fgColor, T.backdropFgColor) 5
-      ]
   }
 
 main :: IO ()
-main = xmobar . config =<< getXMonadDir
+main = do
+  br <- mapRegionsM filterSpecs myCommands
+  dir <- getXMonadDir
+  xmobar $ config br dir

lib/XMonad/Internal/DBus/Common.hs

@@ -1,26 +1,32 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 --------------------------------------------------------------------------------
 -- | Common internal DBus functions
 
 module XMonad.Internal.DBus.Common
   ( callMethod
+  , callMethod'
   , addMatchCallback
+  , xmonadBus
   ) where
 
 import           DBus
 import           DBus.Client
 
--- TODO export the bus name (org.xmonad)
+xmonadBus :: BusName
+xmonadBus = busName_ "org.xmonad"
 
 -- | Call a method and return its result if successful
 callMethod :: MethodCall -> IO (Maybe [Variant])
 callMethod mc = do
   client <- connectSession
-  -- TODO handle clienterrors here
+  r <- callMethod' client (Just xmonadBus) mc
-  reply <- call client mc { methodCallDestination = Just "org.xmonad" }
-  -- TODO not all methods warrent that we wait for a reply?
   disconnect client
+  return r
+
+callMethod' :: Client -> Maybe BusName -> MethodCall -> IO (Maybe [Variant])
+callMethod' client bn mc = do
+  -- TODO handle clienterrors here
+  reply <- call client mc { methodCallDestination = bn }
+  -- TODO not all methods warrant that we wait for a reply? (see callNoReply)
   return $ case reply of
     Left _    -> Nothing
     Right ret -> Just $ methodReturnBody ret

lib/XMonad/Internal/DBus/Control.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 --------------------------------------------------------------------------------
 -- | High-level interface for managing XMonad's DBus
@@ -7,18 +7,30 @@ module XMonad.Internal.DBus.Control
   ( Client
   , startXMonadService
   , stopXMonadService
+  , pathExists
+  , xmonadBus
   ) where
 
+import           Data.Either
+
+import           DBus
 import           DBus.Client
 
+import           XMonad.Internal.DBus.Common
 import           XMonad.Internal.DBus.IntelBacklight
 import           XMonad.Internal.DBus.Screensaver
 import           XMonad.Internal.Shell
 
+introspectInterface :: InterfaceName
+introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
+
+introspectMethod :: MemberName
+introspectMethod = memberName_ "Introspect"
+
 startXMonadService :: IO (Client, Maybe BacklightControls, MaybeExe SSControls)
 startXMonadService = do
   client <- connectSession
-  requestResult <- requestName client "org.xmonad" []
+  requestResult <- requestName client xmonadBus []
   -- TODO if the client is not released on shutdown the owner will be
   -- different
   if requestResult /= NamePrimaryOwner then do
@@ -32,7 +44,14 @@ startXMonadService = do
 
 stopXMonadService :: Client -> IO ()
 stopXMonadService client = do
-  _ <- releaseName client "org.xmonad"
+  _ <- releaseName client xmonadBus
   disconnect client
   return ()
 
+pathExists :: Bool -> BusName -> ObjectPath -> IO Bool
+pathExists sysbus n p = do
+  client <- if sysbus then connectSystem else connectSession
+  r <- call client (methodCall p introspectInterface introspectMethod)
+       { methodCallDestination = Just n }
+  disconnect client
+  return $ isRight r

lib/XMonad/Internal/DBus/IntelBacklight.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 --------------------------------------------------------------------------------
 -- | DBus module for Intel Backlight control
 
@@ -12,6 +10,7 @@ module XMonad.Internal.DBus.IntelBacklight
   , exportIntelBacklight
   , matchSignal
   , hasBacklight
+  , blPath
   , BacklightControls(..)
   ) where
 
@@ -149,43 +148,43 @@ hasBacklight = fromRight False <$> hasBacklight'
 -- integer and emit a signal with the same brightness value. Additionally, there
 -- is one method to get the current brightness.
 
-path :: ObjectPath
+blPath :: ObjectPath
-path = "/intelbacklight"
+blPath = objectPath_ "/intelbacklight"
 
 interface :: InterfaceName
-interface = "org.xmonad.Brightness"
+interface = interfaceName_ "org.xmonad.Brightness"
 
 memCurrentBrightness :: MemberName
-memCurrentBrightness = "CurrentBrightness"
+memCurrentBrightness = memberName_ "CurrentBrightness"
 
 memGetBrightness :: MemberName
-memGetBrightness = "GetBrightness"
+memGetBrightness = memberName_ "GetBrightness"
 
 memMaxBrightness :: MemberName
-memMaxBrightness = "MaxBrightness"
+memMaxBrightness = memberName_ "MaxBrightness"
 
 memMinBrightness :: MemberName
-memMinBrightness = "MinBrightness"
+memMinBrightness = memberName_ "MinBrightness"
 
 memIncBrightness :: MemberName
-memIncBrightness = "IncBrightness"
+memIncBrightness = memberName_ "IncBrightness"
 
 memDecBrightness :: MemberName
-memDecBrightness = "DecBrightness"
+memDecBrightness = memberName_ "DecBrightness"
 
 brSignal :: Signal
-brSignal = signal path interface memCurrentBrightness
+brSignal = signal blPath interface memCurrentBrightness
   -- { signalDestination = Just "org.xmonad" }
 
 brMatcher :: MatchRule
 brMatcher = matchAny
-  { matchPath = Just path
+  { matchPath = Just blPath
   , matchInterface = Just interface
   , matchMember = Just memCurrentBrightness
   }
 
 callBacklight :: MemberName -> IO ()
-callBacklight method = void $ callMethod $ methodCall path interface method
+callBacklight method = void $ callMethod $ methodCall blPath interface method
 
 bodyGetBrightness :: [Variant] -> Maybe Brightness
 bodyGetBrightness [b] = fromVariant b :: Maybe Brightness
@@ -211,7 +210,7 @@ exportIntelBacklight' client = do
   maxval <- getMaxRawBrightness -- assume the max value will never change
   let stepsize = maxBrightness `div` steps
   let emit' = emitBrightness client
-  export client path defaultInterface
+  export client blPath defaultInterface
     { interfaceName = interface
     , interfaceMethods =
       [ autoMethod memMaxBrightness $ emit' =<< setBrightness maxval maxBrightness
@@ -245,7 +244,7 @@ callDecBrightness = callBacklight memDecBrightness
 
 callGetBrightness :: IO (Maybe Brightness)
 callGetBrightness = do
-  reply <- callMethod $ methodCall path interface memGetBrightness
+  reply <- callMethod $ methodCall blPath interface memGetBrightness
   return $ reply >>= bodyGetBrightness
 
 matchSignal :: (Maybe Brightness -> IO ()) -> IO SignalHandler

lib/XMonad/Internal/DBus/Screensaver.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 --------------------------------------------------------------------------------
 -- | DBus module for X11 screensave/DPMS control
 
@@ -8,6 +6,7 @@ module XMonad.Internal.DBus.Screensaver
   , callToggle
   , callQuery
   , matchSignal
+  , ssPath
   , SSControls(..)
   ) where
 
@@ -56,27 +55,27 @@ query = do
 -- with the new state when called. Define another method to get the current
 -- state.
 
-path :: ObjectPath
+ssPath :: ObjectPath
-path = "/screensaver"
+ssPath = objectPath_ "/screensaver"
 
 interface :: InterfaceName
-interface = "org.xmonad.Screensaver"
+interface = interfaceName_ "org.xmonad.Screensaver"
 
 memState :: MemberName
-memState = "State"
+memState = memberName_ "State"
 
 memToggle :: MemberName
-memToggle = "Toggle"
+memToggle = memberName_ "Toggle"
 
 memQuery :: MemberName
-memQuery = "Query"
+memQuery = memberName_ "Query"
 
 sigCurrentState :: Signal
-sigCurrentState = signal path interface memState
+sigCurrentState = signal ssPath interface memState
 
 ruleCurrentState :: MatchRule
 ruleCurrentState = matchAny
-  { matchPath = Just path
+  { matchPath = Just ssPath
   , matchInterface = Just interface
   , matchMember = Just memState
   }
@@ -103,7 +102,7 @@ exportScreensaver client = do
 
 exportScreensaver' :: Client -> IO SSControls
 exportScreensaver' client = do
-  export client path defaultInterface
+  export client ssPath defaultInterface
     { interfaceName = interface
     , interfaceMethods =
       [ autoMethod memToggle $ emitState client =<< toggle
@@ -113,11 +112,11 @@ exportScreensaver' client = do
   return $ SSControls { ssToggle = callToggle }
 
 callToggle :: IO ()
-callToggle = void $ callMethod $ methodCall path interface memToggle
+callToggle = void $ callMethod $ methodCall ssPath interface memToggle
 
 callQuery :: IO (Maybe SSState)
 callQuery = do
-  reply <- callMethod $ methodCall path interface memQuery
+  reply <- callMethod $ methodCall ssPath interface memQuery
   return $ reply >>= bodyGetCurrentState
 
 matchSignal :: (Maybe SSState -> IO ()) -> IO SignalHandler

lib/Xmobar/Plugins/Bluetooth.hs

@@ -6,7 +6,12 @@
 --
 -- Use the bluez interface on DBus to check status
 
-module Xmobar.Plugins.Bluetooth (Bluetooth(..)) where
+module Xmobar.Plugins.Bluetooth
+  ( Bluetooth(..)
+  , btAlias
+  , btBus
+  , btPath
+  ) where
 
 import           DBus
 import           DBus.Client
@@ -19,11 +24,21 @@ data Bluetooth = Bluetooth (String, String, String) Int
 
 callGetPowered :: Client -> IO (Either MethodError Variant)
 callGetPowered client =
-  getProperty client (methodCall "/org/bluez/hci0" "org.bluez.Adapter1" "Powered")
+  getProperty client (methodCall btPath "org.bluez.Adapter1" "Powered")
-    { methodCallDestination = Just "org.bluez" }
+    { methodCallDestination = Just btBus }
+
+btBus :: BusName
+btBus = "org.bluez"
+
+-- TODO this feels like something that shouldn't be hardcoded
+btPath :: ObjectPath
+btPath = "/org/bluez/hci0"
+
+btAlias :: String
+btAlias = "bluetooth"
 
 instance Exec Bluetooth where
-  alias (Bluetooth _ _) = "bluetooth"
+  alias (Bluetooth _ _) = btAlias
   rate  (Bluetooth _ r) = r
   run   (Bluetooth (text, colorOn, colorOff) _) = do
     client <- connectSystem

lib/Xmobar/Plugins/Device.hs

@@ -1,6 +1,10 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Xmobar.Plugins.Device where
+module Xmobar.Plugins.Device
+  ( Device(..)
+  , devBus
+  , devPath
+  ) where
 
 -- TOOD this name can be more general
 --------------------------------------------------------------------------------
@@ -23,15 +27,18 @@ import           Xmobar
 data Device = Device (String, String, String, String) Int
     deriving (Read, Show)
 
-busName :: BusName
+devBus :: BusName
-busName = "org.freedesktop.NetworkManager"
+devBus = "org.freedesktop.NetworkManager"
+
+devPath :: ObjectPath
+devPath = "/org/freedesktop/NetworkManager"
 
 getDevice :: Client -> String -> IO (Maybe ObjectPath)
 getDevice client iface = do
-  let mc = methodCall "/org/freedesktop/NetworkManager"
+  let mc = methodCall devPath
         "org.freedesktop.NetworkManager" "GetDeviceByIpIface"
   reply <- call client $ mc { methodCallBody = [toVariant iface]
-                            , methodCallDestination = Just busName
+                            , methodCallDestination = Just devBus
                             }
   return $ case reply of
     Left _  -> Nothing
@@ -45,7 +52,7 @@ getDeviceConnected client objectPath = do
            "org.freedesktop.NetworkManager.Device"
            "Ip4Connectivity"
   either (const Nothing) (fmap ((> 1) :: Word32 -> Bool) . fromVariant)
-    <$> getProperty client mc { methodCallDestination = Just busName }
+    <$> getProperty client mc { methodCallDestination = Just devBus }
 
 instance Exec Device where
   alias (Device (iface, _, _, _) _) = iface

lib/Xmobar/Plugins/IntelBacklight.hs

@@ -6,7 +6,10 @@
 -- Use the custom DBus interface exported by the XMonad process so I can react
 -- to signals spawned by commands
 
-module Xmobar.Plugins.IntelBacklight (IntelBacklight(..)) where
+module Xmobar.Plugins.IntelBacklight
+  ( IntelBacklight(..)
+  , blAlias
+  ) where
 
 import           Control.Concurrent
 import           Control.Monad
@@ -17,8 +20,11 @@ import           XMonad.Internal.DBus.IntelBacklight
 
 newtype IntelBacklight = IntelBacklight String deriving (Read, Show)
 
+blAlias :: String
+blAlias = "intelbacklight"
+
 instance Exec IntelBacklight where
-  alias (IntelBacklight _) = "intelbacklight"
+  alias (IntelBacklight _) = blAlias
   start (IntelBacklight icon) cb = do
     _ <- matchSignal $ cb . formatBrightness
     cb . formatBrightness =<< callGetBrightness

lib/Xmobar/Plugins/Screensaver.hs

@@ -6,7 +6,10 @@
 -- Use the custom DBus interface exported by the XMonad process so I can react
 -- to signals spawned by commands
 
-module Xmobar.Plugins.Screensaver (Screensaver(..)) where
+module Xmobar.Plugins.Screensaver
+  ( Screensaver(..)
+  , ssAlias
+  ) where
 
 import           Control.Concurrent
 import           Control.Monad
@@ -19,8 +22,11 @@ import           XMonad.Internal.DBus.Screensaver
 newtype Screensaver = Screensaver (String, String, String)
     deriving (Read, Show)
 
+ssAlias :: String
+ssAlias = "screensaver"
+
 instance Exec Screensaver where
-    alias (Screensaver _) = "screensaver"
+    alias (Screensaver _) = ssAlias
     start (Screensaver (text, colorOn, colorOff)) cb = do
       _ <- matchSignal $ cb . fmtState
       cb . fmtState =<< callQuery

lib/Xmobar/Plugins/VPN.hs

@@ -6,7 +6,12 @@
 --
 -- Use the NetworkManger interface on DBus to check status
 
-module Xmobar.Plugins.VPN (VPN(..)) where
+module Xmobar.Plugins.VPN
+  ( VPN(..)
+  , vpnAlias
+  , vpnBus
+  , vpnPath
+  ) where
 
 import           DBus
 import           DBus.Client
@@ -19,12 +24,21 @@ data VPN = VPN (String, String, String) Int
 
 callConnectionType :: Client -> IO (Either MethodError Variant)
 callConnectionType client =
-  getProperty client (methodCall "/org/freedesktop/NetworkManager"
+  getProperty client (methodCall vpnPath
                       "org.freedesktop.NetworkManager" "PrimaryConnectionType")
-    { methodCallDestination = Just "org.freedesktop.NetworkManager" }
+    { methodCallDestination = Just vpnBus }
+
+vpnBus :: BusName
+vpnBus = "org.freedesktop.NetworkManager"
+
+vpnPath :: ObjectPath
+vpnPath = "/org/freedesktop/NetworkManager"
+
+vpnAlias :: String
+vpnAlias = "vpn"
 
 instance Exec VPN where
-  alias (VPN _ _) = "vpn"
+  alias (VPN _ _) = vpnAlias
   rate  (VPN _ r) = r
   run   (VPN (text, colorOn, colorOff) _) = do
     client <- connectSystem