{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Heaps are similar to a partially sorted tree but implemented as an
-- array. They allow for efficient O(1) lookup of the highest priority
-- item as it will always be the first item of the array.
-- 
-- To create a new heap use 'GI.Dazzle.Structs.Heap.heapNew'.
-- 
-- To add items to the heap, use @/dzl_heap_insert_val()/@ or
-- 'GI.Dazzle.Structs.Heap.heapInsertVals' to insert in bulk.
-- 
-- To access an item in the heap, use @/dzl_heap_index()/@.
-- 
-- To remove an arbitrary item from the heap, use 'GI.Dazzle.Structs.Heap.heapExtractIndex'.
-- 
-- To remove the highest priority item in the heap, use 'GI.Dazzle.Structs.Heap.heapExtract'.
-- 
-- To free a heap, use 'GI.Dazzle.Structs.Heap.heapUnref'.
-- 
-- Here is an example that stores integers in a t'GI.Dazzle.Structs.Heap.Heap':
-- 
-- === /C code/
-- >
-- >static int
-- >cmpint (gconstpointer a,
-- >        gconstpointer b)
-- >{
-- >  return *(const gint *)a - *(const gint *)b;
-- >}
-- >
-- >int
-- >main (gint   argc,
-- >      gchar *argv[])
-- >{
-- >  DzlHeap *heap;
-- >  gint i;
-- >  gint v;
-- >
-- >  heap = dzl_heap_new (sizeof (gint), cmpint);
-- >
-- >  for (i = 0; i < 10000; i++)
-- >    dzl_heap_insert_val (heap, i);
-- >  for (i = 0; i < 10000; i++)
-- >    dzl_heap_extract (heap, &v);
-- >
-- >  dzl_heap_unref (heap);
-- >}
-- 

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Dazzle.Structs.Heap
    ( 

-- * Exported types
    Heap(..)                                ,
    newZeroHeap                             ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [extract]("GI.Dazzle.Structs.Heap#g:method:extract"), [extractIndex]("GI.Dazzle.Structs.Heap#g:method:extractIndex"), [insertVals]("GI.Dazzle.Structs.Heap#g:method:insertVals"), [ref]("GI.Dazzle.Structs.Heap#g:method:ref"), [unref]("GI.Dazzle.Structs.Heap#g:method:unref").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveHeapMethod                       ,
#endif

-- ** extract #method:extract#

#if defined(ENABLE_OVERLOADING)
    HeapExtractMethodInfo                   ,
#endif
    heapExtract                             ,


-- ** extractIndex #method:extractIndex#

#if defined(ENABLE_OVERLOADING)
    HeapExtractIndexMethodInfo              ,
#endif
    heapExtractIndex                        ,


-- ** insertVals #method:insertVals#

#if defined(ENABLE_OVERLOADING)
    HeapInsertValsMethodInfo                ,
#endif
    heapInsertVals                          ,


-- ** new #method:new#

    heapNew                                 ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    HeapRefMethodInfo                       ,
#endif
    heapRef                                 ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    HeapUnrefMethodInfo                     ,
#endif
    heapUnref                               ,




 -- * Properties


-- ** data #attr:data#
-- | /No description available in the introspection data./

    clearHeapData                           ,
    getHeapData                             ,
#if defined(ENABLE_OVERLOADING)
    heap_data                               ,
#endif
    setHeapData                             ,


-- ** len #attr:len#
-- | /No description available in the introspection data./

    getHeapLen                              ,
#if defined(ENABLE_OVERLOADING)
    heap_len                                ,
#endif
    setHeapLen                              ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.Callbacks as GLib.Callbacks

#else
import qualified GI.GLib.Callbacks as GLib.Callbacks

#endif

-- | Memory-managed wrapper type.
newtype Heap = Heap (SP.ManagedPtr Heap)
    deriving (Heap -> Heap -> Bool
(Heap -> Heap -> Bool) -> (Heap -> Heap -> Bool) -> Eq Heap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Heap -> Heap -> Bool
== :: Heap -> Heap -> Bool
$c/= :: Heap -> Heap -> Bool
/= :: Heap -> Heap -> Bool
Eq)

instance SP.ManagedPtrNewtype Heap where
    toManagedPtr :: Heap -> ManagedPtr Heap
toManagedPtr (Heap ManagedPtr Heap
p) = ManagedPtr Heap
p

foreign import ccall "dzl_heap_get_type" c_dzl_heap_get_type :: 
    IO GType

type instance O.ParentTypes Heap = '[]
instance O.HasParentTypes Heap

instance B.Types.TypedObject Heap where
    glibType :: IO GType
glibType = IO GType
c_dzl_heap_get_type

instance B.Types.GBoxed Heap

-- | Convert 'Heap' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Heap) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_dzl_heap_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Heap -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Heap
P.Nothing = Ptr GValue -> Ptr Heap -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr Heap
forall a. Ptr a
FP.nullPtr :: FP.Ptr Heap)
    gvalueSet_ Ptr GValue
