diff --git a/src/Quasar/Core.hs b/src/Quasar/Core.hs index 08646c8829606244b8ae8002166456aea4a9df23..99d089212541215cd2b34cc203bcdb80133eb11b 100644 --- a/src/Quasar/Core.hs +++ b/src/Quasar/Core.hs @@ -33,7 +33,7 @@ module Quasar.Core ( synchronousDisposable, noDisposable, disposeEventually, - boundDisposable, + attachDisposable, attachDisposeAction, attachDisposeAction_, ) where @@ -283,8 +283,8 @@ instance IsDisposable EmptyDisposable where -newDisposable :: IO (Awaitable ()) -> IO Disposable -newDisposable = fmap (toDisposable . FnDisposable) . newTMVarIO . Left +newDisposable :: MonadIO m => IO (Awaitable ()) -> m Disposable +newDisposable = liftIO . fmap (toDisposable . FnDisposable) . newTMVarIO . Left synchronousDisposable :: IO () -> IO Disposable synchronousDisposable = newDisposable . fmap pure . liftIO @@ -303,15 +303,15 @@ disposeEventually _resourceManager disposable = liftIO $ do Just (Right ()) -> pure () Nothing -> undefined -- TODO register on resourceManager --- | Creates an `Disposable` that is bound to a ResourceManager. It will automatically be disposed when the resource manager is disposed. -boundDisposable :: HasResourceManager m => IO (Awaitable ()) -> m Disposable -boundDisposable action = do - resourceManager <- askResourceManager - attachDisposeAction resourceManager action +attachDisposable :: (IsDisposable a, MonadIO m) => ResourceManager -> a -> m () +attachDisposable _resourceManager disposable = undefined -- | Creates an `Disposable` that is bound to a ResourceManager. It will automatically be disposed when the resource manager is disposed. attachDisposeAction :: MonadIO m => ResourceManager -> IO (Awaitable ()) -> m Disposable -attachDisposeAction _resourceManager _action = liftIO undefined +attachDisposeAction resourceManager action = do + disposable <- newDisposable action + attachDisposable resourceManager disposable + pure disposable -- | Attaches a dispose action to a ResourceManager. It will automatically be run when the resource manager is disposed. attachDisposeAction_ :: MonadIO m => ResourceManager -> IO (Awaitable ()) -> m () diff --git a/src/Quasar/Observable.hs b/src/Quasar/Observable.hs index bd2eb2606e51e6059c20e46fdf2eaceb4c5facb6..d4e8d8136e0463ba7f671ce06bbfe4d5a591c8f4 100644 --- a/src/Quasar/Observable.hs +++ b/src/Quasar/Observable.hs @@ -81,24 +81,26 @@ class IsRetrievable v o => IsObservable v o | o -> v where -- | Observe until the callback returns `False`. The callback will also be unsubscribed when the `ResourceManager` is disposed. observeWhile :: (IsObservable v o, HasResourceManager m) => o -> (ObservableMessage v -> IO Bool) -> m Disposable observeWhile observable callback = do - disposeVar <- liftIO $ newTVarIO False + --disposeVar <- liftIO $ newTVarIO False - innerDisposable <- liftIO $ observe observable \msg -> do - disposeRequested <- readTVarIO disposeVar - unless disposeRequested do - continue <- callback msg - unless continue $ atomically $ writeTVar disposeVar True + --innerDisposable <- liftIO $ observe observable \msg -> do + -- disposeRequested <- readTVarIO disposeVar + -- unless disposeRequested do + -- continue <- callback msg + -- unless continue $ atomically $ writeTVar disposeVar True - -- Bind the disposable to the ResourceManager, to prevent leaks if the `async` is disposed - disposable <- boundDisposable $ dispose innerDisposable + ---- Bind the disposable to the ResourceManager, to prevent leaks if the `async` is disposed + --disposable <- boundDisposable $ dispose innerDisposable - task <- async do - liftIO $ atomically do - disposeRequested <- readTVar disposeVar - unless disposeRequested retry - liftIO $ dispose disposable + --task <- async do + -- liftIO $ atomically do + -- disposeRequested <- readTVar disposeVar + -- unless disposeRequested retry + -- liftIO $ dispose disposable - pure (disposable <> (toDisposable task)) + --pure (disposable <> (toDisposable task)) + + undefined -- TODO reimplement after ResouceManager API is changed -- | Observe until the callback returns `False`. The callback will also be unsubscribed when the `ResourceManager` is disposed.