Don't catch async exceptions

test/RuntimeSpec.hs

@@ -1,9 +1,32 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module RuntimeSpec (spec) where
 
+import Control.Concurrent (threadDelay)
+import Control.Concurrent.Async (async, cancel, race, waitCatch)
+import Control.Exception (bracket)
+import Control.Monad (forever)
+import Control.Monad.IO.Class (liftIO)
+import HomeAssistant.Runtime.Supervisor (supervised)
+import Katip (LogEnv, closeScribes, initLogEnv, runKatipContextT)
 import Test.Hspec
 
 spec :: Spec
-spec = pure ()
+spec = describe "supervised" $ do
+  it "propagates ThreadKilled instead of retrying" $
+    withTestLogEnv $ \le -> do
+      worker <- async $ runKatipContextT le () mempty $
+        supervised "test" (liftIO (forever (threadDelay 100000)))
+      threadDelay 200000
+      cancel worker
+      result <- race (threadDelay 5000000) (waitCatch worker)
+      case result of
+        Left () -> expectationFailure
+          "supervised retried on ThreadKilled (process would hang)"
+        Right _ -> pure ()
+
+withTestLogEnv :: (LogEnv -> IO a) -> IO a
+withTestLogEnv = bracket (initLogEnv "test" "test") closeScribes
 
 -- I'm commenting out the test as that specific controller
 -- was just a dummy for seeing how the data flows (dead code)