diff --git a/src/Quasar/Disposable.hs b/src/Quasar/Disposable.hs index a4ee3c2c812628fe43f6d5f16f6204b9d697409a..aa2c6c877aec781b04001eeb5e0e502e562b3111 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 320b608b38f090a3a8c3e38ec148ca9b27b4ea39..f8f1341a06ccd04ac08ae0b15804f80613d3f6fe 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 8acad6937b62c8a0bbb2c08143fe6f1e861ee97d..3989064efcf8102785ed9b8744e83f3fa9650d96 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