gv (P.Just Heap
obj) = Heap -> (Ptr Heap -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Heap
obj (Ptr GValue -> Ptr Heap -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Heap)
gvalueGet_ Ptr GValue
gv = do
        Ptr Heap
ptr <- Ptr GValue -> IO (Ptr Heap)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr Heap)
        if Ptr Heap
ptr Ptr Heap -> Ptr Heap -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Heap
forall a. Ptr a
FP.nullPtr
        then Heap -> Maybe Heap
forall a. a -> Maybe a
P.Just (Heap -> Maybe Heap) -> IO Heap -> IO (Maybe Heap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Heap -> Heap) -> Ptr Heap -> IO Heap
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Heap -> Heap
Heap Ptr Heap
ptr
        else Maybe Heap -> IO (Maybe Heap)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Heap
forall a. Maybe a
P.Nothing
        
    

-- | Construct a `Heap` struct initialized to zero.
newZeroHeap :: MonadIO m => m Heap
newZeroHeap :: forall (m :: * -> *). MonadIO m => m Heap
newZeroHeap = IO Heap -> m Heap
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Heap -> m Heap) -> IO Heap -> m Heap
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr Heap)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
16 IO (Ptr Heap) -> (Ptr Heap -> IO Heap) -> IO Heap
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Heap -> Heap) -> Ptr Heap -> IO Heap
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Heap -> Heap
Heap

instance tag ~ 'AttrSet => Constructible Heap tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr Heap -> Heap) -> [AttrOp Heap tag] -> m Heap
new ManagedPtr Heap -> Heap
_ [AttrOp Heap tag]
attrs = do
        Heap
