-- | 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)

-- | 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

instance BoxedObject (GClosure a) where
    boxedType :: GClosure a -> IO GType
boxedType _ = IO GType
c_g_closure_get_type

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 ptr :: 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 closurePtr :: 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
/= 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, BoxedObject 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 closure :: 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. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
disownManagedPtr