From fcb454bc292ec6e05395ce58328948eb2def5de9 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 31 Dec 2022 22:55:32 -0500
Subject: [PATCH] ENH use dbus bracket with xmonad dep print

---
 bin/xmonad.hs                       | 24 +++++++-----------------
 lib/XMonad/Internal/DBus/Control.hs | 20 +++++++++++++++++---
 2 files changed, 24 insertions(+), 20 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index add49b6..1f7eb21 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -203,13 +203,6 @@ startXmobar = do
 startChildDaemons :: FeatureSet -> FIO [Process () () ()]
 startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs)
 
--- withDBusX :: (DBusState -> FIO a) -> FIO a
--- withDBusX = bracket (io connectDBusX) cleanup
---   where
---     cleanup db = do
---       logInfo "unregistering xmonad from DBus"
---       io $ disconnectDBus db
-
 withChildDaemons :: FeatureSet -> ([Process () () ()] -> FIO a) -> FIO a
 withChildDaemons fs = bracket (startChildDaemons fs) cleanup
   where
@@ -225,17 +218,14 @@ withXmobar = bracket startXmobar cleanup
       io $ killNoWait p
 
 printDeps :: FIO ()
-printDeps = do
-  db <- io connectDBus
+printDeps = withDBus_ $ \db -> do
   (i, f, d) <- allFeatures db
-  io $
-    mapM_ (putStrLn . T.unpack) $
-      fmap showFulfillment $
-        sort $
-          nub $
-            concat $
-              fmap dumpFeature f ++ fmap dumpSometimes i ++ fmap dumpSometimes d
-  io $ disconnectDBus db
+  mapM_ (liftIO . putStrLn . T.unpack) $
+    fmap showFulfillment $
+      sort $
+        nub $
+          concat $
+            fmap dumpFeature f ++ fmap dumpSometimes i ++ fmap dumpSometimes d
 
 allFeatures :: DBusState -> FIO ([SometimesIO], [FeatureX], [Sometimes DynWorkspace])
 allFeatures db = do
diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs
index 0013fa7..4369b2f 100644
--- a/lib/XMonad/Internal/DBus/Control.hs
+++ b/lib/XMonad/Internal/DBus/Control.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 --------------------------------------------------------------------------------
@@ -38,13 +39,26 @@ data DBusState = DBusState
   , dbSysClient :: Maybe SysClient
   }
 
-withDBusX_ :: MonadUnliftIO m => (DBusState -> m a) -> m ()
+withDBusX_
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => (DBusState -> m a)
+  -> m ()
 withDBusX_ = void . withDBusX
 
-withDBusX :: MonadUnliftIO m => (DBusState -> m a) -> m (Maybe a)
+withDBusX
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => (DBusState -> m a)
+  -> m (Maybe a)
 withDBusX f = withDBus $ \db -> do
   forM (dbSesClient db) $ \ses -> do
-    bracket_ (requestXMonadName ses) (releaseXMonadName ses) $ f db
+    bracket_ (up ses) (down ses) $ f db
+  where
+    up cl = do
+      logInfo "registering xmonad to DBus"
+      requestXMonadName cl
+    down cl = do
+      logInfo "unregistering xmonad from DBus"
+      releaseXMonadName cl
 
 withDBus_ :: MonadUnliftIO m => (DBusState -> m a) -> m ()
 withDBus_ = void . withDBus