    {-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
    -- For HasCallStack compatibility
    {-# LANGUAGE ImplicitParams, KindSignatures, ConstraintKinds #-}
    {-# LANGUAGE TypeApplications #-}

    -- | We wrap most objects in a "managed pointer", which is basically a
    -- 'ForeignPtr' of the appropriate type together with a notion of
    -- "disowning", which means not running the finalizers passed upon
    -- construction of the object upon garbage collection. The routines in
    -- this module deal with the memory management of such managed
    -- pointers.

    module Data.GI.Base.ManagedPtr
        (
        -- * Managed pointers
          newManagedPtr
        , newManagedPtr'
        , newManagedPtr_
        , withManagedPtr
        , maybeWithManagedPtr
        , withManagedPtrList
        , withTransient
        , unsafeManagedPtrGetPtr
        , unsafeManagedPtrCastPtr
        , touchManagedPtr
        , disownManagedPtr

        -- * Safe casting
        , castTo
        , unsafeCastTo
        , checkInstanceType

        -- * Wrappers
        , newObject
        , withNewObject
        , wrapObject
        , releaseObject
        , unrefObject
        , disownObject
        , newBoxed
        , wrapBoxed
        , copyBoxed
        , copyBoxedPtr
        , freeBoxed
        , disownBoxed
        , wrapPtr
        , newPtr
        , copyBytes
        ) where

    #if !MIN_VERSION_base(4,8,0)
    import Control.Applicative ((<$>))
    #endif
    import Control.Monad (when, void)
    import Control.Monad.Fix (mfix)

    import Data.Coerce (coerce)
    import Data.IORef (newIORef, readIORef, writeIORef, IORef)
    import Data.Maybe (isNothing, isJust)
    #if !MIN_VERSION_base(4,11,0)
    import Data.Monoid ((<>))
    #endif

    import Foreign.C (CInt(..))
    import Foreign.Ptr (Ptr, FunPtr, castPtr, nullPtr)
    import Foreign.ForeignPtr (FinalizerPtr, touchForeignPtr, newForeignPtr_)
    import qualified Foreign.Concurrent as FC
    import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

    import Data.GI.Base.BasicTypes
    import Data.GI.Base.CallStack (CallStack, HasCallStack,
                                   prettyCallStack, callStack)
    import Data.GI.Base.Utils

    import qualified Data.Text as T

    import System.IO (hPutStrLn, stderr)
    import System.Environment (lookupEnv)

    -- | Thin wrapper over `Foreign.Concurrent.newForeignPtr`.
    newManagedPtr :: HasCallStack => Ptr a -> IO () -> IO (ManagedPtr a)
    newManagedPtr :: forall a. HasCallStack => Ptr a -> IO () -> IO (ManagedPtr a)
    newManagedPtr Ptr a
    ptr IO ()
    finalizer = do
      isDisownedRef <- Maybe CallStack -> IO (IORef (Maybe CallStack))
    forall a. a -> IO (IORef a)
    newIORef Maybe CallStack
    forall a. Maybe a
    Nothing
      dbgMode <- isJust <$> lookupEnv "HASKELL_GI_DEBUG_MEM"
      let dbgCallStack = if Bool
    dbgMode
                         then CallStack -> Maybe CallStack
    forall a. a -> Maybe a
    Just CallStack
    HasCallStack => CallStack
    callStack
                         else Maybe CallStack
    forall a. Maybe a
    Nothing
      fPtr <- FC.newForeignPtr ptr (ownedFinalizer finalizer ptr dbgCallStack isDisownedRef)
      return $ ManagedPtr {
                   managedForeignPtr = fPtr
                 , managedPtrAllocCallStack = dbgCallStack
                 , managedPtrIsDisowned = isDisownedRef
                 }

    -- | Run the finalizer for an owned pointer, assuming it has now been
    -- disowned.
    ownedFinalizer :: IO () -> Ptr a -> Maybe CallStack -> IORef (Maybe CallStack)
                   -> IO ()
    ownedFinalizer :: forall a.
    IO ()
    -> Ptr a -> Maybe CallStack -> IORef (Maybe CallStack) -> IO ()
    ownedFinalizer IO ()
    finalizer Ptr a
    ptr Maybe CallStack
    allocCallStack IORef (Maybe CallStack)
    callStackRef = do
      cs <- IORef (Maybe CallStack) -> IO (Maybe CallStack)
    forall a. IORef a -> IO a
    readIORef IORef (Maybe CallStack)
    callStackRef
      -- cs will be @Just cs@ whenever the pointer has been disowned.
      when (isNothing cs) $ case allocCallStack of
                              Just CallStack
    acs -> do
                                Ptr a -> CallStack -> IO ()
    forall a. Ptr a -> CallStack -> IO ()
    printAllocDebug Ptr a
    ptr CallStack
    acs
                                IO ()
    finalizer
                                Text -> IO ()
    dbgLog (String -> Text
    T.pack String
    "Released successfully.\n")
                              Maybe CallStack
    Nothing -> IO ()
    finalizer

    -- | Print some debug diagnostics for an allocation.
    printAllocDebug :: Ptr a -> CallStack -> IO ()
    printAllocDebug :: forall a. Ptr a -> CallStack -> IO ()
    printAllocDebug Ptr a
    ptr CallStack
    allocCS =
      (Text -> IO ()
    dbgLog (Text -> IO ()) -> (String -> Text) -> String -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack) (String
    "Releasing <" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> Ptr a -> String
    forall a. Show a => a -> String
    show Ptr a
    ptr String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    ">. "
                         String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    "Callstack for allocation was:\n"
                         String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> CallStack -> String
    prettyCallStack CallStack
    allocCS String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    "\n\n")

    foreign import ccall "dynamic"
       mkFinalizer :: FinalizerPtr a -> Ptr a -> IO ()

    -- | Version of `newManagedPtr` taking a `FinalizerPtr` and a
    -- corresponding `Ptr`, as in `Foreign.ForeignPtr.newForeignPtr`.
    newManagedPtr' :: HasCallStack => FinalizerPtr a -> Ptr a -> IO (ManagedPtr a)
    newManagedPtr' :: forall a.
    HasCallStack =>
    FinalizerPtr a -> Ptr a -> IO (ManagedPtr a)
    newManagedPtr' FinalizerPtr a
    finalizer Ptr a
    ptr = Ptr a -> IO () -> IO (ManagedPtr a)
    forall a. HasCallStack => Ptr a -> IO () -> IO (ManagedPtr a)
    newManagedPtr Ptr a
    ptr (FinalizerPtr a -> Ptr a -> IO ()
    forall a. FinalizerPtr a -> Ptr a -> IO ()
    mkFinalizer FinalizerPtr a
    finalizer Ptr a
    ptr)

    -- | Thin wrapper over `Foreign.Concurrent.newForeignPtr_`.
    newManagedPtr_ :: Ptr a -> IO (ManagedPtr a)
    newManagedPtr_ :: forall a. Ptr a -> IO (ManagedPtr a)
    newManagedPtr_ Ptr a
    ptr = do
      isDisownedRef <- Maybe CallStack -> IO (IORef (Maybe CallStack))
    forall a. a -> IO (IORef a)
    newIORef Maybe CallStack
    forall a. Maybe a
    Nothing
      fPtr <- newForeignPtr_ ptr
      return $ ManagedPtr {
                   managedForeignPtr = fPtr
                 , managedPtrAllocCallStack = Nothing
                 , managedPtrIsDisowned = isDisownedRef
                 }

    -- | Do not run the finalizers upon garbage collection of the
    -- `ManagedPtr`.
    disownManagedPtr :: forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
    disownManagedPtr :: forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
    disownManagedPtr a
    managed = do
      ptr <- a -> IO (Ptr a)
    forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
    unsafeManagedPtrGetPtr a
    managed
      writeIORef (managedPtrIsDisowned c) (Just callStack)
      return (castPtr ptr)
        where c :: ManagedPtr a
    c = a -> ManagedPtr a
    forall a. ManagedPtrNewtype a => a -> ManagedPtr a
    toManagedPtr a
    managed

    -- | Perform an IO action on the 'Ptr' inside a managed pointer.
    withManagedPtr :: (HasCallStack, ManagedPtrNewtype a) => a -> (Ptr a -> IO c) -> IO c
    withManagedPtr :: forall a c.
    (HasCallStack, ManagedPtrNewtype a) =>
    a -> (Ptr a -> IO c) -> IO c
    withManagedPtr a
    managed Ptr a -> IO c
    action = do
      ptr <- a -> IO (Ptr a)
    forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
    unsafeManagedPtrGetPtr a
    managed
      result <- action ptr
      touchManagedPtr managed
      return result

    -- | Like `withManagedPtr`, but accepts a `Maybe` type. If the passed
    -- value is `Nothing` the inner action will be executed with a
    -- `nullPtr` argument.
    maybeWithManagedPtr :: (HasCallStack, ManagedPtrNewtype a) => Maybe a -> (Ptr a -> IO c) -> IO c
    maybeWithManagedPtr :: forall a c.
    (HasCallStack, ManagedPtrNewtype a) =>
    Maybe a -> (Ptr a -> IO c) -> IO c
    maybeWithManagedPtr Maybe a
    Nothing Ptr a -> IO c
    action = Ptr a -> IO c
    action Ptr a
    forall a. Ptr a
    nullPtr
    maybeWithManagedPtr (Just a
    managed) Ptr a -> IO c
    action = a -> (Ptr a -> IO c) -> IO c
    forall a c.
    (HasCallStack, ManagedPtrNewtype a) =>
    a -> (Ptr a -> IO c) -> IO c
    withManagedPtr a
    managed Ptr a -> IO c
    action

    -- | Perform an IO action taking a list of 'Ptr' on a list of managed
    -- pointers.
    withManagedPtrList :: (HasCallStack, ManagedPtrNewtype a) => [a] -> ([Ptr a] -> IO c) -> IO c
    withManagedPtrList :: forall a c.
    (HasCallStack, ManagedPtrNewtype a) =>
    [a] -> ([Ptr a] -> IO c) -> IO c
    withManagedPtrList [a]
    managedList [Ptr a] -> IO c
    action = do
      ptrs <- (a -> IO (Ptr a)) -> [a] -> IO [Ptr a]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM a -> IO (Ptr a)
    forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
    unsafeManagedPtrGetPtr [a]
    managedList
      result <- action ptrs
      mapM_ touchManagedPtr managedList
      return result

    -- | Perform the IO action with a transient managed pointer. The
    -- managed pointer will be valid while calling the action, but will be
    -- disowned as soon as the action finishes.
    withTransient :: (HasCallStack, ManagedPtrNewtype a)
                  => Ptr a -> (a -> IO b) -> IO b
    withTransient :: forall a b.
    (HasCallStack, ManagedPtrNewtype a) =>
    Ptr a -> (a -> IO b) -> IO b
    withTransient Ptr a
    ptr a -> IO b
    action = do
      managed <- ManagedPtr a -> a
    forall a b. Coercible a b => a -> b
    coerce (ManagedPtr a -> a) -> IO (ManagedPtr a) -> IO a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Ptr a -> IO (ManagedPtr a)
    forall a. Ptr a -> IO (ManagedPtr a)
    newManagedPtr_ Ptr a
    ptr
      r <- action managed
      _ <- disownManagedPtr managed
      return r

    -- | Return the 'Ptr' in a given managed pointer. As the name says,
    -- this is potentially unsafe: the given 'Ptr' may only be used
    -- /before/ a call to 'touchManagedPtr'. This function is of most
    -- interest to the autogenerated bindings, for hand-written code
    -- 'withManagedPtr' is almost always a better choice.
    unsafeManagedPtrGetPtr :: (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
    unsafeManagedPtrGetPtr :: forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
    unsafeManagedPtrGetPtr = a -> IO (Ptr a)
    forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
    unsafeManagedPtrCastPtr

    -- | Same as 'unsafeManagedPtrGetPtr', but is polymorphic on the
    -- return type.
    unsafeManagedPtrCastPtr :: forall a b. (HasCallStack, ManagedPtrNewtype a) =>
                               a -> IO (Ptr b)
    unsafeManagedPtrCastPtr :: forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
    unsafeManagedPtrCastPtr a
    m = do
        let c :: ManagedPtr a
    c = a -> ManagedPtr a
    forall a. ManagedPtrNewtype a => a -> ManagedPtr a
    toManagedPtr a
    m
            ptr :: Ptr b
    ptr = (Ptr a -> Ptr b
    forall a b. Ptr a -> Ptr b
    castPtr (Ptr a -> Ptr b)
    -> (ManagedPtr a -> Ptr a) -> ManagedPtr a -> Ptr b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ForeignPtr a -> Ptr a
    forall a. ForeignPtr a -> Ptr a
    unsafeForeignPtrToPtr (ForeignPtr a -> Ptr a)
    -> (ManagedPtr a -> ForeignPtr a) -> ManagedPtr a -> Ptr a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ManagedPtr a -> ForeignPtr a
    forall a. ManagedPtr a -> ForeignPtr a
    managedForeignPtr) ManagedPtr a
    c
        disowned <- IORef (Maybe CallStack) -> IO (Maybe CallStack)
    forall a. IORef a -> IO a
    readIORef (ManagedPtr a -> IORef (Maybe CallStack)
    forall a. ManagedPtr a -> IORef (Maybe CallStack)
    managedPtrIsDisowned ManagedPtr a
    c)
        maybe (return ptr) (notOwnedWarning ptr) disowned

    -- | Print a warning when we try to access a disowned foreign ptr.
    notOwnedWarning :: HasCallStack => Ptr a -> CallStack -> IO (Ptr a)
    notOwnedWarning :: forall a. HasCallStack => Ptr a -> CallStack -> IO (Ptr a)
    notOwnedWarning Ptr a
    ptr CallStack
    cs = do
      Handle -> String -> IO ()
    hPutStrLn Handle
    stderr (String
    "WARNING: Accessing a disowned pointer <" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Ptr a -> String
    forall a. Show a => a -> String
    show Ptr a
    ptr
                         String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ">, this may lead to crashes.\n\n"
                         String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "• Callstack for the unsafe access to the pointer:\n"
                         String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ CallStack -> String
    prettyCallStack CallStack
    HasCallStack => CallStack
    callStack String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n\n"
                         String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "• The pointer was disowned at:\n"
                         String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ CallStack -> String
    prettyCallStack CallStack
    cs String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n")
      Ptr a -> IO (Ptr a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Ptr a
    ptr

    -- | Ensure that the 'Ptr' in the given managed pointer is still alive
    -- (i.e. it has not been garbage collected by the runtime) at the
    -- point that this is called.
    touchManagedPtr :: forall a. ManagedPtrNewtype a => a -> IO ()
    touchManagedPtr :: forall a. ManagedPtrNewtype a => a -> IO ()
    touchManagedPtr a
    m = let c :: ManagedPtr a
    c = a -> ManagedPtr a
    forall a. ManagedPtrNewtype a => a -> ManagedPtr a
    toManagedPtr a
    m
                        in (ForeignPtr a -> IO ()
    forall a. ForeignPtr a -> IO ()
    touchForeignPtr (ForeignPtr a -> IO ())
    -> (ManagedPtr a -> ForeignPtr a) -> ManagedPtr a -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ManagedPtr a -> ForeignPtr a
    forall a. ManagedPtr a -> ForeignPtr a
    managedForeignPtr) ManagedPtr a
    c

    -- Safe casting machinery
    foreign import ccall unsafe "check_object_type"
        c_check_object_type :: Ptr o -> CGType -> IO CInt

    -- | Check whether the given object is an instance of the given type.
    checkInstanceType :: (ManagedPtrNewtype o, TypedObject o) =>
                         o -> GType -> IO Bool
    checkInstanceType :: forall o.
    (ManagedPtrNewtype o, TypedObject o) =>
    o -> GType -> IO Bool
    checkInstanceType o
    obj (GType CGType
    cgtype) = o -> (Ptr o -> IO Bool) -> IO Bool
    forall a c.
    (HasCallStack, ManagedPtrNewtype a) =>
    a -> (Ptr a -> IO c) -> IO c
    withManagedPtr o
    obj ((Ptr o -> IO Bool) -> IO Bool) -> (Ptr o -> IO Bool) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ \Ptr o
    objPtr -> do
      check <- Ptr o -> CGType -> IO CInt
    forall o. Ptr o -> CGType -> IO CInt
    c_check_object_type Ptr o
    objPtr CGType
    cgtype
      return $ check /= 0

    -- | Cast from one object type to another, checking that the cast is
    -- valid. If it is not, we return `Nothing`. Usage:
    --
    -- > maybeWidget <- castTo Widget label
    castTo :: forall o o'. (HasCallStack,
                            ManagedPtrNewtype o, TypedObject o,
                            ManagedPtrNewtype o', TypedObject o',
                            GObject o') =>
              (ManagedPtr o' -> o') -> o -> IO (Maybe o')
    castTo :: forall o o'.
    (HasCallStack, ManagedPtrNewtype o, TypedObject o,
     ManagedPtrNewtype o', TypedObject o', GObject o') =>
    (ManagedPtr o' -> o') -> o -> IO (Maybe o')
    castTo ManagedPtr o' -> o'
    constructor o
    obj = do
      gtype <- forall a. TypedObject a => IO GType
    glibType @o'
      isInstance <- checkInstanceType obj gtype
      if isInstance
        then return . Just . constructor . coerce $ toManagedPtr obj
        else return Nothing

    -- | Cast a typed object to a new type (without any assumption that
    -- both types descend from `GObject`), assuming that the cast will
    -- succeed. This function will call `error` if the cast is illegal.
    unsafeCastTo :: forall o o'. (HasCallStack,
                                  ManagedPtrNewtype o, TypedObject o,
                                  ManagedPtrNewtype o', TypedObject o') =>
                    (ManagedPtr o' -> o') -> o -> IO o'
    unsafeCastTo :: forall o o'.
    (HasCallStack, ManagedPtrNewtype o, TypedObject o,
     ManagedPtrNewtype o', TypedObject o') =>
    (ManagedPtr o' -> o') -> o -> IO o'
    unsafeCastTo ManagedPtr o' -> o'
    constructor o
    obj = do
        gtype <- forall a. TypedObject a => IO GType
    glibType @o'
        isInstance <- checkInstanceType obj gtype
        if not isInstance
          then do
          srcType <- glibType @o >>= gtypeName
          destType <- glibType @o' >>= gtypeName
          error $ "unsafeCastTo :: invalid conversion from " ++ srcType ++ " to "
            ++ destType ++ " requested."
          else return (constructor $ coerce $ toManagedPtr obj)

    -- Reference counting for constructors
    foreign import ccall "&dbg_g_object_unref"
        ptr_to_g_object_unref :: FunPtr (Ptr a -> IO ())

    foreign import ccall "g_object_ref_sink" g_object_ref_sink ::
        Ptr a -> IO (Ptr a)

    -- | Print a warning when receiving a null pointer in a function that
    -- did not expect one, for easier debugging.
    nullPtrWarning :: String -> CallStack -> IO ()
    nullPtrWarning :: String -> CallStack -> IO ()
    nullPtrWarning String
    fn CallStack
    cs =
      Handle -> String -> IO ()
    hPutStrLn Handle
    stderr (String
    "WARNING: Trying to wrap a null pointer in " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    quotedFn
                         String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", this may lead to crashes.\n\n"
                         String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "• Callstack for the unsafe call to "
                         String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    quotedFn String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ":\n"
                         String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ CallStack -> String
    prettyCallStack CallStack
    cs String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n\n"
                         String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "This is probably a bug in the introspection data,\n"
                         String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "please report it at https://github.com/haskell-gi/haskell-gi/issues")
      where quotedFn :: String
    quotedFn = String
    "‘" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    fn String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "’"

    -- | Construct a Haskell wrapper for a 'GObject', increasing its
    -- reference count, or taking ownership of the floating reference if
    -- there is one.
    newObject :: (HasCallStack, GObject a, GObject b) =>
                 (ManagedPtr a -> a) -> Ptr b -> IO a
    newObject :: forall a b.
    (HasCallStack, GObject a, GObject b) =>
    (ManagedPtr a -> a) -> Ptr b -> IO a
    newObject ManagedPtr a -> a
    constructor Ptr b
    ptr = do
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Ptr b
    ptr Ptr b -> Ptr b -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ptr b
    forall a. Ptr a
    nullPtr) (String -> CallStack -> IO ()
    nullPtrWarning String
    "newObject" CallStack
    HasCallStack => CallStack
    callStack)
      IO (Ptr b) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Ptr b) -> IO ()) -> IO (Ptr b) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Ptr b -> IO (Ptr b)
    forall a. Ptr a -> IO (Ptr a)
    g_object_ref_sink Ptr b
    ptr
      fPtr <- FinalizerPtr a -> Ptr a -> IO (ManagedPtr a)
    forall a.
    HasCallStack =>
    FinalizerPtr a -> Ptr a -> IO (ManagedPtr a)
    newManagedPtr' FinalizerPtr a
    forall a. FunPtr (Ptr a -> IO ())
    ptr_to_g_object_unref (Ptr a -> IO (ManagedPtr a)) -> Ptr a -> IO (ManagedPtr a)
    forall a b. (a -> b) -> a -> b
    $ Ptr b -> Ptr a
    forall a b. Ptr a -> Ptr b
    castPtr Ptr b
    ptr
      return $! constructor fPtr

    -- | Perform the given IO action with a wrapped copy of the given ptr
    -- to a GObject. Note that this increases the reference count of the
    -- wrapped GObject, similarly to 'newObject'.
    withNewObject :: (HasCallStack, GObject o)
                      => Ptr o -> (o -> IO b) -> IO b
    withNewObject :: forall o b.
    (HasCallStack, GObject o) =>
    Ptr o -> (o -> IO b) -> IO b
    withNewObject Ptr o
    ptr o -> IO b
    action = do
      IO (Ptr o) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Ptr o) -> IO ()) -> IO (Ptr o) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Ptr o -> IO (Ptr o)
    forall a. Ptr a -> IO (Ptr a)
    g_object_ref_sink Ptr o
    ptr
      managed <- FinalizerPtr (ZonkAny 4)
    -> Ptr (ZonkAny 4) -> IO (ManagedPtr (ZonkAny 4))
    forall a.
    HasCallStack =>
    FinalizerPtr a -> Ptr a -> IO (ManagedPtr a)
    newManagedPtr' FinalizerPtr (ZonkAny 4)
    forall a. FunPtr (Ptr a -> IO ())
    ptr_to_g_object_unref (Ptr (ZonkAny 4) -> IO (ManagedPtr (ZonkAny 4)))
    -> Ptr (ZonkAny 4) -> IO (ManagedPtr (ZonkAny 4))
    forall a b. (a -> b) -> a -> b
    $ Ptr o -> Ptr (ZonkAny 4)
    forall a b. Ptr a -> Ptr b
    castPtr Ptr o
    ptr
      action (coerce managed)

    -- | Same as 'newObject', but we steal ownership of the object.
    wrapObject :: forall a b. (HasCallStack, GObject a, GObject b) =>
                  (ManagedPtr a -> a) -> Ptr b -> IO a
    wrapObject :: forall a b.
    (HasCallStack, GObject a, GObject b) =>
    (ManagedPtr a -> a) -> Ptr b -> IO a
    wrapObject ManagedPtr a -> a
    constructor Ptr b
    ptr = do
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Ptr b
    ptr Ptr b -> Ptr b -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ptr b
    forall a. Ptr a
    nullPtr) (String -> CallStack -> IO ()
    nullPtrWarning String
    "wrapObject" CallStack
    HasCallStack => CallStack
    callStack)
      fPtr <- FinalizerPtr a -> Ptr a -> IO (ManagedPtr a)
    forall a.
    HasCallStack =>
    FinalizerPtr a -> Ptr a -> IO (ManagedPtr a)
    newManagedPtr' FinalizerPtr a
    forall a. FunPtr (Ptr a -> IO ())
    ptr_to_g_object_unref (Ptr a -> IO (ManagedPtr a)) -> Ptr a -> IO (ManagedPtr a)
    forall a b. (a -> b) -> a -> b
    $ Ptr b -> Ptr a
    forall a b. Ptr a -> Ptr b
    castPtr Ptr b
    ptr
      return $! constructor fPtr

    -- | Unref the given `GObject` and disown it. Use this if you want to
    -- manually release the memory associated to a given `GObject`
    -- (assuming that no other reference to the underlying C object exists)
    -- before the garbage collector does it. It is typically not safe to
    -- access the `GObject` after calling this function.
    releaseObject :: (HasCallStack, GObject a) => a -> IO ()
    releaseObject :: forall a. (HasCallStack, GObject a) => a -> IO ()
    releaseObject a
    obj = do
      ptr <- a -> IO (Ptr (ZonkAny 1))
    forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
    disownObject a
    obj
      dbgDealloc obj
      dbg_g_object_unref ptr

    -- It is fine to use unsafe here, since all this does is schedule an
    -- idle callback. The scheduling itself will never block for a long
    -- time, or call back into Haskell.
    foreign import ccall unsafe "dbg_g_object_unref"
            dbg_g_object_unref :: Ptr a -> IO ()

    -- | Decrease the reference count of the given 'GObject'. The memory
    -- associated with the object may be released if the reference count
    -- reaches 0.
    unrefObject :: (HasCallStack, GObject a) => a -> IO ()
    unrefObject :: forall a. (HasCallStack, GObject a) => a -> IO ()
    unrefObject a
    obj = a -> (Ptr a -> IO ()) -> IO ()
    forall a c.
    (HasCallStack, ManagedPtrNewtype a) =>
    a -> (Ptr a -> IO c) -> IO c
    withManagedPtr a
    obj ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr a
    ptr -> do
      a -> IO ()
    forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO ()
    dbgDealloc a
    obj
      Ptr a -> IO ()
    forall a. Ptr a -> IO ()
    dbg_g_object_unref Ptr a
    ptr

    -- | Print some debug info (if the right environment valiable is set)
    -- about the object being disowned.
    foreign import ccall "dbg_g_object_disown"
            dbg_g_object_disown :: Ptr a -> IO ()

    -- | Disown a GObject, that is, do not unref the associated foreign
    -- GObject when the Haskell object gets garbage collected. Returns the
    -- pointer to the underlying GObject.
    disownObject :: (HasCallStack, GObject a) => a -> IO (Ptr b)
    disownObject :: forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
    disownObject a
    obj = a -> (Ptr a -> IO (Ptr b)) -> IO (Ptr b)
    forall a c.
    (HasCallStack, ManagedPtrNewtype a) =>
    a -> (Ptr a -> IO c) -> IO c
    withManagedPtr a
    obj ((Ptr a -> IO (Ptr b)) -> IO (Ptr b))
    -> (Ptr a -> IO (Ptr b)) -> IO (Ptr b)
    forall a b. (a -> b) -> a -> b
    $ \Ptr a
    ptr -> do
      a -> IO ()
    forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO ()
    dbgDealloc a
    obj
      Ptr a -> IO ()
    forall a. Ptr a -> IO ()
    dbg_g_object_disown Ptr a
    ptr
      Ptr (ZonkAny 0) -> Ptr b
    forall a b. Ptr a -> Ptr b
    castPtr (Ptr (ZonkAny 0) -> Ptr b) -> IO (Ptr (ZonkAny 0)) -> IO (Ptr b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> IO (Ptr (ZonkAny 0))
    forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
    disownManagedPtr a
    obj

    -- It is fine to use unsafe here, since all this does is schedule an
    -- idle callback. The scheduling itself will never block for a long
    -- time, or call back into Haskell.
    foreign import ccall unsafe "boxed_free_helper" boxed_free_helper ::
        CGType -> Ptr a -> IO ()

    foreign import ccall "g_boxed_copy" g_boxed_copy ::
        CGType -> Ptr a -> IO (Ptr a)

    -- | Construct a Haskell wrapper for the given boxed object. We make a
    -- copy of the object.
    newBoxed :: forall a. (HasCallStack, GBoxed a) => (ManagedPtr a -> a) -> Ptr a -> IO a
    newBoxed :: forall a.
    (HasCallStack, GBoxed a) =>
    (ManagedPtr a -> a) -> Ptr a -> IO a
    newBoxed ManagedPtr a -> a
    constructor Ptr a
    ptr = do
      GType gtype <- forall a. TypedObject a => IO GType
    glibType @a
      ptr' <- g_boxed_copy gtype ptr
      fPtr <- newManagedPtr ptr' (boxed_free_helper gtype ptr')
      return $! constructor fPtr

    -- | Like 'newBoxed', but we do not make a copy (we "steal" the passed
    -- object, so now it is managed by the Haskell runtime).
    wrapBoxed :: forall a. (HasCallStack, GBoxed a) => (ManagedPtr a -> a) -> Ptr a -> IO a
    wrapBoxed :: forall a.
    (HasCallStack, GBoxed a) =>
    (ManagedPtr a -> a) -> Ptr a -> IO a
    wrapBoxed ManagedPtr a -> a
    constructor Ptr a
    ptr = do
      GType gtype <- forall a. TypedObject a => IO GType
    glibType @a
      fPtr <- newManagedPtr ptr (boxed_free_helper gtype ptr)
      return $! constructor fPtr

    -- | Make a copy of the given boxed object.
    copyBoxed :: forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
    copyBoxed :: forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
    copyBoxed a
    b = do
      GType gtype <- forall a. TypedObject a => IO GType
    glibType @a
      withManagedPtr b (g_boxed_copy gtype)

    -- | Like 'copyBoxed', but acting directly on a pointer, instead of a
    -- managed pointer.
    copyBoxedPtr :: forall a. GBoxed a => Ptr a -> IO (Ptr a)
    copyBoxedPtr :: forall a. GBoxed a => Ptr a -> IO (Ptr a)
    copyBoxedPtr Ptr a
    ptr = do
      GType gtype <- forall a. TypedObject a => IO GType
    glibType @a
      g_boxed_copy gtype ptr

    foreign import ccall "g_boxed_free" g_boxed_free ::
        CGType -> Ptr a -> IO ()

    -- | Free the memory associated with a boxed object. Note that this
    -- disowns the associated `ManagedPtr` via `disownManagedPtr`.
    freeBoxed :: forall a. (HasCallStack, GBoxed a) => a -> IO ()
    freeBoxed :: forall a. (HasCallStack, GBoxed a) => a -> IO ()
    freeBoxed a
    boxed = do
      GType gtype <- forall a. TypedObject a => IO GType
    glibType @a
      ptr <- disownManagedPtr boxed
      dbgDealloc boxed
      g_boxed_free gtype ptr

    -- | Disown a boxed object, that is, do not free the associated
    -- foreign GBoxed when the Haskell object gets garbage
    -- collected. Returns the pointer to the underlying `GBoxed`.
    disownBoxed :: (HasCallStack, GBoxed a) => a -> IO (Ptr a)
    disownBoxed :: forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
    disownBoxed = a -> IO (Ptr a)
    forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
    disownManagedPtr

    -- | Wrap a pointer, taking ownership of it.
    wrapPtr :: (HasCallStack, BoxedPtr a) => (ManagedPtr a -> a) -> Ptr a -> IO a
    wrapPtr :: forall a.
    (HasCallStack, BoxedPtr a) =>
    (ManagedPtr a -> a) -> Ptr a -> IO a
    wrapPtr ManagedPtr a -> a
    constructor Ptr a
    ptr = (a -> IO a) -> IO a
    forall a. (a -> IO a) -> IO a
    forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
    mfix ((a -> IO a) -> IO a) -> (a -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \a
    wrapped -> do
      fPtr <- Ptr a -> IO () -> IO (ManagedPtr a)
    forall a. HasCallStack => Ptr a -> IO () -> IO (ManagedPtr a)
    newManagedPtr Ptr a
    ptr (a -> IO ()
    forall a. BoxedPtr a => a -> IO ()
    boxedPtrFree a
    wrapped)
      return $! constructor fPtr

    -- | Wrap a pointer, making a copy of the data.
    newPtr :: (HasCallStack, BoxedPtr a) => (ManagedPtr a -> a) -> Ptr a -> IO a
    newPtr :: forall a.
    (HasCallStack, BoxedPtr a) =>
    (ManagedPtr a -> a) -> Ptr a -> IO a
    newPtr ManagedPtr a -> a
    constructor Ptr a
    ptr = do
      tmpWrap <- Ptr a -> IO (ManagedPtr a)
    forall a. Ptr a -> IO (ManagedPtr a)
    newManagedPtr_ Ptr a
    ptr
      ptr' <- boxedPtrCopy (constructor tmpWrap)
      return $! ptr'

    -- | Make a copy of a wrapped pointer using @memcpy@ into a freshly
    -- allocated memory region of the given size.
    copyBytes :: (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
    copyBytes :: forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
    copyBytes Int
    size Ptr a
    ptr = do
      ptr' <- IO (Ptr a)
    forall a. CallocPtr a => IO (Ptr a)
    boxedPtrCalloc
      memcpy ptr' ptr size
      return ptr'

    foreign import ccall unsafe "g_thread_self" g_thread_self :: IO (Ptr ())

    -- | Same as `dbgDeallocPtr`, but for `ManagedPtr`s, and no callstack
    -- needs to be provided.
    dbgDealloc :: (HasCallStack, ManagedPtrNewtype a) => a -> IO ()
    dbgDealloc :: forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO ()
    dbgDealloc a
    m = do
      env <- String -> IO (Maybe String)
    lookupEnv String
    "HASKELL_GI_DEBUG_MEM"
      case env of
        Maybe String
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        Just String
    _ -> do
          let mPtr :: ManagedPtr a
    mPtr = a -> ManagedPtr a
    forall a. ManagedPtrNewtype a => a -> ManagedPtr a
    toManagedPtr a
    m
              ptr :: Ptr a
    ptr = (ForeignPtr a -> Ptr a
    forall a. ForeignPtr a -> Ptr a
    unsafeForeignPtrToPtr (ForeignPtr a -> Ptr a)
    -> (ManagedPtr a -> ForeignPtr a) -> ManagedPtr a -> Ptr a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ManagedPtr a -> ForeignPtr a
    forall a. ManagedPtr a -> ForeignPtr a
    managedForeignPtr) ManagedPtr a
    mPtr
          threadPtr <- IO (Ptr ())
    g_thread_self
          hPutStrLn stderr ("Releasing <" ++ show ptr ++ "> from thread ["
                             ++ show threadPtr ++ "].\n"
                             ++ (case managedPtrAllocCallStack mPtr of
                                   Just CallStack
    allocCS -> String
    "• Callstack for allocation:\n"
                                                   String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ CallStack -> String
    prettyCallStack CallStack
    allocCS String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n\n"
                                   Maybe CallStack
    Nothing -> String
    "")
                             ++ "• CallStack for deallocation:\n"
                             ++ prettyCallStack callStack ++ "\n")