REF overload internal dbus functions

bin/xmobar.hs

@@ -11,6 +11,8 @@ module Main (main) where
 -- * Theme integration with xmonad (shared module imported below)
 -- * A custom Locks plugin from my own forked repo
 
+import           Data.Internal.DBus
+import           Data.Internal.Dependency
 import           Data.List
 import           Data.Maybe
 
@@ -38,7 +40,6 @@ import           XMonad.Internal.DBus.Brightness.ClevoKeyboard
 import           XMonad.Internal.DBus.Brightness.IntelBacklight
 import           XMonad.Internal.DBus.Control
 import           XMonad.Internal.DBus.Screensaver               (ssSignalDep)
-import           XMonad.Internal.Dependency
 import           XMonad.Internal.Process
     ( proc'
     , readCreateProcessWithExitCode'

bin/xmonad.hs

@@ -10,6 +10,8 @@ import           Control.Concurrent
 import           Control.Concurrent.Lifted                      (fork)
 import           Control.Monad
 
+import           Data.Internal.DBus
+import           Data.Internal.Dependency
 import           Data.List
     ( intercalate
     , isPrefixOf
@@ -53,7 +55,6 @@ import           XMonad.Internal.DBus.Brightness.IntelBacklight
 import           XMonad.Internal.DBus.Control
 import           XMonad.Internal.DBus.Removable
 import           XMonad.Internal.DBus.Screensaver
-import           XMonad.Internal.Dependency
 import           XMonad.Internal.Process
 import           XMonad.Internal.Shell
 import qualified XMonad.Internal.Theme                          as T

lib/Data/Internal/DBus.hs

@@ -1,12 +1,11 @@
 --------------------------------------------------------------------------------
 -- | Common internal DBus functions
 
-module DBus.Internal
+module Data.Internal.DBus
-  ( addMatchCallback
+  ( SafeClient(..)
-  -- , getDBusClient
+  , SysClient(..)
-  -- , fromDBusClient
+  , SesClient(..)
-  -- , withDBusClient
+  , addMatchCallback
-  -- , withDBusClient_
   , matchProperty
   , matchPropertyFull
   , matchPropertyChanged
@@ -28,26 +27,70 @@ module DBus.Internal
   , bodyToMaybe
   ) where
 
--- import           Control.Exception
+import           Control.Exception
 import           Control.Monad
 
 import           Data.Bifunctor
-import qualified Data.Map.Strict as M
+import qualified Data.Map.Strict   as M
 import           Data.Maybe
 
 import           DBus
 import           DBus.Client
 
+--------------------------------------------------------------------------------
+-- | Type-safe client
+
+class SafeClient c where
+  toClient :: c -> Client
+
+  getDBusClient :: IO (Maybe c)
+
+  withDBusClient :: (c -> IO a) -> IO (Maybe a)
+  withDBusClient f = do
+    client <- getDBusClient
+    forM client $ \c -> do
+      r <- f c
+      disconnect (toClient c)
+      return r
+
+  withDBusClient_ :: (c -> IO ()) -> IO ()
+  withDBusClient_ = void . withDBusClient
+
+  fromDBusClient :: (c -> a) -> IO (Maybe a)
+  fromDBusClient f = withDBusClient (return . f)
+
+newtype SysClient = SysClient Client
+
+instance SafeClient SysClient where
+  toClient (SysClient cl) = cl
+
+  getDBusClient = fmap SysClient <$> getDBusClient' True
+
+newtype SesClient = SesClient Client
+
+instance SafeClient SesClient where
+  toClient (SesClient cl) = cl
+
+  getDBusClient = fmap SesClient <$> getDBusClient' False
+
+getDBusClient' :: Bool -> IO (Maybe Client)
+getDBusClient' sys = do
+  res <- try $ if sys then connectSystem else connectSession
+  case res of
+    Left e  -> putStrLn (clientErrorMessage e) >> return Nothing
+    Right c -> return $ Just c
+
 --------------------------------------------------------------------------------
 -- | Methods
 
 type MethodBody = Either String [Variant]
 
-callMethod' :: Client -> MethodCall -> IO MethodBody
+callMethod' :: SafeClient c => c -> MethodCall -> IO MethodBody
-callMethod' cl = fmap (bimap methodErrorMessage methodReturnBody) . call cl
+callMethod' cl = fmap (bimap methodErrorMessage methodReturnBody)
+  . call (toClient cl)
 
-callMethod :: Client -> BusName -> ObjectPath -> InterfaceName -> MemberName
+callMethod :: SafeClient c => c -> BusName -> ObjectPath -> InterfaceName
-  -> IO MethodBody
+  -> MemberName -> IO MethodBody
 callMethod client bus path iface = callMethod' client . methodCallBus bus path iface
 
 methodCallBus :: BusName -> ObjectPath -> InterfaceName -> MemberName -> MethodCall
@@ -60,8 +103,8 @@ methodCallBus b p i m = (methodCall p i m)
 dbusInterface :: InterfaceName
 dbusInterface = interfaceName_ "org.freedesktop.DBus"
 
-callGetNameOwner :: Client -> BusName -> IO (Maybe BusName)
+callGetNameOwner :: SafeClient c => c -> BusName -> IO (Maybe BusName)
-callGetNameOwner client name = bodyToMaybe <$> callMethod' client mc
+callGetNameOwner cl name = bodyToMaybe <$> callMethod' cl mc
   where
     mc = (methodCallBus dbusName dbusPath dbusInterface mem)
       { methodCallBody = [toVariant name] }
@@ -81,8 +124,9 @@ bodyToMaybe = either (const Nothing) fromSingletonVariant
 
 type SignalCallback = [Variant] -> IO ()
 
-addMatchCallback :: MatchRule -> SignalCallback -> Client -> IO SignalHandler
+addMatchCallback :: SafeClient c => MatchRule -> SignalCallback -> c
-addMatchCallback rule cb client = addMatch client rule $ cb . signalBody
+  -> IO SignalHandler
+addMatchCallback rule cb cl = addMatch (toClient cl) rule $ cb . signalBody
 
 matchSignal :: Maybe BusName -> Maybe ObjectPath -> Maybe InterfaceName
   -> Maybe MemberName -> MatchRule
@@ -93,8 +137,8 @@ matchSignal b p i m = matchAny
   , matchMember = m
   }
 
-matchSignalFull :: Client -> BusName -> Maybe ObjectPath -> Maybe InterfaceName
+matchSignalFull :: SafeClient c => c -> BusName -> Maybe ObjectPath
-  -> Maybe MemberName -> IO (Maybe MatchRule)
+  -> Maybe InterfaceName -> Maybe MemberName -> IO (Maybe MatchRule)
 matchSignalFull client b p i m =
   fmap (\o -> matchSignal (Just o) p i m) <$> callGetNameOwner client b
 
@@ -107,18 +151,19 @@ propertyInterface = interfaceName_ "org.freedesktop.DBus.Properties"
 propertySignal :: MemberName
 propertySignal = memberName_ "PropertiesChanged"
 
-callPropertyGet :: BusName -> ObjectPath -> InterfaceName -> MemberName -> Client
+callPropertyGet :: SafeClient c => BusName -> ObjectPath -> InterfaceName
-  -> IO [Variant]
+  -> MemberName -> c -> IO [Variant]
-callPropertyGet bus path iface property client = fmap (either (const []) (:[]))
+callPropertyGet bus path iface property cl = fmap (either (const []) (:[]))
-  $ getProperty client $ methodCallBus bus path iface property
+  $ getProperty (toClient cl) $ methodCallBus bus path iface property
 
 matchProperty :: Maybe BusName -> Maybe ObjectPath -> MatchRule
 matchProperty b p =
   matchSignal b p (Just propertyInterface) (Just propertySignal)
 
-matchPropertyFull :: Client -> BusName -> Maybe ObjectPath -> IO (Maybe MatchRule)
+matchPropertyFull :: SafeClient c => c -> BusName -> Maybe ObjectPath
-matchPropertyFull client b p =
+  -> IO (Maybe MatchRule)
-  matchSignalFull client b p (Just propertyInterface) (Just propertySignal)
+matchPropertyFull cl b p =
+  matchSignalFull cl b p (Just propertyInterface) (Just propertySignal)
 
 data SignalMatch a = Match a | NoMatch | Failure deriving (Eq, Show)
 
@@ -141,30 +186,6 @@ matchPropertyChanged iface property [i, body, _] =
     toMap v = fromVariant v :: Maybe (M.Map String Variant)
 matchPropertyChanged _ _ _ = Failure
 
---------------------------------------------------------------------------------
--- | Client requests
-
--- getDBusClient :: Bool -> IO (Maybe Client)
--- getDBusClient sys = do
---   res <- try $ if sys then connectSystem else connectSession
---   case res of
---     Left e  -> putStrLn (clientErrorMessage e) >> return Nothing
---     Right c -> return $ Just c
-
--- withDBusClient :: Bool -> (c -> IO a) -> IO (Maybe a)
--- withDBusClient sys f = do
---   client <- getDBusClient sys
---   forM client $ \c -> do
---     r <- f c
---     disconnect c
---     return r
-
--- withDBusClient_ :: Bool -> (Client -> IO ()) -> IO ()
--- withDBusClient_ sys = void . withDBusClient sys
-
--- fromDBusClient :: Bool -> (Client -> a) -> IO (Maybe a)
--- fromDBusClient sys f = withDBusClient sys (return . f)
-
 --------------------------------------------------------------------------------
 -- | Object Manager
 
@@ -182,23 +203,24 @@ omInterfacesAdded = memberName_ "InterfacesAdded"
 omInterfacesRemoved :: MemberName
 omInterfacesRemoved = memberName_ "InterfacesRemoved"
 
-callGetManagedObjects :: Client -> BusName -> ObjectPath -> IO ObjectTree
+callGetManagedObjects :: SafeClient c => c -> BusName -> ObjectPath
-callGetManagedObjects client bus path =
+  -> IO ObjectTree
+callGetManagedObjects cl bus path =
   either (const M.empty) (fromMaybe M.empty . fromSingletonVariant)
-  <$> callMethod client bus path omInterface getManagedObjects
+  <$> callMethod cl bus path omInterface getManagedObjects
 
-addInterfaceChangedListener :: BusName -> MemberName -> ObjectPath
+addInterfaceChangedListener :: SafeClient c => BusName -> MemberName
-  -> SignalCallback -> Client -> IO (Maybe SignalHandler)
+  -> ObjectPath -> SignalCallback -> c -> IO (Maybe SignalHandler)
-addInterfaceChangedListener bus prop path sc client = do
+addInterfaceChangedListener bus prop path sc cl = do
-  rule <- matchSignalFull client bus (Just path) (Just omInterface) (Just prop)
+  rule <- matchSignalFull cl bus (Just path) (Just omInterface) (Just prop)
-  forM rule $ \r -> addMatchCallback r sc client
+  forM rule $ \r -> addMatchCallback r sc cl
 
-addInterfaceAddedListener :: BusName -> ObjectPath -> SignalCallback -> Client
+addInterfaceAddedListener :: SafeClient c => BusName -> ObjectPath
-  -> IO (Maybe SignalHandler)
+  -> SignalCallback -> c -> IO (Maybe SignalHandler)
 addInterfaceAddedListener bus =
   addInterfaceChangedListener bus omInterfacesAdded
 
-addInterfaceRemovedListener :: BusName -> ObjectPath -> SignalCallback -> Client
+addInterfaceRemovedListener :: SafeClient c => BusName -> ObjectPath
-  -> IO (Maybe SignalHandler)
+  -> SignalCallback -> c -> IO (Maybe SignalHandler)
 addInterfaceRemovedListener bus =
   addInterfaceChangedListener bus omInterfacesRemoved

lib/Data/Internal/Dependency.hs

@@ -8,7 +8,7 @@
 --------------------------------------------------------------------------------
 -- | Functions for handling dependencies
 
-module XMonad.Internal.Dependency
+module Data.Internal.Dependency
   -- feature types
   ( Feature
   , Always(..)
@@ -41,8 +41,6 @@ module XMonad.Internal.Dependency
   , DBusTree
   , DBusTree_
   , SafeClient(..)
-  , SysClient(..)
-  , SesClient(..)
   , IODependency(..)
   , IODependency_(..)
   , SystemDependency(..)
@@ -112,7 +110,6 @@ module XMonad.Internal.Dependency
   , shellTest
   ) where
 
-import           Control.Exception       hiding (bracket)
 import           Control.Monad.IO.Class
 import           Control.Monad.Identity
 import           Control.Monad.Reader
@@ -124,6 +121,7 @@ import           Data.Bifunctor
 import           Data.Either
 import qualified Data.HashMap.Strict     as H
 import           Data.Hashable
+import           Data.Internal.DBus
 import           Data.List
 import           Data.Maybe
 import           Data.Yaml
@@ -132,8 +130,6 @@ import           GHC.Generics            (Generic)
 import           GHC.IO.Exception        (ioe_description)
 
 import           DBus                    hiding (typeOf)
-import           DBus.Client
-import           DBus.Internal
 import qualified DBus.Introspection      as I
 
 import           System.Directory
@@ -300,47 +296,6 @@ data Root a = forall p. IORoot (p -> a) (IOTree p)
   | forall c p. SafeClient c => DBusRoot (p -> c -> a) (DBusTree c p) (Maybe c)
   | forall c. SafeClient c => DBusRoot_ (c -> a) (DBusTree_ c) (Maybe c)
 
-class SafeClient c where
-  toClient :: c -> Client
-
-  getDBusClient :: IO (Maybe c)
-
-  withDBusClient :: (c -> IO a) -> IO (Maybe a)
-  withDBusClient f = do
-    client <- getDBusClient
-    forM client $ \c -> do
-      r <- f c
-      disconnect (toClient c)
-      return r
-
-  withDBusClient_ :: (c -> IO ()) -> IO ()
-  withDBusClient_ = void . withDBusClient
-
-  fromDBusClient :: (c -> a) -> IO (Maybe a)
-  fromDBusClient f = withDBusClient (return . f)
-
-newtype SysClient = SysClient Client
-
-instance SafeClient SysClient where
-  toClient (SysClient cl) = cl
-
-  getDBusClient = fmap SysClient <$> getDBusClient' True
-
-newtype SesClient = SesClient Client
-
-instance SafeClient SesClient where
-  toClient (SesClient cl) = cl
-
-  getDBusClient = fmap SesClient <$> getDBusClient' False
-
-getDBusClient' :: Bool -> IO (Maybe Client)
-getDBusClient' sys = do
-  res <- try $ if sys then connectSystem else connectSession
-  case res of
-    Left e  -> putStrLn (clientErrorMessage e) >> return Nothing
-    Right c -> return $ Just c
-
-
 -- | The dependency tree with rule to merge results when needed
 data Tree d d_ p =
   forall x y. And12 (x -> y -> p) (Tree d d_ x) (Tree d d_ y)
@@ -937,7 +892,7 @@ testDBusDependency_ = testDBusDependency'_
 
 testDBusDependency'_ :: SafeClient c => c -> DBusDependency_ c -> FIO Result_
 testDBusDependency'_ cl (Bus _ bus) = io $ do
-  ret <- callMethod (toClient cl) queryBus queryPath queryIface queryMem
+  ret <- callMethod cl queryBus queryPath queryIface queryMem
   return $ case ret of
         Left e    -> Left [Msg Error e]
         Right b -> let ns = bodyGetNames b in
@@ -955,7 +910,7 @@ testDBusDependency'_ cl (Bus _ bus) = io $ do
     bodyGetNames _   = []
 
 testDBusDependency'_ cl (Endpoint _ busname objpath iface mem) = io $ do
-  ret <- callMethod (toClient cl) busname objpath introspectInterface introspectMethod
+  ret <- callMethod cl busname objpath introspectInterface introspectMethod
   return $ case ret of
         Left e     -> Left [Msg Error e]
         Right body -> procBody body
@@ -1055,7 +1010,7 @@ sometimesEndpoint fn name ful busname path iface mem cl =
   sometimesDBus cl fn name deps cmd
   where
     deps = Only_ $ Endpoint ful busname path iface $ Method_ mem
-    cmd c = io $ void $ callMethod (toClient c) busname path iface mem
+    cmd c = io $ void $ callMethod c busname path iface mem
 
 --------------------------------------------------------------------------------
 -- | Dependency Tree Constructors
@@ -1395,23 +1350,3 @@ bracket s = "[" ++ s ++ "]"
 
 curly :: String -> String
 curly s = "{" ++ s ++ "}"
-
---------------------------------------------------------------------------------
--- | Other random formatting
-
--- failedMsgsIO :: Bool -> String -> [SubfeatureFail] -> FIO [Msg]
--- failedMsgsIO err fn = io . failedMsgs err fn
-
--- failedMsgs :: Bool -> String -> [SubfeatureFail] -> IO [Msg]
--- failedMsgs err fn = fmap concat . mapM (failedMsg err fn)
-
--- failedMsg :: Bool -> String -> SubfeatureFail -> IO [Msg]
--- failedMsg err fn Subfeature { sfData = d, sfName = n } = do
---   mapM (fmtMsg err fn n) $ case d of (PostMissing e) -> [e]; (PostFail es) -> es
-
--- fmtMsg :: Bool -> String -> String -> Msg -> IO Msg
--- fmtMsg err fn n msg = do
---   let e = if err then "ERROR" else "WARNING"
---   p <- getProgName
---   return $ unwords [bracket p, bracket e, bracket fn, bracket n, msg]
-

lib/XMonad/Internal/Command/DMenu.hs

@@ -17,6 +17,9 @@ module XMonad.Internal.Command.DMenu
 
 import           Control.Monad.Reader
 
+import           Data.Internal.DBus
+import           Data.Internal.Dependency
+
 import           DBus
 
 import           Graphics.X11.Types
@@ -30,7 +33,6 @@ import           System.IO
 import           XMonad.Core                     hiding (spawn)
 import           XMonad.Internal.Command.Desktop
 import           XMonad.Internal.DBus.Common
-import           XMonad.Internal.Dependency
 import           XMonad.Internal.Notify
 import           XMonad.Internal.Process
 import           XMonad.Internal.Shell

lib/XMonad/Internal/Command/Desktop.hs

@@ -42,6 +42,9 @@ module XMonad.Internal.Command.Desktop
 import           Control.Monad               (void)
 import           Control.Monad.IO.Class
 
+import           Data.Internal.DBus
+import           Data.Internal.Dependency
+
 import           DBus
 
 import           System.Directory
@@ -53,7 +56,6 @@ import           XMonad                      (asks)
 import           XMonad.Actions.Volume
 import           XMonad.Core                 hiding (spawn)
 import           XMonad.Internal.DBus.Common
-import           XMonad.Internal.Dependency
 import           XMonad.Internal.Notify
 import           XMonad.Internal.Process
 import           XMonad.Internal.Shell

lib/XMonad/Internal/Command/Power.hs

@@ -27,6 +27,8 @@ module XMonad.Internal.Command.Power
 
 import           Control.Arrow               (first)
 
+import           Data.Internal.Dependency
+
 import           Data.Either
 import qualified Data.Map                    as M
 
@@ -39,7 +41,6 @@ import           System.IO.Error
 import           System.Process              (ProcessHandle)
 
 import           XMonad.Core
-import           XMonad.Internal.Dependency
 import           XMonad.Internal.Process     (spawnPipeArgs)
 import           XMonad.Internal.Shell
 import qualified XMonad.Internal.Theme       as T

lib/XMonad/Internal/Concurrent/ACPIEvent.hs

@@ -15,6 +15,7 @@ import           Control.Monad
 import           Data.ByteString                          hiding (readFile)
 import           Data.ByteString.Char8                    as C hiding (readFile)
 import           Data.Connection
+import           Data.Internal.Dependency
 
 import           Text.Read                                (readMaybe)
 
@@ -24,7 +25,6 @@ import           System.IO.Streams.UnixSocket
 import           XMonad.Core
 import           XMonad.Internal.Command.Power
 import           XMonad.Internal.Concurrent.ClientMessage
-import           XMonad.Internal.Dependency
 import           XMonad.Internal.Shell
 import           XMonad.Internal.Theme                    (FontBuilder)
 

lib/XMonad/Internal/Concurrent/VirtualBox.hs

@@ -8,11 +8,12 @@ module XMonad.Internal.Concurrent.VirtualBox
 
 import           Control.Exception
 
+import           Data.Internal.Dependency
+
 import           Text.XML.Light
 
 import           System.Directory
 
-import           XMonad.Internal.Dependency
 import           XMonad.Internal.Shell
 
 vmExists :: String -> IO (Maybe Msg)

lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs

@@ -13,13 +13,14 @@ module XMonad.Internal.DBus.Brightness.ClevoKeyboard
 import           Control.Monad                          (when)
 
 import           Data.Int                               (Int32)
+import           Data.Internal.DBus
+import           Data.Internal.Dependency
 
 import           DBus
 
 import           System.FilePath.Posix
 
 import           XMonad.Internal.DBus.Brightness.Common
-import           XMonad.Internal.Dependency
 import           XMonad.Internal.IO
 
 --------------------------------------------------------------------------------
@@ -123,7 +124,7 @@ clevoKeyboardControls :: Maybe SesClient -> BrightnessControls
 clevoKeyboardControls = brightnessControls xpfClevoBacklight clevoKeyboardConfig
 
 callGetBrightnessCK :: SesClient -> IO (Maybe Brightness)
-callGetBrightnessCK = callGetBrightness clevoKeyboardConfig . toClient
+callGetBrightnessCK = callGetBrightness clevoKeyboardConfig
 
 matchSignalCK :: (Maybe Brightness -> IO ()) -> SesClient -> IO ()
-matchSignalCK cb = matchSignal clevoKeyboardConfig cb . toClient
+matchSignalCK = matchSignal clevoKeyboardConfig

lib/XMonad/Internal/DBus/Brightness/Common.hs

@@ -14,15 +14,15 @@ module XMonad.Internal.DBus.Brightness.Common
 import           Control.Monad               (void)
 
 import           Data.Int                    (Int32)
+import           Data.Internal.DBus
+import           Data.Internal.Dependency
 
 import           DBus
 import           DBus.Client
-import           DBus.Internal
 import qualified DBus.Introspection          as I
 
 import           XMonad.Core                 (io)
 import           XMonad.Internal.DBus.Common
-import           XMonad.Internal.Dependency
 
 --------------------------------------------------------------------------------
 -- | External API
@@ -64,7 +64,8 @@ brightnessControls q bc cl =
   where
     cb = callBacklight q cl bc
 
-callGetBrightness :: Num c => BrightnessConfig a b -> Client -> IO (Maybe c)
+callGetBrightness :: (SafeClient c, Num n) => BrightnessConfig a b -> c
+  -> IO (Maybe n)
 callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } client =
   either (const Nothing) bodyGetBrightness
   <$> callMethod client xmonadBusName p i memGet
@@ -73,7 +74,8 @@ signalDep :: BrightnessConfig a b -> DBusDependency_ SesClient
 signalDep BrightnessConfig { bcPath = p, bcInterface = i } =
   Endpoint [] xmonadBusName p i $ Signal_ memCur
 
-matchSignal :: Num c => BrightnessConfig a b -> (Maybe c -> IO ()) -> Client -> IO ()
+matchSignal :: (SafeClient c, Num n) => BrightnessConfig a b
+  -> (Maybe n-> IO ()) -> c -> IO ()
 matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb =
   void . addMatchCallback brMatcher (cb . bodyGetBrightness)
   where
@@ -139,7 +141,7 @@ callBacklight q cl BrightnessConfig { bcPath = p
   Sometimes (unwords [n, controlName]) q [Subfeature root "method call"]
   where
     root = DBusRoot_ cmd (Only_ $ Endpoint [] xmonadBusName p i $ Method_ m) cl
-    cmd c = io $ void $ callMethod (toClient c) xmonadBusName p i m
+    cmd c = io $ void $ callMethod c xmonadBusName p i m
 
 bodyGetBrightness :: Num a => [Variant] -> Maybe a
 bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)

lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs

@@ -11,13 +11,14 @@ module XMonad.Internal.DBus.Brightness.IntelBacklight
   ) where
 
 import           Data.Int                               (Int32)
