diff --git a/src/Quasar/ResourceManager.hs b/src/Quasar/ResourceManager.hs
index 9b99f78062b88a553e770148fc7fc0939599f8f1..c9f31aa814a549bea9bff967e8e923204f8f1d7c 100644
--- a/src/Quasar/ResourceManager.hs
+++ b/src/Quasar/ResourceManager.hs
@@ -31,7 +31,7 @@ module Quasar.ResourceManager (
 ) where
 
 
-import Control.Concurrent (forkIOWithUnmask)
+import Control.Concurrent (ThreadId, forkIOWithUnmask, myThreadId, throwTo, forkIO)
 import Control.Concurrent.STM
 import Control.Monad.Catch
 import Control.Monad.Reader
@@ -64,12 +64,6 @@ newEntry disposable = do
   disposedAwaitable <- cacheAwaitable (isDisposed disposable)
   ResourceManagerEntry <$> newTMVarIO (disposedAwaitable, toDisposable disposable)
 
-entryStartDispose :: ResourceManagerEntry -> IO ()
-entryStartDispose (ResourceManagerEntry var) =
-  atomically (tryReadTMVar var) >>= \case
-    Nothing -> pure ()
-    Just (_, disposable) -> void $ dispose disposable
-
 checkEntries :: Seq ResourceManagerEntry -> IO ()
 checkEntries = mapM_ checkEntry
 
@@ -169,18 +163,61 @@ captureDisposable action = do
   pure $ toDisposable resourceManager
 
 
+-- * ExceptionHandler
+
+type ExceptionHandler = SomeException -> IO ()
+
+loggingExceptionHandler :: ExceptionHandler
+loggingExceptionHandler ex = hPutStrLn stderr $ displayException ex
+
+
+data CancelHelper = CancelHelper
+  deriving stock Show
+  deriving anyclass Exception
+
+
+withLinkedExceptionHandler :: (MonadAwait m, MonadMask m, MonadIO m) => ExceptionHandler -> (ExceptionHandler -> m a) -> m a
+withLinkedExceptionHandler parentExceptionHandler action = do
+  shouldCancelVar <- liftIO $ newTVarIO False
+  let
+    exceptionHandler :: ExceptionHandler
+    exceptionHandler ex = do
+      parentExceptionHandler ex
+      atomically $ writeTVar shouldCancelVar True
+    cancelThread :: ThreadId -> (IO () -> IO ()) -> IO ()
+    cancelThread mainThreadId unmask =
+      do
+        unmask do
+          atomically $ check =<< readTVar shouldCancelVar
+          throwTo mainThreadId CancelTask
+      `catch`
+      \CancelHelper -> pure ()
+
+  mainThreadId <- liftIO myThreadId
+  mask \unmask ->
+    do
+      bracket
+        do liftIO $ forkIOWithUnmask $ cancelThread mainThreadId
+        do \cancelThreadId -> liftIO $ throwTo cancelThreadId CancelHelper
+        do \_ -> unmask $ action exceptionHandler
+    `catch`
+    \CancelTask -> throwM TaskDisposed
+
+
+
+withRootExceptionHandler :: (MonadAwait m, MonadMask m, MonadIO m) => (ExceptionHandler -> m a) -> m a
+withRootExceptionHandler = withLinkedExceptionHandler loggingExceptionHandler
+
 
 -- * Resource manager implementations
 
 
-data RootResourceManager = RootResourceManager ResourceManager (TMVar SomeException)
+data RootResourceManager = RootResourceManager ResourceManager ExceptionHandler
 
 instance IsResourceManager RootResourceManager where
   attachDisposable (RootResourceManager child _) disposable = attachDisposable child disposable
-  throwToResourceManager (RootResourceManager child storedException) ex = do
-    liftIO $ atomically $ void $ tryPutTMVar storedException (toException ex)
-    -- TODO fix log merging bug
-    hPutStrLn stderr $ displayException ex
+  throwToResourceManager (RootResourceManager child exceptionHandler) ex = do
+    exceptionHandler (toException ex)
     void $ dispose child
 
 instance IsDisposable RootResourceManager where
@@ -188,17 +225,17 @@ instance IsDisposable RootResourceManager where
   isDisposed (RootResourceManager child _) = isDisposed child
 
 withRootResourceManager :: (MonadAwait m, MonadMask m, MonadIO m) => (ResourceManager -> m a) -> m a
--- TODO abort thread on resource manager exception (that behavior should also be generalized)
-withRootResourceManager = bracket newUnmanagedRootResourceManager (await <=< liftIO . dispose)
+withRootResourceManager action = withRootExceptionHandler \exceptionHandler ->
+  bracket (newUnmanagedRootResourceManager exceptionHandler) (await <=< liftIO . dispose) action
 
 withRootResourceManagerM :: (MonadAwait m, MonadMask m, MonadIO m) => ReaderT ResourceManager m a -> m a
