From cbc4277c5039f37bf53d1b5e79b87a8510d3ae43 Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Tue, 31 Aug 2021 20:53:51 +0200
Subject: [PATCH] Change `dispose` signature to use MonadIO
---
src/Quasar/Disposable.hs | 6 +++---
src/Quasar/Timer.hs | 2 +-
test/Quasar/DisposableSpec.hs | 10 ++++------
3 files changed, 8 insertions(+), 10 deletions(-)
diff --git a/src/Quasar/Disposable.hs b/src/Quasar/Disposable.hs
index a4ee3c2..aa2c6c8 100644
--- a/src/Quasar/Disposable.hs
+++ b/src/Quasar/Disposable.hs
@@ -56,7 +56,7 @@ class IsDisposable a where
-- | Dispose a resource.
-- TODO MonadIO
- dispose :: a -> IO (Awaitable ())
+ dispose :: MonadIO m => a -> m (Awaitable ())
dispose = dispose . toDisposable
isDisposed :: a -> Awaitable ()
@@ -100,7 +100,7 @@ instance IsAwaitable () Disposable where
newtype FnDisposable = FnDisposable (TMVar (Either (IO (Awaitable ())) (Awaitable ())))
instance IsDisposable FnDisposable where
- dispose (FnDisposable var) = do
+ dispose (FnDisposable var) = liftIO do
mask \restore -> do
eitherVal <- atomically do
takeTMVar var >>= \case
@@ -272,7 +272,7 @@ data ResourceManager = ResourceManager {
}
instance IsDisposable ResourceManager where
- dispose resourceManager = mask \unmask ->
+ dispose resourceManager = liftIO $ mask \unmask ->
unmask dispose' `catchAll` \ex -> setException resourceManager ex >> throwIO ex
where
dispose' :: IO (Awaitable ())
diff --git a/src/Quasar/Timer.hs b/src/Quasar/Timer.hs
index 320b608..f8f1341 100644
--- a/src/Quasar/Timer.hs
+++ b/src/Quasar/Timer.hs
@@ -46,7 +46,7 @@ instance Ord Timer where
x `compare` y = time x `compare` time y
instance IsDisposable Timer where
- dispose self = do
+ dispose self = liftIO do
atomically do
cancelled <- failAsyncVarSTM (completed self) TimerCancelled
when cancelled do
diff --git a/test/Quasar/DisposableSpec.hs b/test/Quasar/DisposableSpec.hs
index 8acad69..3989064 100644
--- a/test/Quasar/DisposableSpec.hs
+++ b/test/Quasar/DisposableSpec.hs
@@ -16,19 +16,17 @@ spec :: Spec
spec = parallel $ do
describe "Disposable" $ do
describe "noDisposable" $ do
- it "can be disposed" $ do
+ it "can be disposed" $ io do
await =<< dispose noDisposable
- it "can be awaited" $ do
+ it "can be awaited" $ io do
await (isDisposed noDisposable)
- pure () :: IO ()
describe "newDisposable" $ do
- it "signals it's disposed state" $ do
+ it "signals it's disposed state" $ io do
disposable <- newDisposable $ pure $ pure ()
void $ forkIO $ threadDelay 100000 >> disposeAndAwait disposable
await (isDisposed disposable)
- pure () :: IO ()
it "can be disposed multiple times" $ io do
disposable <- newDisposable $ pure $ pure ()
@@ -47,7 +45,7 @@ spec = parallel $ do
it "can be created" $ io do
void unsafeNewResourceManager
- it "can be created and disposed" $ do
+ it "can be created and disposed" $ io do
resourceManager <- unsafeNewResourceManager
await =<< dispose resourceManager
--
GitLab