o <- m Heap
forall (m :: * -> *). MonadIO m => m Heap
newZeroHeap
        Heap -> [AttrOp Heap 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set Heap
o [AttrOp Heap tag]
[AttrOp Heap 'AttrSet]
attrs
        Heap -> m Heap
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Heap
o


-- | Get the value of the “@data@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' heap #data
-- @
getHeapData :: MonadIO m => Heap -> m (Maybe T.Text)
getHeapData :: forall (m :: * -> *). MonadIO m => Heap -> m (Maybe Text)
getHeapData Heap
s = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Heap -> (Ptr Heap -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Heap
s ((Ptr Heap -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr Heap -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr Heap
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr Heap
ptr Ptr Heap -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@data@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' heap [ #data 'Data.GI.Base.Attributes.:=' value ]
-- @
setHeapData :: MonadIO m => Heap -> CString -> m ()
setHeapData :: forall (m :: * -> *). MonadIO m => Heap -> CString -> m ()
setHeapData Heap
s CString
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Heap -> (Ptr Heap -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Heap
s ((Ptr Heap -> IO ()) -> IO ()) -> (Ptr Heap -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Heap
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Heap
ptr Ptr Heap -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CString
val :: CString)

-- | Set the value of the “@data@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #data
-- @
clearHeapData :: MonadIO m => Heap -> m ()
clearHeapData :: forall (m :: * -> *). MonadIO m => Heap -> m ()
clearHeapData Heap
s = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Heap -> (Ptr Heap -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Heap
s ((Ptr Heap -> IO ()) -> IO ()) -> (Ptr Heap -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Heap
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Heap
ptr Ptr Heap -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data HeapDataFieldInfo
instance AttrInfo HeapDataFieldInfo where
    type AttrBaseTypeConstraint HeapDataFieldInfo = (~) Heap
    type AttrAllowedOps HeapDataFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint HeapDataFieldInfo = (~) CString
    type AttrTransferTypeConstraint HeapDataFieldInfo = (~)CString
    type AttrTransferType HeapDataFieldInfo = CString
    type AttrGetType HeapDataFieldInfo = Maybe T.Text
    type AttrLabel HeapDataFieldInfo = "data"
    type AttrOrigin HeapDataFieldInfo = Heap
    attrGet = getHeapData
    attrSet = setHeapData
    attrConstruct = undefined
    attrClear = clearHeapData
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Heap.data"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Heap.html#g:attr:data"
        })

heap_data :: AttrLabelProxy "data"
heap_data = AttrLabelProxy

#endif


-- | Get the value of the “@len@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' heap #len
-- @
getHeapLen :: MonadIO m => Heap -> m FCT.CSize
getHeapLen :: forall (m :: * -> *). MonadIO m => Heap -> m CSize
getHeapLen Heap
s = IO CSize -> m CSize
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> m CSize) -> IO CSize -> m CSize
forall a b. (a -> b) -> a -> b
$ Heap -> (Ptr Heap -> IO CSize) -> IO CSize
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Heap
s ((Ptr Heap -> IO CSize) -> IO CSize)
-> (Ptr Heap -> IO CSize) -> IO CSize
forall a b. (a -> b) -> a -> b
$ \Ptr Heap
ptr -> do
    CSize
val <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek (Ptr Heap
ptr Ptr Heap -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO FCT.CSize
    CSize -> IO CSize
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CSize
val

-- | Set the value of the “@len@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' heap [ #len 'Data.GI.Base.Attributes.:=' value ]
-- @
setHeapLen :: MonadIO m => Heap -> FCT.CSize -> m ()
setHeapLen :: forall (m :: * -> *). MonadIO m => Heap -> CSize -> m ()
setHeapLen Heap
s CSize
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Heap -> (Ptr Heap -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Heap
s ((Ptr Heap -> IO ()) -> IO ()) -> (Ptr Heap -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Heap
ptr -> do
    Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Heap
ptr Ptr Heap -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CSize
val :: FCT.CSize)

#if defined(ENABLE_OVERLOADING)
data HeapLenFieldInfo
instance AttrInfo HeapLenFieldInfo where
    type AttrBaseTypeConstraint HeapLenFieldInfo = (~) Heap
    type AttrAllowedOps HeapLenFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint HeapLenFieldInfo = (~) FCT.CSize
    type AttrTransferTypeConstraint HeapLenFieldInfo = (~)FCT.CSize
    type AttrTransferType HeapLenFieldInfo = FCT.CSize
    type AttrGetType HeapLenFieldInfo = FCT.CSize
    type AttrLabel HeapLenFieldInfo = "len"
    type AttrOrigin HeapLenFieldInfo = Heap
    attrGet = getHeapLen
    attrSet = setHeapLen
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Heap.len"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Heap.html#g:attr:len"
        })

heap_len :: AttrLabelProxy "len"
heap_len = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Heap
type instance O.AttributeList Heap = HeapAttributeList
type HeapAttributeList = ('[ '("data", HeapDataFieldInfo), '("len", HeapLenFieldInfo)] :: [(Symbol, DK.Type)])
#endif

-- method Heap::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "element_size"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the size of each element in the heap"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "compare_func"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "CompareFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a function to compare to elements"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Dazzle" , name = "Heap" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_heap_new" dzl_heap_new :: 
    Word32 ->                               -- element_size : TBasicType TUInt
    FunPtr GLib.Callbacks.C_CompareFunc ->  -- compare_func : TInterface (Name {namespace = "GLib", name = "CompareFunc"})
    IO (Ptr Heap)

-- | Creates a new t'GI.Dazzle.Structs.Heap.Heap'. A heap is a tree-like structure stored in
-- an array that is not fully sorted, but head is guaranteed to be either
-- the max, or min value based on /@compareFunc@/. This is also known as
-- a priority queue.
heapNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@elementSize@/: the size of each element in the heap
    -> GLib.Callbacks.CompareFunc
    -- ^ /@compareFunc@/: a function to compare to elements
    -> m Heap
    -- ^ __Returns:__ A newly allocated t'GI.Dazzle.Structs.Heap.Heap'
heapNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32 -> CompareFunc -> m Heap
heapNew Word32
elementSize CompareFunc
compareFunc = IO Heap -> m Heap
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Heap -> m Heap) -> IO Heap -> m Heap
forall a b. (a -> b) -> a -> b
$ do
    Ptr (FunPtr C_CompareFunc)
ptrcompareFunc <- IO (Ptr (FunPtr C_CompareFunc))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr GLib.Callbacks.C_CompareFunc))
    FunPtr C_CompareFunc
compareFunc' <- C_CompareFunc -> IO (FunPtr C_CompareFunc)
GLib.Callbacks.mk_CompareFunc (Maybe (Ptr (FunPtr C_CompareFunc))
-> C_CompareFunc -> C_CompareFunc
GLib.Callbacks.wrap_CompareFunc (Ptr (FunPtr C_CompareFunc) -> Maybe (Ptr (FunPtr C_CompareFunc))
forall a. a -> Maybe a
Just Ptr (FunPtr C_CompareFunc)
ptrcompareFunc) (CompareFunc -> C_CompareFunc
GLib.Callbacks.drop_closures_CompareFunc CompareFunc
compareFunc))
    Ptr (FunPtr C_CompareFunc) -> FunPtr C_CompareFunc -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_CompareFunc)
ptrcompareFunc FunPtr C_CompareFunc
compareFunc'
    Ptr Heap
result <- Word32 -> FunPtr C_CompareFunc -> IO (Ptr Heap)
dzl_heap_new Word32
elementSize FunPtr C_CompareFunc
compareFunc'
    Text -> Ptr Heap -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"heapNew" Ptr Heap
result
    Heap
result' <- ((ManagedPtr Heap -> Heap) -> Ptr Heap -> IO Heap
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Heap -> Heap
Heap) Ptr Heap
result
    Heap -> IO Heap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Heap
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Heap::extract
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "heap"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Heap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_heap_extract" dzl_heap_extract :: 
    Ptr Heap ->                             -- heap : TInterface (Name {namespace = "Dazzle", name = "Heap"})
    Ptr () ->                               -- result : TBasicType TPtr
    IO CInt

-- | /No description available in the introspection data./
heapExtract ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Heap
    -> Ptr ()
    -> m Bool
heapExtract :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Heap -> Ptr () -> m Bool
heapExtract Heap
heap Ptr ()
result_ = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Heap
heap' <- Heap -> IO (Ptr Heap)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Heap
heap
    CInt
result <- Ptr Heap -> Ptr () -> IO CInt
dzl_heap_extract Ptr Heap
heap' Ptr ()
result_
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Heap -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Heap
heap
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data HeapExtractMethodInfo
instance (signature ~ (Ptr () -> m Bool), MonadIO m) => O.OverloadedMethod HeapExtractMethodInfo Heap signature where
    overloadedMethod = heapExtract

instance O.OverloadedMethodInfo HeapExtractMethodInfo Heap where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Heap.heapExtract",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Heap.html#v:heapExtract"
        })


