ENH generalize dbus controls

lib/XMonad/Internal/DBus/Control.hs

@@ -18,11 +18,11 @@ module XMonad.Internal.DBus.Control
   )
 where
 
-import Control.Monad
 import DBus
 import DBus.Client
 import Data.Internal.DBus
 import Data.Internal.Dependency
+import RIO
 import XMonad.Internal.DBus.Brightness.ClevoKeyboard
 import XMonad.Internal.DBus.Brightness.IntelBacklight
 import XMonad.Internal.DBus.Common
@@ -35,27 +35,27 @@ data DBusState = DBusState
   }
 
 -- | Connect to the DBus
-connectDBus :: IO DBusState
+connectDBus :: MonadUnliftIO m => m DBusState
 connectDBus = do
   ses <- getDBusClient
   sys <- getDBusClient
   return DBusState {dbSesClient = ses, dbSysClient = sys}
 
 -- | Disconnect from the DBus
-disconnectDBus :: DBusState -> IO ()
+disconnectDBus :: MonadUnliftIO m => DBusState -> m ()
 disconnectDBus db = disc dbSesClient >> disc dbSysClient
   where
     disc f = maybe (return ()) disconnectDBusClient $ f db
 
 -- | Connect to the DBus and request the XMonad name
-connectDBusX :: IO DBusState
+connectDBusX :: MonadUnliftIO m => m DBusState
 connectDBusX = do
   db <- connectDBus
   forM_ (dbSesClient db) requestXMonadName
   return db
 
 -- | Disconnect from DBus and release the XMonad name
-disconnectDBusX :: DBusState -> IO ()
+disconnectDBusX :: MonadUnliftIO m => DBusState -> m ()
 disconnectDBusX db = do
   forM_ (dbSesClient db) releaseXMonadName
   disconnectDBus db
@@ -64,12 +64,12 @@ disconnectDBusX db = do
 dbusExporters :: [Maybe SesClient -> SometimesIO]
 dbusExporters = [exportScreensaver, exportIntelBacklight, exportClevoKeyboard]
 
-releaseXMonadName :: SesClient -> IO ()
-releaseXMonadName ses = void $ releaseName (toClient ses) xmonadBusName
+releaseXMonadName :: MonadUnliftIO m => SesClient -> m ()
+releaseXMonadName ses = liftIO $ void $ releaseName (toClient ses) xmonadBusName
 
-requestXMonadName :: SesClient -> IO ()
+requestXMonadName :: MonadUnliftIO m => SesClient -> m ()
 requestXMonadName ses = do
-  res <- requestName (toClient ses) xmonadBusName []
+  res <- liftIO $ requestName (toClient ses) xmonadBusName []
   -- TODO if the client is not released on shutdown the owner will be different
   let msg
         | res == NamePrimaryOwner = Nothing
@@ -78,6 +78,6 @@ requestXMonadName ses = do
             || res == NameExists =
             Just $ "another process owns " ++ xn
         | otherwise = Just $ "unknown error when requesting " ++ xn
-  forM_ msg putStrLn
+  liftIO $ forM_ msg putStrLn
   where
     xn = "'" ++ formatBusName xmonadBusName ++ "'"