From 7821140dc2603c54b675390342013c295409e95b Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 20:19:09 -0500
Subject: [PATCH] ENH use logging in dbus connect

---
 lib/XMonad/Internal/Concurrent/ClientMessage.hs   | 10 +---------
 .../Internal/Concurrent/DynamicWorkspaces.hs      |  3 ---
 lib/XMonad/Internal/DBus/Screensaver.hs           | 15 ++++++---------
 lib/XMonad/Internal/IO.hs                         | 13 ++++++++++++-
 4 files changed, 19 insertions(+), 22 deletions(-)

diff --git a/lib/XMonad/Internal/Concurrent/ClientMessage.hs b/lib/XMonad/Internal/Concurrent/ClientMessage.hs
index 37e85c9..f8c0308 100644
--- a/lib/XMonad/Internal/Concurrent/ClientMessage.hs
+++ b/lib/XMonad/Internal/Concurrent/ClientMessage.hs
@@ -28,8 +28,7 @@ import Graphics.X11.Xlib.Atom
 import Graphics.X11.Xlib.Display
 import Graphics.X11.Xlib.Event
 import Graphics.X11.Xlib.Extras
-import Graphics.X11.Xlib.Types
-import RIO hiding (Display)
+import XMonad.Internal.IO
 
 --------------------------------------------------------------------------------
 -- Data structure for the ClientMessage
@@ -64,13 +63,6 @@ splitXMsg (x : xs) = (xtype, tag)
     xtype = toEnum $ fromIntegral x
     tag = chr . fromIntegral <$> takeWhile (/= 0) xs
 
-withOpenDisplay :: (Display -> IO a) -> IO a
-withOpenDisplay = bracket (openDisplay "") cleanup
-  where
-    cleanup dpy = do
-      flush dpy
-      closeDisplay dpy
-
 -- | Emit a ClientMessage event to the X server with the given type and payloud
 sendXMsg :: XMsgType -> String -> IO ()
 sendXMsg xtype tag = withOpenDisplay $ \dpy -> do
diff --git a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
index 843db73..6a64909 100644
--- a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
+++ b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
@@ -96,9 +96,6 @@ data WConf = WConf
 
 type W a = RIO WConf ()
 
-withOpenDisplay :: (Display -> IO a) -> IO a
-withOpenDisplay = bracket (openDisplay "") closeDisplay
-
 runWorkspaceMon :: [DynWorkspace] -> IO ()
 runWorkspaceMon dws = withOpenDisplay $ \dpy -> do
   root <- rootWindow dpy $ defaultScreen dpy
diff --git a/lib/XMonad/Internal/DBus/Screensaver.hs b/lib/XMonad/Internal/DBus/Screensaver.hs
index a38a7f2..46ea1ca 100644
--- a/lib/XMonad/Internal/DBus/Screensaver.hs
+++ b/lib/XMonad/Internal/DBus/Screensaver.hs
@@ -18,9 +18,9 @@ import qualified DBus.Introspection as I
 import Data.Internal.DBus
 import Data.Internal.Dependency
 import Graphics.X11.XScreenSaver
-import Graphics.X11.Xlib.Display
 import RIO
 import XMonad.Internal.DBus.Common
+import XMonad.Internal.IO
 import XMonad.Internal.Shell
 
 --------------------------------------------------------------------------------
@@ -31,7 +31,7 @@ type SSState = Bool -- true is enabled
 ssExecutable :: FilePath
 ssExecutable = "xset"
 
-toggle :: IO SSState
+toggle :: MonadUnliftIO m => m SSState
 toggle = do
   st <- query
   let args = if st then ["off", "-dpms"] else ["on", "+dpms"]
@@ -40,12 +40,9 @@ toggle = do
   rc <- runProcess (proc ssExecutable $ "s" : args)
   return $ if rc == ExitSuccess then not st else st
 
-query :: IO SSState
+query :: MonadUnliftIO m => m SSState
 query = do
-  -- TODO bracket the display
-  dpy <- openDisplay ""
-  xssi <- xScreenSaverQueryInfo dpy
-  closeDisplay dpy
+  xssi <- withOpenDisplay (liftIO . xScreenSaverQueryInfo)
   return $ case xssi of
     Just XScreenSaverInfo {xssi_state = ScreenSaverDisabled} -> False
     Just XScreenSaverInfo {xssi_state = _} -> True
@@ -101,7 +98,7 @@ exportScreensaver ses =
   where
     cmd cl =
       let cl' = toClient cl
-       in liftIO $
+       in withRunInIO $ \run ->
             export
               cl'
               ssPath
@@ -109,7 +106,7 @@ exportScreensaver ses =
                 { interfaceName = interface
                 , interfaceMethods =
                     [ autoMethod memToggle $ emitState cl' =<< toggle
-                    , autoMethod memQuery query
+                    , autoMethod memQuery (run query)
                     ]
                 , interfaceSignals = [sig]
                 }
diff --git a/lib/XMonad/Internal/IO.hs b/lib/XMonad/Internal/IO.hs
index 6023619..2acde87 100644
--- a/lib/XMonad/Internal/IO.hs
+++ b/lib/XMonad/Internal/IO.hs
@@ -22,11 +22,15 @@ module XMonad.Internal.IO
   , PermResult (..)
   , getPermissionsSafe
   , waitUntilExit
+  , withOpenDisplay
   )
 where
 
 import Data.Char
-import RIO
+import Graphics.X11.Xlib.Display
+import Graphics.X11.Xlib.Event
+import Graphics.X11.Xlib.Types
+import RIO hiding (Display)
 import RIO.Directory
 import RIO.FilePath
 import qualified RIO.Text as T
@@ -168,3 +172,10 @@ waitUntilExit pid = do
   when res $ do
     threadDelay 100000
     waitUntilExit pid
+
+withOpenDisplay :: MonadUnliftIO m => (Display -> m a) -> m a
+withOpenDisplay = bracket (liftIO $ openDisplay "") cleanup
+  where
+    cleanup dpy = liftIO $ do
+      flush dpy
+      closeDisplay dpy