#endif

-- method Heap::extract_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "heap"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Heap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TSize
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_heap_extract_index" dzl_heap_extract_index :: 
    Ptr Heap ->                             -- heap : TInterface (Name {namespace = "Dazzle", name = "Heap"})
    FCT.CSize ->                            -- index_ : TBasicType TSize
    Ptr () ->                               -- result : TBasicType TPtr
    IO CInt

-- | /No description available in the introspection data./
heapExtractIndex ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Heap
    -> FCT.CSize
    -> Ptr ()
    -> m Bool
heapExtractIndex :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Heap -> CSize -> Ptr () -> m Bool
heapExtractIndex Heap
heap CSize
index_ Ptr ()
result_ = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Heap
heap' <- Heap -> IO (Ptr Heap)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Heap
heap
    CInt
result <- Ptr Heap -> CSize -> Ptr () -> IO CInt
dzl_heap_extract_index Ptr Heap
heap' CSize
index_ Ptr ()
result_
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Heap -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Heap
heap
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data HeapExtractIndexMethodInfo
instance (signature ~ (FCT.CSize -> Ptr () -> m Bool), MonadIO m) => O.OverloadedMethod HeapExtractIndexMethodInfo Heap signature where
    overloadedMethod = heapExtractIndex

instance O.OverloadedMethodInfo HeapExtractIndexMethodInfo Heap where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Heap.heapExtractIndex",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Heap.html#v:heapExtractIndex"
        })


#endif

-- method Heap::insert_vals
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "heap"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Heap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "len"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_heap_insert_vals" dzl_heap_insert_vals :: 
    Ptr Heap ->                             -- heap : TInterface (Name {namespace = "Dazzle", name = "Heap"})
    Ptr () ->                               -- data : TBasicType TPtr
    Word32 ->                               -- len : TBasicType TUInt
    IO ()

-- | /No description available in the introspection data./
heapInsertVals ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Heap
    -> Ptr ()
    -> Word32
    -> m ()
