Merge pull request #404 from geekosaur/forever-away

attempt to work around the join point bug (#389)

CHANGES.md

@@ -13,6 +13,13 @@
   * Fixed border color of windows with alpha channel. Now all windows have the
     same opaque border color.
 
+  * Change the main loop to try to avoid [GHC bug 21708] on systems
+    running GHC 9.2 up to version 9.2.3. The issue has been fixed in
+    [GHC 9.2.4] and all later releases.
+
+[GHC bug 21708]: https://gitlab.haskell.org/ghc/ghc/-/issues/21708
+[GHC 9.2.4]: https://discourse.haskell.org/t/ghc-9-2-4-released/4851
+
 ## 0.17.0 (October 27, 2021)
 
 ### Enhancements

src/XMonad/Main.hs

@@ -267,10 +267,11 @@ launch initxmc drs = do
             userCode $ startupHook initxmc
 
             rrData <- io $ xrrQueryExtension dpy
-            let rrUpdate = when (isJust rrData) . void . xrrUpdateConfiguration
 
             -- main loop, for all you HOF/recursion fans out there.
-            forever $ prehandle =<< io (nextEvent dpy e >> rrUpdate e >> getEvent e)
+            -- forever $ prehandle =<< io (nextEvent dpy e >> rrUpdate e >> getEvent e)
+            -- sadly, 9.2.{1,2,3} join points mishandle the above and trash the heap (see #389)
+            mainLoop dpy e rrData
 
     return ()
       where
@@ -281,6 +282,8 @@ launch initxmc drs = do
                       in local (\c -> c { mousePosition = mouse, currentEvent = Just e }) (handleWithHook e)
         evs = [ keyPress, keyRelease, enterNotify, leaveNotify
               , buttonPress, buttonRelease]
+        rrUpdate e r = when (isJust r) (void (xrrUpdateConfiguration e))
+        mainLoop d e r = io (nextEvent d e >> rrUpdate e r >> getEvent e) >>= prehandle >> mainLoop d e r
 
 
 -- | Runs handleEventHook from the configuration and runs the default handler