Don't catch async exceptions

This commit is contained in:
2026-09-17 11:05:27 +03:00
parent 27f271691c
commit 036473ab81
3 changed files with 33 additions and 10 deletions
+7 -7
View File
@@ -54,13 +54,13 @@ data Controller = forall b. Controller T.Text (HASS (Event Value) b) Bool
controllers :: [Controller]
controllers =
[ Controller "bedroom-presence" bedroomPresenceController False
, Controller "bedroom-button" bedroomButtonController False
, Controller "bedroom-drawer" bedroomDrawerController False
, Controller "bedroom-humidifier" humidifierController False
, Controller "school-light-controller" schoolLightController False
, Controller "kitchen-motion-controller" kitchenMotionController False
, Controller "livingroom-presence" livingroomPresenceController False
[ Controller "bedroom-presence" bedroomPresenceController True
, Controller "bedroom-button" bedroomButtonController True
, Controller "bedroom-drawer" bedroomDrawerController True
, Controller "bedroom-humidifier" humidifierController True
, Controller "school-light-controller" schoolLightController True
, Controller "kitchen-motion-controller" kitchenMotionController True
, Controller "livingroom-presence" livingroomPresenceController True
, Controller "hallway-motion-controller" hallwayLightsController True
]
+2 -2
View File
@@ -16,7 +16,7 @@ import Data.Void (Void)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Catch (MonadCatch, MonadMask)
import Katip (KatipContext, logFM, ls)
import Control.Retry (RetryStatus(..), recovering, fullJitterBackoff, capDelay)
import Control.Retry (RetryStatus(..), recovering, fullJitterBackoff, capDelay, skipAsyncExceptions)
import Control.Monad (when)
import Katip.Core (Severity(..))
@@ -41,7 +41,7 @@ instance Exception SupervisorException
-- restarted instead of escalated.
supervised :: (MonadIO m, MonadCatch m, KatipContext m, MonadMask m) => Text -> m Void -> m Void
supervised name action = checkpoint (Annotation name) $ do
recovering retryPolicy handlers $ \RetryStatus{rsIterNumber} -> do
recovering retryPolicy (skipAsyncExceptions ++ handlers) $ \RetryStatus{rsIterNumber} -> do
when (rsIterNumber > 0) $ logFM WarningS $ ls $ "Child crashed, retry no " <> show rsIterNumber
action
where