From 044a6455002dff49818911f6b22ba237c90d91ca Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Thu, 10 Feb 2022 20:03:50 +0100
Subject: [PATCH] Move some exceptions to Exceptions module

---
 src/Quasar/Async/Unmanaged.hs | 28 ++-------------------
 src/Quasar/Exceptions.hs      | 46 +++++++++++++++++++++++++++++++++++
 src/Quasar/ResourceManager.hs |  7 +-----
 3 files changed, 49 insertions(+), 32 deletions(-)

diff --git a/src/Quasar/Async/Unmanaged.hs b/src/Quasar/Async/Unmanaged.hs
index 4415471..4b6f400 100644
--- a/src/Quasar/Async/Unmanaged.hs
+++ b/src/Quasar/Async/Unmanaged.hs
@@ -18,12 +18,13 @@ module Quasar.Async.Unmanaged (
 import Control.Concurrent (ThreadId, forkIO, forkIOWithUnmask, throwTo)
 import Control.Concurrent.STM
 import Control.Monad.Catch
+import Quasar.Exceptions
 import Quasar.Awaitable
 import Quasar.Disposable
 import Quasar.Prelude
 
 
--- | An async is an asynchronously running computation that can be cancelled.
+-- | A async is an asynchronously running computation that can be cancelled.
 --
 -- The result (or exception) can be aquired by using the `IsAwaitable` class (e.g. by calling `await` or `awaitIO`).
 -- It is possible to cancel the async by using `dispose` if the operation has not been completed.
@@ -60,31 +61,6 @@ instance Functor Async where
   fmap fn (Async key actionVar finalizerVar resultAwaitable) = Async key actionVar finalizerVar (fn <$> resultAwaitable)
 
 
-data CancelAsync = CancelAsync Unique
-  deriving stock Eq
-instance Show CancelAsync where
-  show _ = "CancelAsync"
-instance Exception CancelAsync where
-
-data AsyncDisposed = AsyncDisposed
-  deriving stock (Eq, Show)
-instance Exception AsyncDisposed where
-
--- TODO Needs a descriptive name. This is similar in functionality to `ExceptionThrownInLinkedThread`
-data AsyncException = AsyncException SomeException
-  deriving stock Show
-  deriving anyclass Exception
-
-
-isCancelAsync :: SomeException -> Bool
-isCancelAsync (fromException @CancelAsync -> Just _) = True
-isCancelAsync _ = False
-
-isAsyncDisposed :: SomeException -> Bool
-isAsyncDisposed (fromException @AsyncDisposed -> Just _) = True
-isAsyncDisposed _ = False
-
-
 
 -- | Base implementation for the `unmanagedAsync`- and `Quasar.Async.async`-class of functions.
 unmanagedAsyncWithHandlerAndUnmask :: MonadIO m => (SomeException -> IO ()) -> ((forall b. IO b -> IO b) -> IO a) -> m (Async a)
diff --git a/src/Quasar/Exceptions.hs b/src/Quasar/Exceptions.hs
index 4e7b33e..1c2fe45 100644
--- a/src/Quasar/Exceptions.hs
+++ b/src/Quasar/Exceptions.hs
@@ -3,6 +3,15 @@ module Quasar.Exceptions (
   throwToExceptionChannel,
   catchInChannel,
   catchAllInChannel,
+
+  -- * Exceptions
+  CancelAsync(..),
+  AsyncDisposed(..),
+  AsyncException(..),
+  isCancelAsync,
+  isAsyncDisposed,
+  DisposeException(..),
+  isDisposeException,
 ) where
 
 import Control.Concurrent.STM
@@ -26,3 +35,40 @@ catchInChannel handler parentChannel = ExceptionChannel $ mapM_ wrappedHandler .
 
 catchAllInChannel :: (SomeException -> STM ()) -> ExceptionChannel -> ExceptionChannel
 catchAllInChannel = catchInChannel
+
+
+newtype CancelAsync = CancelAsync Unique
+  deriving stock Eq
+instance Show CancelAsync where
+  show _ = "CancelAsync"
+instance Exception CancelAsync where
+
+data AsyncDisposed = AsyncDisposed
+  deriving stock (Eq, Show)
+instance Exception AsyncDisposed where
+
+-- TODO Needs a descriptive name. This is similar in functionality to `ExceptionThrownInLinkedThread`
+newtype AsyncException = AsyncException SomeException
+  deriving stock Show
+  deriving anyclass Exception
+
+
+isCancelAsync :: SomeException -> Bool
+isCancelAsync (fromException @CancelAsync -> Just _) = True
+isCancelAsync _ = False
+
+isAsyncDisposed :: SomeException -> Bool
+isAsyncDisposed (fromException @AsyncDisposed -> Just _) = True
+isAsyncDisposed _ = False
+
+
+  
+data DisposeException = DisposeException SomeException
+  deriving stock Show
+
+instance Exception DisposeException where
+  displayException (DisposeException inner) = "Exception was thrown while disposing a resource: " <> displayException inner
+
+isDisposeException :: SomeException -> Bool
+isDisposeException (fromException @DisposeException -> Just _) = True
+isDisposeException _ = False
diff --git a/src/Quasar/ResourceManager.hs b/src/Quasar/ResourceManager.hs
index 70593ca..1f879c7 100644
--- a/src/Quasar/ResourceManager.hs
+++ b/src/Quasar/ResourceManager.hs
@@ -59,16 +59,11 @@ import Data.Sequence qualified as Seq
 import Quasar.Async.Unmanaged
 import Quasar.Awaitable
 import Quasar.Disposable
+import Quasar.Exceptions
 import Quasar.Prelude
 import Quasar.Utils.Exceptions
 
 
-data DisposeException = DisposeException SomeException
-  deriving stock Show
-
-instance Exception DisposeException where
-  displayException (DisposeException inner) = "Exception was thrown while disposing: " <> displayException inner
-
 data FailedToRegisterResource = FailedToRegisterResource
   deriving stock (Eq, Show)
 
-- 
GitLab