diff --git a/quasar.cabal b/quasar.cabal index ed7c7dff82745534cfb432d526f8ac996daf3931..d6eab27b187b6170e290cbee894881157cef9978 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 0000000000000000000000000000000000000000..4e7b33e1bcc03691d30fb119d8a11c8de4d97bb5 --- /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