From 50f7fb9905c30f3f7c1a6bbadf6823c5a046536e Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Sun, 25 Jul 2021 19:10:29 +0200
Subject: [PATCH] Move Disposable to Quasar.Disposable
---
quasar.cabal | 1 +
src/Quasar/Core.hs | 51 ------------------
src/Quasar/Disposable.hs | 53 +++++++++++++++++++
src/Quasar/Observable.hs | 1 +
src/Quasar/Observable/Delta.hs | 2 +-
src/Quasar/Observable/ObservableHashMap.hs | 1 +
src/Quasar/Observable/ObservablePriority.hs | 2 +-
.../Observable/ObservableHashMapSpec.hs | 1 +
.../Observable/ObservablePrioritySpec.hs | 1 +
9 files changed, 60 insertions(+), 53 deletions(-)
create mode 100644 src/Quasar/Disposable.hs
diff --git a/quasar.cabal b/quasar.cabal
index a151df5..bbcd9f4 100644
--- a/quasar.cabal
+++ b/quasar.cabal
@@ -78,6 +78,7 @@ library
exposed-modules:
Quasar.Awaitable
Quasar.Core
+ Quasar.Disposable
Quasar.Observable
Quasar.Observable.Delta
Quasar.Observable.ObservableHashMap
diff --git a/src/Quasar/Core.hs b/src/Quasar/Core.hs
index 15ffc90..863b7e8 100644
--- a/src/Quasar/Core.hs
+++ b/src/Quasar/Core.hs
@@ -11,13 +11,6 @@ module Quasar.Core (
newAsyncVar,
putAsyncVar,
- -- * Disposable
- IsDisposable(..),
- Disposable,
- mkDisposable,
- synchronousDisposable,
- noDisposable,
-
-- * Cancellation
withCancellationToken,
) where
@@ -250,47 +243,3 @@ withCancellationToken action = do
-- TODO test if it is better to run readMVar recursively or to keep it uninterruptible
either throwIO pure =<< (unmask (readMVar resultMVar) `catchAll` (\ex -> cancel cancellationToken ex >> readMVar resultMVar))
-
-
--- * Disposable
-
-class IsDisposable a where
- -- TODO document laws: must not throw exceptions, is idempotent
-
- -- | Dispose a resource.
- dispose :: a -> AsyncIO ()
-
- -- | Dispose a resource in the IO monad.
- disposeIO :: a -> IO ()
-
- toDisposable :: a -> Disposable
- toDisposable = mkDisposable . dispose
-
-instance IsDisposable a => IsDisposable (Maybe a) where
- dispose = mapM_ dispose
- disposeIO = mapM_ disposeIO
-
-
-newtype Disposable = Disposable (AsyncIO ())
-
-instance IsDisposable Disposable where
- dispose (Disposable fn) = fn
- disposeIO = runAsyncIO . dispose
- toDisposable = id
-
-instance Semigroup Disposable where
- x <> y = mkDisposable $ liftA2 (<>) (dispose x) (dispose y)
-
-instance Monoid Disposable where
- mempty = mkDisposable $ pure ()
- mconcat disposables = mkDisposable $ traverse_ dispose disposables
-
-
-mkDisposable :: AsyncIO () -> Disposable
-mkDisposable = Disposable
-
-synchronousDisposable :: IO () -> Disposable
-synchronousDisposable = mkDisposable . liftIO
-
-noDisposable :: Disposable
-noDisposable = mempty
diff --git a/src/Quasar/Disposable.hs b/src/Quasar/Disposable.hs
new file mode 100644
index 0000000..33eaaff
--- /dev/null
+++ b/src/Quasar/Disposable.hs
@@ -0,0 +1,53 @@
+module Quasar.Disposable (
+ IsDisposable(..),
+ Disposable,
+ mkDisposable,
+ synchronousDisposable,
+ noDisposable,
+) where
+
+import Quasar.Core
+import Quasar.Prelude
+
+-- * Disposable
+
+class IsDisposable a where
+ -- TODO document laws: must not throw exceptions, is idempotent
+
+ -- | Dispose a resource.
+ dispose :: a -> AsyncIO ()
+
+ -- | Dispose a resource in the IO monad.
+ disposeIO :: a -> IO ()
+ disposeIO = runAsyncIO . dispose
+
+ toDisposable :: a -> Disposable
+ toDisposable = mkDisposable . dispose
+
+instance IsDisposable a => IsDisposable (Maybe a) where
+ dispose = mapM_ dispose
+ disposeIO = mapM_ disposeIO
+
+
+newtype Disposable = Disposable (AsyncIO ())
+
+instance IsDisposable Disposable where
+ dispose (Disposable fn) = fn
+ toDisposable = id
+
+instance Semigroup Disposable where
+ x <> y = mkDisposable $ liftA2 (<>) (dispose x) (dispose y)
+
+instance Monoid Disposable where
+ mempty = mkDisposable $ pure ()
+ mconcat disposables = mkDisposable $ traverse_ dispose disposables
+
+
+mkDisposable :: AsyncIO () -> Disposable
+mkDisposable = Disposable
+
+synchronousDisposable :: IO () -> Disposable
+synchronousDisposable = mkDisposable . liftIO
+
+noDisposable :: Disposable
+noDisposable = mempty
diff --git a/src/Quasar/Observable.hs b/src/Quasar/Observable.hs
index e77f8cf..4a4f812 100644
--- a/src/Quasar/Observable.hs
+++ b/src/Quasar/Observable.hs
@@ -36,6 +36,7 @@ import Data.HashMap.Strict qualified as HM
import Data.IORef
import Data.Unique
import Quasar.Core
+import Quasar.Disposable
import Quasar.Prelude
diff --git a/src/Quasar/Observable/Delta.hs b/src/Quasar/Observable/Delta.hs
index c2862b2..3adb77d 100644
--- a/src/Quasar/Observable/Delta.hs
+++ b/src/Quasar/Observable/Delta.hs
@@ -7,7 +7,7 @@ module Quasar.Observable.Delta (
import Data.Binary (Binary)
import Data.Binary qualified as B
import Data.HashMap.Strict qualified as HM
-import Quasar.Core
+import Quasar.Disposable
import Quasar.Observable
import Quasar.Prelude
diff --git a/src/Quasar/Observable/ObservableHashMap.hs b/src/Quasar/Observable/ObservableHashMap.hs
index b013f03..a157128 100644
--- a/src/Quasar/Observable/ObservableHashMap.hs
+++ b/src/Quasar/Observable/ObservableHashMap.hs
@@ -15,6 +15,7 @@ import Data.Maybe (isJust)
import Language.Haskell.TH.Syntax (mkName, nameBase)
import Lens.Micro.Platform
import Quasar.Core
+import Quasar.Disposable
import Quasar.Observable
import Quasar.Observable.Delta
import Quasar.Prelude hiding (lookup, lookupDelete)
diff --git a/src/Quasar/Observable/ObservablePriority.hs b/src/Quasar/Observable/ObservablePriority.hs
index 7c926e3..9184e2e 100644
--- a/src/Quasar/Observable/ObservablePriority.hs
+++ b/src/Quasar/Observable/ObservablePriority.hs
@@ -9,7 +9,7 @@ import Data.List (maximumBy)
import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Ord (comparing)
-import Quasar.Core
+import Quasar.Disposable
import Quasar.Observable
import Quasar.Prelude
diff --git a/test/Quasar/Observable/ObservableHashMapSpec.hs b/test/Quasar/Observable/ObservableHashMapSpec.hs
index 9884802..f3cc07e 100644
--- a/test/Quasar/Observable/ObservableHashMapSpec.hs
+++ b/test/Quasar/Observable/ObservableHashMapSpec.hs
@@ -1,6 +1,7 @@
module Quasar.Observable.ObservableHashMapSpec (spec) where
import Quasar.Core
+import Quasar.Disposable
import Quasar.Observable
import Quasar.Observable.Delta
import Quasar.Observable.ObservableHashMap qualified as OM
diff --git a/test/Quasar/Observable/ObservablePrioritySpec.hs b/test/Quasar/Observable/ObservablePrioritySpec.hs
index 4278a3b..a09b9e3 100644
--- a/test/Quasar/Observable/ObservablePrioritySpec.hs
+++ b/test/Quasar/Observable/ObservablePrioritySpec.hs
@@ -1,6 +1,7 @@
module Quasar.Observable.ObservablePrioritySpec (spec) where
import Quasar.Core
+import Quasar.Disposable
import Quasar.Observable
import Quasar.Observable.ObservablePriority (ObservablePriority)
import Quasar.Observable.ObservablePriority qualified as OP
--
GitLab