From 2e2924c9056b4838e5b8d3adfa4c62082d321faf Mon Sep 17 00:00:00 2001
From: Curtis Chin Jen Sem <csochinjensem@gmail.com>
Date: Mon, 6 Apr 2026 01:09:04 +0200
Subject: [PATCH] Ignore `SessionException` during cleanup

---
 lsp-test/src/Language/LSP/Test/Session.hs | 21 ++++++++++++++++-----
 1 file changed, 16 insertions(+), 5 deletions(-)

diff --git a/lsp-test/src/Language/LSP/Test/Session.hs b/lsp-test/src/Language/LSP/Test/Session.hs
index 15033169..4f0f57dd 100644
--- a/lsp-test/src/Language/LSP/Test/Session.hs
+++ b/lsp-test/src/Language/LSP/Test/Session.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ViewPatterns #-}
 
 module Language.LSP.Test.Session
   ( Session(..)
@@ -302,7 +303,7 @@ runSession' serverIn serverOut mServerProc serverHandler config caps rootDir exi
         (ignoreRegistrationRequests config)
       runSession' = runSessionMonad context initState
 
-      errorHandler = throwTo mainThreadId :: SessionException -> IO ()
+      errorHandler e = throwTo mainThreadId (SomeAsyncException (e :: SessionException))
       serverListenerLauncher =
         async $ catch (serverHandler serverOut context) errorHandler
       msgTimeoutMs = messageTimeout config * 10^6
@@ -316,10 +317,20 @@ runSession' serverIn serverOut mServerProc serverHandler config caps rootDir exi
 #endif
                   cleanupProcess (Just serverIn, Just serverOut, Nothing, sp)
               | otherwise = pure ()
-        finally (timeout msgTimeoutMs (runSession' exitServer))
-                -- Make sure to kill the listener first, before closing
-                -- handles etc via cleanupProcess
-                (cancel async >> cleanup)
+
+        finally
+          -- If we get interrupted by the listener thread, we may be waiting
+          -- for a message that won't come / reading from a handle that's been
+          -- closed.
+          --
+          -- Seeing as we're in the cleanup stage already, ignore that specific
+          -- class of errors.
+          (void (timeout msgTimeoutMs (runSession' exitServer)) `catch`
+            (\(asyncExceptionFromException -> Just (_ :: SessionException)) -> pure ()))
+
+          -- Make sure to kill the listener first, before closing
+          -- handles etc via cleanupProcess
+          (cancel async >> cleanup)
 
   (result, _) <- bracket serverListenerLauncher
                          serverAndListenerFinalizer