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