+import           Data.Internal.DBus
+import           Data.Internal.Dependency
 
 import           DBus
 
 import           System.FilePath.Posix
 
 import           XMonad.Internal.DBus.Brightness.Common
-import           XMonad.Internal.Dependency
 import           XMonad.Internal.IO
 
 --------------------------------------------------------------------------------
@@ -105,7 +106,7 @@ intelBacklightControls :: Maybe SesClient -> BrightnessControls
 intelBacklightControls = brightnessControls xpfIntelBacklight intelBacklightConfig
 
 callGetBrightnessIB :: SesClient -> IO (Maybe Brightness)
-callGetBrightnessIB = callGetBrightness intelBacklightConfig . toClient
+callGetBrightnessIB = callGetBrightness intelBacklightConfig
 
 matchSignalIB :: (Maybe Brightness -> IO ()) -> SesClient -> IO ()
-matchSignalIB cb = matchSignal intelBacklightConfig cb . toClient
+matchSignalIB = matchSignal intelBacklightConfig

lib/XMonad/Internal/DBus/Control.hs

@@ -19,6 +19,9 @@ module XMonad.Internal.DBus.Control
 
 import           Control.Monad
 
+import           Data.Internal.DBus
+import           Data.Internal.Dependency
+
 import           DBus
 import           DBus.Client
 
