module Control.Disposable where
import qualified Data.DList as D
import Data.Foldable
import Data.Semigroup
import qualified GHC.Generics as G
import qualified GHCJS.Foreign.Callback as J
class Disposable a where
dispose :: a -> IO ()
data SomeDisposable where
DisposeNone :: SomeDisposable
Dispose :: forall a. Disposable a => a -> SomeDisposable
DisposeList :: forall a. Disposable a => [a] -> SomeDisposable
instance Disposable SomeDisposable where
dispose DisposeNone = pure ()
dispose (Dispose a) = dispose a
dispose (DisposeList as) = traverse_ dispose as
class Disposing a where
disposing :: a -> SomeDisposable
default disposing :: (G.Generic a, GDisposing (G.Rep a)) => a -> SomeDisposable
disposing x = DisposeList . D.toList . gDisposing $ G.from x
instance Disposable (J.Callback a) where
dispose = J.releaseCallback
instance Disposing (J.Callback a) where
disposing = Dispose
class GDisposing f where
gDisposing :: f p -> D.DList SomeDisposable
instance GDisposing G.U1 where
gDisposing G.U1 = mempty
instance (GDisposing f, GDisposing g) => GDisposing (f G.:+: g) where
gDisposing (G.L1 x) = gDisposing x
gDisposing (G.R1 x) = gDisposing x
instance (GDisposing f, GDisposing g) => GDisposing (f G.:*: g) where
gDisposing (x G.:*: y) = (gDisposing x) <> (gDisposing y)
instance (Disposing c) => GDisposing (G.K1 i c) where
gDisposing (G.K1 x) = D.singleton $ disposing x
instance (GDisposing f) => GDisposing (G.M1 i t f) where
gDisposing (G.M1 x) = gDisposing x