From 7a94a8d35463a008ea5c3977c920667cdeca9df1 Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Sat, 29 Jan 2022 21:24:27 +0100
Subject: [PATCH] Add exception channel for asynchronous exceptions
Co-authored-by: Jan Beinke <git@janbeinke.com>
---
quasar.cabal | 1 +
src/Quasar/Exceptions.hs | 28 ++++++++++++++++++++++++++++
2 files changed, 29 insertions(+)
create mode 100644 src/Quasar/Exceptions.hs
diff --git a/quasar.cabal b/quasar.cabal
index ed7c7df..d6eab27 100644
--- a/quasar.cabal
+++ b/quasar.cabal
@@ -89,6 +89,7 @@ library
Quasar.Async.Unmanaged
Quasar.Awaitable
Quasar.Disposable
+ Quasar.Exceptions
Quasar.Observable
Quasar.Observable.Delta
Quasar.Observable.ObservableHashMap
diff --git a/src/Quasar/Exceptions.hs b/src/Quasar/Exceptions.hs
new file mode 100644
index 0000000..4e7b33e
--- /dev/null
+++ b/src/Quasar/Exceptions.hs
@@ -0,0 +1,28 @@
+module Quasar.Exceptions (
+ ExceptionChannel(..),
+ throwToExceptionChannel,
+ catchInChannel,
+ catchAllInChannel,
+) where
+
+import Control.Concurrent.STM
+import Control.Monad.Catch
+import Quasar.Prelude
+
+
+newtype ExceptionChannel = ExceptionChannel (SomeException -> STM ())
+
+
+throwToExceptionChannel :: Exception e => ExceptionChannel -> e -> STM ()
+throwToExceptionChannel (ExceptionChannel channelFn) ex = channelFn (toException ex)
+
+-- TODO better name?
+catchInChannel :: forall e. Exception e => (e -> STM ()) -> ExceptionChannel -> ExceptionChannel
+catchInChannel handler parentChannel = ExceptionChannel $ mapM_ wrappedHandler . fromException
+ where
+ wrappedHandler :: e -> STM ()
+ wrappedHandler ex = catchAll (handler ex) (throwToExceptionChannel parentChannel)
+
+
+catchAllInChannel :: (SomeException -> STM ()) -> ExceptionChannel -> ExceptionChannel
+catchAllInChannel = catchInChannel
--
GitLab