-withRootResourceManagerM action = withResourceManager (`onResourceManager` action)
+withRootResourceManagerM action = withRootResourceManager (`onResourceManager` action)
 
-newUnmanagedRootResourceManager :: MonadIO m => m ResourceManager
-newUnmanagedRootResourceManager = liftIO $ fixIO \self -> do
+newUnmanagedRootResourceManager :: MonadIO m => ExceptionHandler -> m ResourceManager
+newUnmanagedRootResourceManager exceptionHandler = liftIO $ fixIO \self -> do
   var <- liftIO newEmptyTMVarIO
   childResourceManager <- newUnmanagedDefaultResourceManager self
-  pure $ toResourceManager (RootResourceManager childResourceManager var)
+  pure $ toResourceManager (RootResourceManager childResourceManager exceptionHandler)
 
 
 data DefaultResourceManager = DefaultResourceManager {
@@ -228,19 +265,29 @@ instance IsResourceManager DefaultResourceManager where
           unmask (void (dispose disposable)) `catchAll` throwToResourceManager resourceManager
 
 instance IsDisposable DefaultResourceManager where
-  dispose resourceManager = liftIO $ mask \unmask ->
-    unmask dispose' `catchAll` \ex -> pure () <$ throwToResourceManager resourceManager ex
+  dispose resourceManager = liftIO $ mask \unmask -> do
+    entries <- atomically do
+      isAlreadyDisposing <- swapTVar (disposingVar resourceManager) True
+      if not isAlreadyDisposing
+        then readTVar (entriesVar resourceManager)
+        else pure Empty
+
+    mapM_ (entryStartDispose unmask) entries
+    pure $ isDisposed resourceManager
     where
-      dispose' :: IO (Awaitable ())
-      dispose' = do
-        entries <- atomically do
-          isAlreadyDisposing <- swapTVar (disposingVar resourceManager) True
-          if not isAlreadyDisposing
-            then readTVar (entriesVar resourceManager)
-            else pure Empty
+      entryStartDispose :: (IO () -> IO ()) -> ResourceManagerEntry -> IO ()
+      entryStartDispose unmask (ResourceManagerEntry var) =
+        atomically (tryReadTMVar var) >>= \case
+          Nothing -> pure ()
+          Just (_, disposable) ->
+            unmask (void $ dispose disposable)
+            `catchAll`
+            \ex -> do
+              -- Disposable failed so it should be removed
+              atomically (void $ tryTakeTMVar var)
+              throwToResourceManager resourceManager ex
+              pure ()
 
-        mapM_ entryStartDispose entries
-        pure $ isDisposed resourceManager
 
   isDisposed resourceManager =
     unsafeAwaitSTM do
@@ -253,11 +300,11 @@ withResourceManager = withRootResourceManager
 
 {-# DEPRECATED withResourceManagerM "Use withRootResourceManagerM insted" #-}
 withResourceManagerM :: (MonadAwait m, MonadMask m, MonadIO m) => ReaderT ResourceManager m a -> m a
-withResourceManagerM = withResourceManagerM
+withResourceManagerM = withRootResourceManagerM
 
 {-# DEPRECATED newUnmanagedResourceManager "Use newUnmanagedRootResourceManager insted" #-}
 newUnmanagedResourceManager :: MonadIO m => m ResourceManager
-newUnmanagedResourceManager = newUnmanagedRootResourceManager
+newUnmanagedResourceManager = newUnmanagedRootResourceManager loggingExceptionHandler
 
 newResourceManager :: MonadResourceManager m => m ResourceManager
 newResourceManager = mask_ do
diff --git a/test/Quasar/DisposableSpec.hs b/test/Quasar/DisposableSpec.hs
index c8796f38d079d5318c7d6e5df3574184af5403e6..9651659c5668ff32f45f1bcf0687c2f2c5f2d606 100644
--- a/test/Quasar/DisposableSpec.hs
+++ b/test/Quasar/DisposableSpec.hs
@@ -94,12 +94,15 @@ spec = parallel $ do
             throwIO TestException
         \TestException -> True
 
-    it "re-throws an exception from a dispose action" $ do
+    it "cancels the main thread when a dispose action fails" $ do
       shouldThrow
         do
-          withResourceManager \resourceManager ->
-            attachDisposeAction resourceManager $ throwIO TestException
-        \TestException -> True
+          withRootResourceManagerM do
+            withSubResourceManagerM do
+              registerDisposeAction $ throwIO TestException
+            liftIO $ threadDelay 100000
+            fail "Did not stop main thread on failing dispose action"
+        \TaskDisposed -> True
 
     it "can attach an disposable that is disposed asynchronously" $ do
       withResourceManager \resourceManager -> do