From 76011dc6d654f687e683b23710fcdd8fc0b7b7da Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 19:23:31 -0500
Subject: [PATCH] ENH use logging in dynamic workspace thread

---
 bin/xmonad.hs                                 |  2 +-
 .../Internal/Concurrent/DynamicWorkspaces.hs  | 41 ++++++++++++++-----
 2 files changed, 32 insertions(+), 11 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 841e29a..2380e6d 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -149,7 +149,7 @@ run = do
   where
     startDynWorkspaces fs = do
       dws <- catMaybes <$> mapM evalSometimes (fsDynWorkspaces fs)
-      void $ io $ async $ runWorkspaceMon dws
+      void $ async $ runWorkspaceMon dws
       return dws
 
 runXMonad :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()
diff --git a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
index e61b263..3e18c11 100644
--- a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
+++ b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- Automatically Manage Dynamic Workspaces
 -- This is a somewhat convoluted wrapper for the Dymamic Workspaces module
@@ -34,6 +36,8 @@ module XMonad.Internal.Concurrent.DynamicWorkspaces
   )
 where
 
+import qualified Data.ByteString.Char8 as BC
+import Data.Internal.XIO
 import Graphics.X11.Types
 import Graphics.X11.Xlib.Atom
 import Graphics.X11.Xlib.Display
@@ -92,24 +96,34 @@ data WEnv = WEnv
   { wDisplay :: !Display
   , wDynWorkspaces :: ![DynWorkspace]
   , wCurPIDs :: !(MVar (S.Set Pid))
-  -- , wXEnv :: !XEnv
+  , wXEnv :: !XEnv
   }
 
+instance HasLogFunc WEnv where
+  logFuncL = lens wXEnv (\x y -> x {wXEnv = y}) . logFuncL
+
 type WIO a = RIO WEnv a
 
-runWorkspaceMon :: [DynWorkspace] -> IO ()
+runWorkspaceMon :: [DynWorkspace] -> XIO ()
 runWorkspaceMon dws = withOpenDisplay $ \dpy -> do
-  root <- rootWindow dpy $ defaultScreen dpy
+  root <- liftIO $ rootWindow dpy $ defaultScreen dpy
   -- listen only for substructure change events (which includes MapNotify)
-  allocaSetWindowAttributes $ \a -> do
+  liftIO $ allocaSetWindowAttributes $ \a -> do
     set_event_mask a substructureNotifyMask
     changeWindowAttributes dpy root cWEventMask a
-  void $ allocaXEvent $ withEvents dpy
+  withRunInIO $ \runIO -> do
+    void $ allocaXEvent $ runIO . withEvents dpy
   where
+    wrapEnv dpy ps x =
+      WEnv
+        { wDisplay = dpy
+        , wDynWorkspaces = dws
+        , wCurPIDs = ps
+        , wXEnv = x
+        }
     withEvents dpy e = do
       ps <- newMVar S.empty
-      let c = WEnv {wDisplay = dpy, wDynWorkspaces = dws, wCurPIDs = ps}
-      runRIO c $
+      mapRIO (wrapEnv dpy ps) $ do
         forever $
           handleEvent =<< io (nextEvent dpy e >> getEvent e)
 
@@ -138,17 +152,24 @@ withUniquePid :: Pid -> String -> WIO ()
 withUniquePid pid tag = do
   ps <- asks wCurPIDs
   pids <- readMVar ps
-  io
-    $ unless (pid `elem` pids)
+  unless (pid `elem` pids)
     $ bracket_
       (modifyMVar_ ps (return . S.insert pid))
       (modifyMVar_ ps (return . S.delete pid))
-    $ waitUntilExit pid >> sendXMsg Workspace tag
+    $ do
+      logInfo $ "waiting for pid " <> pid_ <> " to exit on workspace " <> tag_
+      waitUntilExit pid
+      logInfo $ "pid " <> pid_ <> " exited on workspace " <> tag_
+      liftIO $ sendXMsg Workspace tag
+  where
+    pid_ = "'" <> displayShow pid <> "'"
+    tag_ = "'" <> displayBytesUtf8 (BC.pack tag) <> "'"
 
 --------------------------------------------------------------------------------
 -- Launching apps
 -- When launching apps on dymamic workspaces, first check if they are running
 -- and launch if not, then switch to their workspace
+
 wsOccupied :: Eq a1 => a1 -> W.StackSet a1 l a2 sid sd -> Bool
 wsOccupied tag ws =
   elem tag $