module Control.Disposable
( Disposable
, runDisposable
, Dispose(..)
) where
import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad
import Data.IORef
import Data.Semigroup
import qualified GHCJS.Foreign.Callback as J
import qualified GHCJS.Foreign.Export as J
newtype Disposable = Disposable { runDisposable :: IO () }
instance Semigroup Disposable where
(Disposable f) <> (Disposable g) = Disposable (f >> g)
instance Monoid Disposable where
mempty = Disposable (pure ())
mappend = (<>)
class Dispose a where
dispose :: a -> Disposable
instance Dispose Disposable where
dispose = id
instance Dispose (J.Callback a) where
dispose = Disposable . J.releaseCallback
instance Dispose (J.Export a) where
dispose = Disposable . J.releaseExport
instance Dispose a => Dispose (TVar a) where
dispose a = Disposable . join $ (runDisposable . dispose) <$> atomically (readTVar a)
instance Dispose a => Dispose (TMVar a) where
dispose a = Disposable . join $
(runDisposable . dispose) <$> atomically (readTMVar a)
instance Dispose a => Dispose (IORef a) where
dispose a = Disposable . join $
(runDisposable . dispose) <$> readIORef a
instance Dispose a => Dispose (MVar a) where
dispose a = Disposable . join $
(runDisposable . dispose) <$> readMVar a