heapInsertVals :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Heap -> Ptr () -> Word32 -> m ()
heapInsertVals Heap
heap Ptr ()
data_ Word32
len = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Heap
heap' <- Heap -> IO (Ptr Heap)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Heap
heap
    Ptr Heap -> Ptr () -> Word32 -> IO ()
dzl_heap_insert_vals Ptr Heap
heap' Ptr ()
data_ Word32
len
    Heap -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Heap
heap
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data HeapInsertValsMethodInfo
instance (signature ~ (Ptr () -> Word32 -> m ()), MonadIO m) => O.OverloadedMethod HeapInsertValsMethodInfo Heap signature where
    overloadedMethod = heapInsertVals

instance O.OverloadedMethodInfo HeapInsertValsMethodInfo Heap where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Heap.heapInsertVals",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Heap.html#v:heapInsertVals"
        })


#endif

-- method Heap::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "heap"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Heap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #DzlHeap" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Dazzle" , name = "Heap" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_heap_ref" dzl_heap_ref :: 
    Ptr Heap ->                             -- heap : TInterface (Name {namespace = "Dazzle", name = "Heap"})
    IO (Ptr Heap)

-- | Increments the reference count of /@heap@/ by one.
heapRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Heap
    -- ^ /@heap@/: An t'GI.Dazzle.Structs.Heap.Heap'
    -> m Heap
    -- ^ __Returns:__ /@heap@/
heapRef :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Heap -> m Heap
heapRef Heap
heap = IO Heap -> m Heap
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Heap -> m Heap) -> IO Heap -> m Heap
forall a b. (a -> b) -> a -> b
$ do
    Ptr Heap
heap' <- Heap -> IO (Ptr Heap)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Heap
heap
    Ptr Heap
result <- Ptr Heap -> IO (Ptr Heap)
dzl_heap_ref Ptr Heap
heap'
    Text -> Ptr Heap -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"heapRef" Ptr Heap
result
    Heap
result' <- ((ManagedPtr Heap -> Heap) -> Ptr Heap -> IO Heap
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Heap -> Heap
Heap) Ptr Heap
result
    Heap -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Heap
heap
    Heap -> IO Heap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Heap
result'

#if defined(ENABLE_OVERLOADING)
data HeapRefMethodInfo
instance (signature ~ (m Heap), MonadIO m) => O.OverloadedMethod HeapRefMethodInfo Heap signature where
    overloadedMethod = heapRef

instance O.OverloadedMethodInfo HeapRefMethodInfo Heap where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Heap.heapRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Heap.html#v:heapRef"
        })


#endif

-- method Heap::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "heap"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Heap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #DzlHeap" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_heap_unref" dzl_heap_unref :: 
    Ptr Heap ->                             -- heap : TInterface (Name {namespace = "Dazzle", name = "Heap"})
    IO ()

-- | Decrements the reference count of /@heap@/ by one, freeing the structure
-- when the reference count reaches zero.
heapUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Heap
    -- ^ /@heap@/: An t'GI.Dazzle.Structs.Heap.Heap'
    -> m ()
heapUnref :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Heap -> m ()
heapUnref Heap
heap = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Heap
heap' <- Heap -> IO (Ptr Heap)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Heap
heap
    Ptr Heap -> IO ()
dzl_heap_unref Ptr Heap
heap'
    Heap -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Heap
heap
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data HeapUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod HeapUnrefMethodInfo Heap signature where
    overloadedMethod = heapUnref

instance O.OverloadedMethodInfo HeapUnrefMethodInfo Heap where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Heap.heapUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Heap.html#v:heapUnref"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveHeapMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveHeapMethod "extract" o = HeapExtractMethodInfo
    ResolveHeapMethod "extractIndex" o = HeapExtractIndexMethodInfo
    ResolveHeapMethod "insertVals" o = HeapInsertValsMethodInfo
    ResolveHeapMethod "ref" o = HeapRefMethodInfo
    ResolveHeapMethod "unref" o = HeapUnrefMethodInfo
    ResolveHeapMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveHeapMethod t Heap, O.OverloadedMethod info Heap p) => OL.IsLabel t (Heap -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveHeapMethod t Heap, O.OverloadedMethod info Heap p, R.HasField t Heap p) => R.HasField t Heap p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveHeapMethod t Heap, O.OverloadedMethodInfo info Heap) => OL.IsLabel t (O.MethodProxy info Heap) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif