{-# LANGUAGE TypeFamilies, DataKinds #-} -- | Some helper functions for dealing with @GClosure@s. module Data.GI.Base.GClosure ( GClosure(..) , newGClosure , wrapGClosurePtr , newGClosureFromPtr , noGClosure , unrefGClosure , disownGClosure ) where import Foreign.Ptr (Ptr, FunPtr, nullPtr) import Foreign.C (CInt(..)) import Control.Monad (when) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.GI.Base.BasicTypes import Data.GI.Base.CallStack (HasCallStack) import Data.GI.Base.ManagedPtr (newBoxed, newManagedPtr', disownManagedPtr, withManagedPtr) import Data.GI.Base.Overloading (ParentTypes, HasParentTypes) -- | The basic type. This corresponds to a wrapped @GClosure@ on the C -- side, which is a boxed object. newtype GClosure a = GClosure (ManagedPtr (GClosure a)) -- | A convenience alias for @Nothing :: Maybe (GClosure a)@. noGClosure :: Maybe (GClosure a) noGClosure :: Maybe (GClosure a) noGClosure = Maybe (GClosure a) forall a. Maybe a Nothing foreign import ccall "g_closure_get_type" c_g_closure_get_type :: IO GType -- | There are no types in the bindings that a closure can be safely -- cast to. type instance ParentTypes (GClosure a) = '[] instance HasParentTypes (GClosure a) -- | Find the associated `GType` for the given closure. instance TypedObject (GClosure a) where glibType :: IO GType glibType = IO GType c_g_closure_get_type -- | `GClosure`s are registered as boxed in the GLib type system. instance GBoxed (GClosure a) foreign import ccall "g_cclosure_new" g_cclosure_new :: FunPtr a -> Ptr () -> FunPtr c -> IO (Ptr (GClosure a)) -- Releasing the `FunPtr` for the signal handler. foreign import ccall "& haskell_gi_release_signal_closure" ptr_to_release_closure :: FunPtr (Ptr () -> Ptr () -> IO ()) -- | Create a new `GClosure` holding the given `FunPtr`. Note that -- after calling this the `FunPtr` will be freed whenever the -- `GClosure` is garbage collected, so it is generally not safe to -- refer to the generated `FunPtr` after this function returns. newGClosure :: MonadIO m => FunPtr a -> m (GClosure a) newGClosure :: FunPtr a -> m (GClosure a) newGClosure FunPtr a ptr = IO (GClosure a) -> m (GClosure a) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (GClosure a) -> m (GClosure a)) -> IO (GClosure a) -> m (GClosure a) forall a b. (a -> b) -> a -> b $ do Ptr (GClosure a) closure <- FunPtr a -> Ptr () -> FunPtr (Ptr () -> Ptr () -> IO ()) -> IO (Ptr (GClosure a)) forall a c. FunPtr a -> Ptr () -> FunPtr c -> IO (Ptr (GClosure a)) g_cclosure_new FunPtr a ptr Ptr () forall a. Ptr a nullPtr FunPtr (Ptr () -> Ptr () -> IO ()) ptr_to_release_closure Ptr (GClosure a) -> IO (GClosure a) forall a. Ptr (GClosure a) -> IO (GClosure a) wrapGClosurePtr Ptr (GClosure a) closure foreign import ccall g_closure_ref :: Ptr (GClosure a) -> IO (Ptr (GClosure a)) foreign import ccall g_closure_sink :: Ptr (GClosure a) -> IO () foreign import ccall g_closure_unref :: Ptr (GClosure a) -> IO () foreign import ccall "&g_closure_unref" ptr_to_g_closure_unref :: FunPtr (Ptr (GClosure a) -> IO ()) foreign import ccall "haskell_gi_g_closure_is_floating" g_closure_is_floating :: Ptr (GClosure a) -> IO CInt -- | Take ownership of a passed in 'Ptr' to a 'GClosure'. wrapGClosurePtr :: Ptr (GClosure a) -> IO (GClosure a) wrapGClosurePtr :: Ptr (GClosure a) -> IO (GClosure a) wrapGClosurePtr Ptr (GClosure a) closurePtr = do CInt floating <- Ptr (GClosure a) -> IO CInt forall a. Ptr (GClosure a) -> IO CInt g_closure_is_floating Ptr (GClosure a) closurePtr Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when (CInt floating CInt -> CInt -> Bool forall a. Eq a => a -> a -> Bool /= CInt 0) (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $ do Ptr (GClosure a) _ <- Ptr (GClosure a) -> IO (Ptr (GClosure a)) forall a. Ptr (GClosure a) -> IO (Ptr (GClosure a)) g_closure_ref Ptr (GClosure a) closurePtr Ptr (GClosure a) -> IO () forall a. Ptr (GClosure a) -> IO () g_closure_sink Ptr (GClosure a) closurePtr ManagedPtr (GClosure a) fPtr <- FinalizerPtr (GClosure a) -> Ptr (GClosure a) -> IO (ManagedPtr (GClosure a)) forall a. HasCallStack => FinalizerPtr a -> Ptr a -> IO (ManagedPtr a) newManagedPtr' FinalizerPtr (GClosure a) forall a. FunPtr (Ptr (GClosure a) -> IO ()) ptr_to_g_closure_unref Ptr (GClosure a) closurePtr GClosure a -> IO (GClosure a) forall (m :: * -> *) a. Monad m => a -> m a return (GClosure a -> IO (GClosure a)) -> GClosure a -> IO (GClosure a) forall a b. (a -> b) -> a -> b $! ManagedPtr (GClosure a) -> GClosure a forall a. ManagedPtr (GClosure a) -> GClosure a GClosure ManagedPtr (GClosure a) fPtr -- | Construct a Haskell wrapper for the 'GClosure', without assuming -- ownership. newGClosureFromPtr :: Ptr (GClosure a) -> IO (GClosure a) newGClosureFromPtr :: Ptr (GClosure a) -> IO (GClosure a) newGClosureFromPtr = (ManagedPtr (GClosure a) -> GClosure a) -> Ptr (GClosure a) -> IO (GClosure a) forall a. (HasCallStack, GBoxed a) => (ManagedPtr a -> a) -> Ptr a -> IO a newBoxed ManagedPtr (GClosure a) -> GClosure a forall a. ManagedPtr (GClosure a) -> GClosure a GClosure -- | Decrease the reference count of the given 'GClosure'. If the -- reference count reaches 0 the memory will be released. unrefGClosure :: (HasCallStack, MonadIO m) => GClosure a -> m () unrefGClosure :: GClosure a -> m () unrefGClosure GClosure a closure = IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> IO () -> m () forall a b. (a -> b) -> a -> b $ GClosure a -> (Ptr (GClosure a) -> IO ()) -> IO () forall a c. (HasCallStack, ManagedPtrNewtype a) => a -> (Ptr a -> IO c) -> IO c withManagedPtr GClosure a closure Ptr (GClosure a) -> IO () forall a. Ptr (GClosure a) -> IO () g_closure_unref -- | Disown (that is, remove from te purview of the Haskell Garbage -- Collector) the given 'GClosure'. disownGClosure :: GClosure a -> IO (Ptr (GClosure a)) disownGClosure :: GClosure a -> IO (Ptr (GClosure a)) disownGClosure = GClosure a -> IO (Ptr (GClosure a)) forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b) disownManagedPtr