Change dispose signature

src/Quasar/Core.hs

@@ -20,6 +20,14 @@ module Quasar.Core (
   async,
   await,
   awaitResult,
+
+  -- * Disposable
+  IsDisposable(..),
+  Disposable,
+  disposeIO,
+  mkDisposable,
+  synchronousDisposable,
+  noDisposable,
 ) where
 
 import Control.Concurrent (ThreadId, forkIOWithUnmask, myThreadId)
@@ -103,8 +111,8 @@ cancelTask = const (pure ())
 
 -- | Creates an `AsyncTask` from an `Awaitable`.
 -- The resulting task only depends on an external resource, so disposing it has no effect.
-toAsyncTask :: Awaitable r -> AsyncTask r
-toAsyncTask = AsyncTask
+toAsyncTask :: IsAwaitable r a => a -> AsyncTask r
+toAsyncTask = AsyncTask . toAwaitable
 
 successfulTask :: r -> AsyncTask r
 successfulTask = AsyncTask . successfulAwaitable
@@ -157,3 +165,50 @@ newResourceManager configuration = do
 disposeResourceManager :: ResourceManager -> IO ()
 -- TODO resource management
 disposeResourceManager = const (pure ())
+
+
+
+-- * Disposable
+
+class IsDisposable a where
+  -- TODO document laws: must not throw exceptions, is idempotent
+
+  -- | Dispose a resource.
+  dispose :: a -> IO (Awaitable ())
+  dispose = dispose . toDisposable
+
+  toDisposable :: a -> Disposable
+  toDisposable = mkDisposable . dispose
+
+  {-# MINIMAL toDisposable | dispose #-}
+
+-- | Dispose a resource in the IO monad.
+disposeIO :: IsDisposable a => a -> IO ()
+disposeIO = awaitIO <=< dispose
+
+instance IsDisposable a => IsDisposable (Maybe a) where
+  dispose = maybe (pure (pure ())) dispose
+
+
+newtype Disposable = Disposable (IO (Awaitable ()))
+
+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 $ pure ()
+  mconcat disposables = mkDisposable $ mconcat <$> traverse dispose disposables
+
+
+mkDisposable :: IO (Awaitable ()) -> Disposable
+mkDisposable = Disposable
+
+synchronousDisposable :: IO () -> Disposable
+synchronousDisposable = mkDisposable . fmap pure . liftIO
+
+noDisposable :: Disposable
+noDisposable = mempty

src/Quasar/Disposable.hs

 module Quasar.Disposable (
   IsDisposable(..),
   Disposable,
+  disposeIO,
   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 = withDefaultResourceManager . 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

src/Quasar/Observable.hs

@@ -188,8 +188,10 @@ instance forall v o i. (IsObservable i o, IsObservable v i) => IsObservable v (J
     innerDisposableMVar <- newMVar Nothing
     outerDisposable <- observe outer (outerCallback innerDisposableMVar)
     pure $ mkDisposable $ do
-      dispose outerDisposable
-      mapM_ dispose =<< liftIO (readMVar innerDisposableMVar)
+      -- TODO use `disposeEventually` to immediately deregister handler (ignoring messages from the old callback after that)
+      undefined
+      --dispose outerDisposable
+      --mapM_ dispose =<< liftIO (readMVar innerDisposableMVar)
       where
         outerCallback :: MVar (Maybe Disposable) -> ObservableMessage i -> IO ()
         outerCallback innerDisposableMVar message = do