@@ -26,7 +29,6 @@ import           XMonad.Internal.DBus.Brightness.ClevoKeyboard
 import           XMonad.Internal.DBus.Brightness.IntelBacklight
 import           XMonad.Internal.DBus.Common
 import           XMonad.Internal.DBus.Screensaver
-import           XMonad.Internal.Dependency
 
 -- | Current connections to the DBus (session and system buses)
 data DBusState = DBusState

lib/XMonad/Internal/DBus/Removable.hs

@@ -8,14 +8,15 @@ module XMonad.Internal.DBus.Removable (runRemovableMon) where
 
 import           Control.Monad
 
-import           Data.Map.Lazy                   (Map, member)
+import           Data.Internal.DBus
+import           Data.Internal.Dependency
+import           Data.Map.Strict                 (Map, member)
 
 import           DBus
 import           DBus.Client
 
 import           XMonad.Core                     (io)
 import           XMonad.Internal.Command.Desktop
-import           XMonad.Internal.Dependency
 
 bus :: BusName
 bus = busName_ "org.freedesktop.UDisks2"

lib/XMonad/Internal/DBus/Screensaver.hs

@@ -11,16 +11,17 @@ module XMonad.Internal.DBus.Screensaver
 
 import           Control.Monad               (void)
 
+import           Data.Internal.DBus
+import           Data.Internal.Dependency
+
 import           DBus
 import           DBus.Client
-import           DBus.Internal
 import qualified DBus.Introspection          as I
 
 import           Graphics.X11.XScreenSaver
 import           Graphics.X11.Xlib.Display
 
 import           XMonad.Internal.DBus.Common
-import           XMonad.Internal.Dependency
 import           XMonad.Internal.Process
 
 --------------------------------------------------------------------------------
@@ -124,14 +125,14 @@ callToggle :: Maybe SesClient -> SometimesIO
 callToggle = sometimesEndpoint "screensaver toggle" "dbus switch" []
   xmonadBusName ssPath interface memToggle
 
-callQuery :: Client -> IO (Maybe SSState)
+callQuery :: SesClient -> IO (Maybe SSState)
-callQuery client = do
+callQuery ses = do
-  reply <- callMethod client xmonadBusName ssPath interface memQuery
+  reply <- callMethod ses xmonadBusName ssPath interface memQuery
   return $ either (const Nothing) bodyGetCurrentState reply
 
 matchSignal :: (Maybe SSState -> IO ()) -> SesClient -> IO ()
 matchSignal cb ses = void $ addMatchCallback ruleCurrentState
-  (cb . bodyGetCurrentState) $ toClient ses
+  (cb . bodyGetCurrentState) ses
 
 ssSignalDep :: DBusDependency_ SesClient
 ssSignalDep = Endpoint [] xmonadBusName ssPath interface $ Signal_ memState

lib/Xmobar/Plugins/BacklightCommon.hs

@@ -6,7 +6,8 @@
 
 module Xmobar.Plugins.BacklightCommon (startBacklight) where
 
-import           XMonad.Internal.Dependency
+import           Data.Internal.DBus
+
 import           Xmobar.Plugins.Common
 
 startBacklight :: RealFrac a => ((Maybe a -> IO ()) -> SesClient -> IO ())

lib/Xmobar/Plugins/Bluetooth.hs

@@ -39,6 +39,8 @@ module Xmobar.Plugins.Bluetooth
 import           Control.Concurrent.MVar
 import           Control.Monad
 
+import           Data.Internal.DBus
+import           Data.Internal.Dependency
 import           Data.List
 import           Data.List.Split
 import qualified Data.Map                    as M
@@ -46,10 +48,8 @@ import           Data.Maybe
 
 import           DBus
 import           DBus.Client
-import           DBus.Internal
 
 import           XMonad.Internal.DBus.Common
-import           XMonad.Internal.Dependency
 import           Xmobar
 import           Xmobar.Plugins.Common
 
@@ -158,13 +158,13 @@ splitPath :: ObjectPath -> [String]
 splitPath = splitOn "/" . dropWhile (=='/') . formatObjectPath
 
 getBtObjectTree :: SysClient -> IO ObjectTree
-getBtObjectTree sys = callGetManagedObjects (toClient sys) btBus btOMPath
+getBtObjectTree sys = callGetManagedObjects sys btBus btOMPath
 
 btOMPath :: ObjectPath
 btOMPath = objectPath_ "/"
 
 addBtOMListener :: SignalCallback -> SysClient -> IO ()
-addBtOMListener sc = void . addInterfaceAddedListener btBus btOMPath sc . toClient
+addBtOMListener sc = void . addInterfaceAddedListener btBus btOMPath sc
 
 addDeviceAddedListener :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO ()
 addDeviceAddedListener state display adapter client =
@@ -195,19 +195,19 @@ initAdapter state adapter client = do
   putPowered state $ fromSingletonVariant reply
 
 matchBTProperty :: SysClient -> ObjectPath -> IO (Maybe MatchRule)
-matchBTProperty client p = matchPropertyFull (toClient client) btBus (Just p)
+matchBTProperty sys p = matchPropertyFull sys btBus (Just p)
 
 addAdaptorListener :: MutableBtState -> IO () -> ObjectPath -> SysClient
   -> IO (Maybe SignalHandler)
 addAdaptorListener state display adaptor sys = do
   rule <- matchBTProperty sys adaptor
-  forM rule $ \r -> addMatchCallback r (procMatch . matchPowered) (toClient sys)
+  forM rule $ \r -> addMatchCallback r (procMatch . matchPowered) sys
   where
     procMatch = withSignalMatch $ \b -> putPowered state b >> display
 
 callGetPowered :: ObjectPath -> SysClient -> IO [Variant]
-callGetPowered adapter sys =
+callGetPowered adapter = callPropertyGet btBus adapter adapterInterface
-  callPropertyGet btBus adapter adapterInterface (memberName_ adaptorPowered) $ toClient sys
+  $ memberName_ adaptorPowered
 
 matchPowered :: [Variant] -> SignalMatch Bool
 matchPowered = matchPropertyChanged adapterInterface adaptorPowered
@@ -234,8 +234,8 @@ addAndInitDevice state display device client = do
   forM_ sh $ \s -> initDevice state s device client
 
 initDevice :: MutableBtState -> SignalHandler -> ObjectPath -> SysClient -> IO ()
-initDevice state sh device client = do
+initDevice state sh device sys = do
-  reply <- callGetConnected device (toClient client)
+  reply <- callGetConnected device sys
   void $ insertDevice state device $
     BTDevice { btDevConnected = fromVariant =<< listToMaybe reply
              , btDevSigHandler = sh
@@ -243,16 +243,16 @@ initDevice state sh device client = do
 
 addDeviceListener :: MutableBtState -> IO () -> ObjectPath -> SysClient
   -> IO (Maybe SignalHandler)
-addDeviceListener state display device client = do
+addDeviceListener state display device sys = do
-  rule <- matchBTProperty client device
+  rule <- matchBTProperty sys device
-  forM rule $ \r -> addMatchCallback r (procMatch . matchConnected) (toClient client)
+  forM rule $ \r -> addMatchCallback r (procMatch . matchConnected) sys
   where
     procMatch = withSignalMatch $ \c -> updateDevice state device c >> display
 
 matchConnected :: [Variant] -> SignalMatch Bool
 matchConnected = matchPropertyChanged devInterface devConnected
 
-callGetConnected :: ObjectPath -> Client -> IO [Variant]
+callGetConnected :: ObjectPath -> SysClient -> IO [Variant]
 callGetConnected p = callPropertyGet btBus p devInterface $ memberName_ devConnected
 
 insertDevice :: MutableBtState -> ObjectPath -> BTDevice -> IO Bool

lib/Xmobar/Plugins/Common.hs

@@ -1,4 +1,3 @@
-
 module Xmobar.Plugins.Common
   ( colorText
   , startListener
@@ -16,12 +15,12 @@ module Xmobar.Plugins.Common
 
 import           Control.Monad
 
+import           Data.Internal.DBus
+
 import           DBus
 import           DBus.Client
-import           DBus.Internal
 
-import           XMonad.Hooks.DynamicLog    (xmobarColor)
+import           XMonad.Hooks.DynamicLog (xmobarColor)
-import           XMonad.Internal.Dependency
 
 type Callback = String -> IO ()
 
@@ -31,9 +30,9 @@ data Colors = Colors
   }
   deriving (Eq, Show, Read)
 
-startListener :: IsVariant a => MatchRule -> (Client -> IO [Variant])
+startListener :: (SafeClient c, IsVariant a) => MatchRule -> (c -> IO [Variant])
   -> ([Variant] -> SignalMatch a) -> (a -> IO String) -> Callback
-  -> Client -> IO ()
+  -> c -> IO ()
 startListener rule getProp fromSignal toColor cb client = do
   reply <- getProp client
   displayMaybe cb toColor $ fromSingletonVariant reply

lib/Xmobar/Plugins/Device.hs

@@ -11,15 +11,14 @@ module Xmobar.Plugins.Device
 
 import           Control.Monad
 
+import           Data.Internal.DBus
+import           Data.Internal.Dependency
 import           Data.Word
 
 import           DBus
-import           DBus.Client
-import           DBus.Internal
 
 import           XMonad.Internal.Command.Desktop
 import           XMonad.Internal.DBus.Common
-import           XMonad.Internal.Dependency
 import           Xmobar
 import           Xmobar.Plugins.Common
 
@@ -45,13 +44,13 @@ devDep = Endpoint networkManagerPkgs networkManagerBus nmPath nmInterface
   $ Method_ getByIP
 
 getDevice :: SysClient -> String -> IO (Maybe ObjectPath)
-getDevice cl iface = bodyToMaybe <$> callMethod' (toClient cl) mc
+getDevice sys iface = bodyToMaybe <$> callMethod' sys mc
   where
     mc = (methodCallBus networkManagerBus nmPath nmInterface getByIP)
       { methodCallBody = [toVariant iface]
       }
 
-getDeviceConnected :: ObjectPath -> Client -> IO [Variant]
+getDeviceConnected :: ObjectPath -> SysClient -> IO [Variant]
 getDeviceConnected path = callPropertyGet networkManagerBus path nmDeviceInterface
   $ memberName_ devSignal
 
@@ -61,13 +60,13 @@ matchStatus = matchPropertyChanged nmDeviceInterface devSignal
 instance Exec Device where
   alias (Device (iface, _, _)) = iface
   start (Device (iface, text, colors)) cb = do
-    withDBusClientConnection cb $ \client -> do
+    withDBusClientConnection cb $ \sys -> do
-      path <- getDevice client iface
+      path <- getDevice sys iface
-      displayMaybe' cb (listener client) path
+      displayMaybe' cb (listener sys) path
     where
-      listener client path = do
+      listener sys path = do
-        rule <- matchPropertyFull (toClient client) networkManagerBus (Just path)
+        rule <- matchPropertyFull sys networkManagerBus (Just path)
         -- TODO warn the user here rather than silently drop the listener
         forM_ rule $ \r ->
-          startListener r (getDeviceConnected path) matchStatus chooseColor' cb (toClient client)
+          startListener r (getDeviceConnected path) matchStatus chooseColor' cb sys
       chooseColor' = return . (\s -> colorText colors s text) . (> 1)

lib/Xmobar/Plugins/Screensaver.hs

@@ -12,7 +12,6 @@ module Xmobar.Plugins.Screensaver
 import           Xmobar
 
 import           XMonad.Internal.DBus.Screensaver
-import           XMonad.Internal.Dependency
 import           Xmobar.Plugins.Common
 
 newtype Screensaver = Screensaver (String, Colors) deriving (Read, Show)
@@ -23,9 +22,9 @@ ssAlias = "screensaver"
 instance Exec Screensaver where
   alias (Screensaver _) = ssAlias
   start (Screensaver (text, colors)) cb = do
-    withDBusClientConnection cb $ \c -> do
+    withDBusClientConnection cb $ \sys -> do
-      matchSignal display c
+      matchSignal display sys
-      display =<< callQuery (toClient c)
+      display =<< callQuery sys
     where
       display = displayMaybe cb $ return . (\s -> colorText colors s text)
 

lib/Xmobar/Plugins/VPN.hs

@@ -14,16 +14,16 @@ module Xmobar.Plugins.VPN
 import           Control.Concurrent.MVar
 import           Control.Monad
 
+import           Data.Internal.DBus
+import           Data.Internal.Dependency
 import qualified Data.Map                        as M
 import           Data.Maybe
 import qualified Data.Set                        as S
 
 import           DBus
-import           DBus.Internal
 
 import           XMonad.Internal.Command.Desktop
 import           XMonad.Internal.DBus.Common
-import           XMonad.Internal.Dependency
 import           Xmobar
 import           Xmobar.Plugins.Common
 
@@ -70,16 +70,16 @@ updateState f state op = modifyMVar_ state $ return . f op
 --
 
 getVPNObjectTree :: SysClient -> IO ObjectTree
-getVPNObjectTree client = callGetManagedObjects (toClient client) vpnBus vpnPath
+getVPNObjectTree sys = callGetManagedObjects sys vpnBus vpnPath
 
 findTunnels :: ObjectTree -> VPNState
 findTunnels = S.fromList . M.keys . M.filter (elem vpnDeviceTun . M.keys)
 
 vpnAddedListener :: SignalCallback -> SysClient -> IO ()
-vpnAddedListener cb = void . addInterfaceAddedListener vpnBus vpnPath cb . toClient
+vpnAddedListener cb = void . addInterfaceAddedListener vpnBus vpnPath cb
 
 vpnRemovedListener :: SignalCallback -> SysClient -> IO ()
-vpnRemovedListener cb = void . addInterfaceRemovedListener vpnBus vpnPath cb . toClient
+vpnRemovedListener cb = void . addInterfaceRemovedListener vpnBus vpnPath cb
 
 addedCallback :: MutableVPNState -> IO () -> SignalCallback
 addedCallback state display [device, added] = update >> display

my-xmonad.cabal

@@ -12,7 +12,6 @@ library
                    , XMonad.Internal.Theme
                    , XMonad.Internal.Notify
                    , XMonad.Internal.Shell
-                   , XMonad.Internal.Dependency
                    , XMonad.Internal.IO
                    , XMonad.Internal.Command.Desktop
                    , XMonad.Internal.Command.DMenu
@@ -33,7 +32,8 @@ library
                    , Xmobar.Plugins.IntelBacklight
                    , Xmobar.Plugins.Screensaver
                    , Xmobar.Plugins.VPN
-                   , DBus.Internal
+                   , Data.Internal.Dependency
+                   , Data.Internal.DBus
     build-depends: X11 >= 1.9.1
                  , base
                  , bytestring >= 0.10.8.2