{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Represents the entries in an index object.

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

module GI.Ggit.Structs.IndexEntries
    ( 

-- * Exported types
    IndexEntries(..)                        ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveIndexEntriesMethod               ,
#endif


-- ** getByIndex #method:getByIndex#

#if defined(ENABLE_OVERLOADING)
    IndexEntriesGetByIndexMethodInfo        ,
#endif
    indexEntriesGetByIndex                  ,


-- ** getByPath #method:getByPath#

#if defined(ENABLE_OVERLOADING)
    IndexEntriesGetByPathMethodInfo         ,
#endif
    indexEntriesGetByPath                   ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    IndexEntriesRefMethodInfo               ,
#endif
    indexEntriesRef                         ,


-- ** size #method:size#

#if defined(ENABLE_OVERLOADING)
    IndexEntriesSizeMethodInfo              ,
#endif
    indexEntriesSize                        ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    IndexEntriesUnrefMethodInfo             ,
#endif
    indexEntriesUnref                       ,




    ) 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.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
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.Text as T
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 {-# SOURCE #-} qualified GI.Ggit.Structs.IndexEntry as Ggit.IndexEntry
import qualified GI.Gio.Interfaces.File as Gio.File

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

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

foreign import ccall "ggit_index_entries_get_type" c_ggit_index_entries_get_type :: 
    IO GType

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

instance B.Types.TypedObject IndexEntries where
    glibType :: IO GType
glibType = IO GType
c_ggit_index_entries_get_type

instance B.Types.GBoxed IndexEntries

-- | Convert 'IndexEntries' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue IndexEntries where
    toGValue :: IndexEntries -> IO GValue
toGValue IndexEntries
o = do
        GType
gtype <- IO GType
c_ggit_index_entries_get_type
        IndexEntries -> (Ptr IndexEntries -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr IndexEntries
o (GType
-> (GValue -> Ptr IndexEntries -> IO ())
-> Ptr IndexEntries
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr IndexEntries -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO IndexEntries
fromGValue GValue
gv = do
        Ptr IndexEntries
ptr <- GValue -> IO (Ptr IndexEntries)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr IndexEntries)
        (ManagedPtr IndexEntries -> IndexEntries)
-> Ptr IndexEntries -> IO IndexEntries
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr IndexEntries -> IndexEntries
IndexEntries Ptr IndexEntries
ptr
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList IndexEntries
type instance O.AttributeList IndexEntries = IndexEntriesAttributeList
type IndexEntriesAttributeList = ('[ ] :: [(Symbol, *)])
#endif

-- method IndexEntries::get_by_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entries"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntries" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntries."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "idx"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the entry."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Ggit" , name = "IndexEntry" })
-- throws : False
-- Skip return : False

foreign import ccall "ggit_index_entries_get_by_index" ggit_index_entries_get_by_index :: 
    Ptr IndexEntries ->                     -- entries : TInterface (Name {namespace = "Ggit", name = "IndexEntries"})
    Word64 ->                               -- idx : TBasicType TUInt64
    IO (Ptr Ggit.IndexEntry.IndexEntry)

-- | Get a t'GI.Ggit.Structs.IndexEntry.IndexEntry' by index. Note that the returned t'GI.Ggit.Structs.IndexEntry.IndexEntry' is
-- _only_ valid as long as:
-- 
-- 1) The associated index has been closed
-- 2) The entry has not been removed (see 'GI.Ggit.Objects.Index.indexRemove')
-- 3) The index has not been refreshed (see 'GI.Ggit.Objects.Index.indexRead')
-- 
-- Changes to the t'GI.Ggit.Structs.IndexEntry.IndexEntry' will be reflected in the index once written
-- back to disk using 'GI.Ggit.Objects.Index.indexWrite'.
indexEntriesGetByIndex ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntries
    -- ^ /@entries@/: a t'GI.Ggit.Structs.IndexEntries.IndexEntries'.
    -> Word64
    -- ^ /@idx@/: the index of the entry.
    -> m (Maybe Ggit.IndexEntry.IndexEntry)
    -- ^ __Returns:__ a t'GI.Ggit.Structs.IndexEntry.IndexEntry' or 'P.Nothing' if out of bounds.
indexEntriesGetByIndex :: IndexEntries -> Word64 -> m (Maybe IndexEntry)
indexEntriesGetByIndex IndexEntries
entries Word64
idx = IO (Maybe IndexEntry) -> m (Maybe IndexEntry)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe IndexEntry) -> m (Maybe IndexEntry))
-> IO (Maybe IndexEntry) -> m (Maybe IndexEntry)
forall a b. (a -> b) -> a -> b
$ do
    Ptr IndexEntries
entries' <- IndexEntries -> IO (Ptr IndexEntries)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntries
entries
    Ptr IndexEntry
result <- Ptr IndexEntries -> Word64 -> IO (Ptr IndexEntry)
ggit_index_entries_get_by_index Ptr IndexEntries
entries' Word64
idx
    Maybe IndexEntry
maybeResult <- Ptr IndexEntry
-> (Ptr IndexEntry -> IO IndexEntry) -> IO (Maybe IndexEntry)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr IndexEntry
result ((Ptr IndexEntry -> IO IndexEntry) -> IO (Maybe IndexEntry))
-> (Ptr IndexEntry -> IO IndexEntry) -> IO (Maybe IndexEntry)
forall a b. (a -> b) -> a -> b
$ \Ptr IndexEntry
result' -> do
        IndexEntry
result'' <- ((ManagedPtr IndexEntry -> IndexEntry)
-> Ptr IndexEntry -> IO IndexEntry
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr IndexEntry -> IndexEntry
Ggit.IndexEntry.IndexEntry) Ptr IndexEntry
result'
        IndexEntry -> IO IndexEntry
forall (m :: * -> *) a. Monad m => a -> m a
return IndexEntry
result''
    IndexEntries -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntries
entries
    Maybe IndexEntry -> IO (Maybe IndexEntry)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe IndexEntry
maybeResult

#if defined(ENABLE_OVERLOADING)
data IndexEntriesGetByIndexMethodInfo
instance (signature ~ (Word64 -> m (Maybe Ggit.IndexEntry.IndexEntry)), MonadIO m) => O.MethodInfo IndexEntriesGetByIndexMethodInfo IndexEntries signature where
    overloadedMethod = indexEntriesGetByIndex

#endif

-- method IndexEntries::get_by_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entries"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntries" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntries."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the path to search."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stage"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "stage to search." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Ggit" , name = "IndexEntry" })
-- throws : False
-- Skip return : False

foreign import ccall "ggit_index_entries_get_by_path" ggit_index_entries_get_by_path :: 
    Ptr IndexEntries ->                     -- entries : TInterface (Name {namespace = "Ggit", name = "IndexEntries"})
    Ptr Gio.File.File ->                    -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Int32 ->                                -- stage : TBasicType TInt
    IO (Ptr Ggit.IndexEntry.IndexEntry)

-- | Get a t'GI.Ggit.Structs.IndexEntry.IndexEntry' by index. Note that the returned t'GI.Ggit.Structs.IndexEntry.IndexEntry' is
-- _only_ valid as long as:
-- 
-- 1) The associated index has not been closed
-- 2) The entry has not been removed (see 'GI.Ggit.Objects.Index.indexRemove')
-- 3) The index has not been refreshed (see 'GI.Ggit.Objects.Index.indexRead')
-- 
-- Changes to the t'GI.Ggit.Structs.IndexEntry.IndexEntry' will be reflected in the index once written
-- back to disk using 'GI.Ggit.Objects.Index.indexWrite'.
-- 
-- /@stage@/ indicates the stage to search the file for. Stages are used in the
-- index when merge conflicts occur, such that multiple versions of the same
-- file can be represented in the index. Stage 0 is associated with the working
-- tree, while stages 1 to 3 are associated with the various versions of the
-- file in a merge conflict. The special value -1 can be used to match the first
-- file encountered in any stage.
indexEntriesGetByPath ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.File.IsFile a) =>
    IndexEntries
    -- ^ /@entries@/: a t'GI.Ggit.Structs.IndexEntries.IndexEntries'.
    -> a
    -- ^ /@file@/: the path to search.
    -> Int32
    -- ^ /@stage@/: stage to search.
    -> m (Maybe Ggit.IndexEntry.IndexEntry)
    -- ^ __Returns:__ a t'GI.Ggit.Structs.IndexEntry.IndexEntry' or 'P.Nothing' if it was not found.
indexEntriesGetByPath :: IndexEntries -> a -> Int32 -> m (Maybe IndexEntry)
indexEntriesGetByPath IndexEntries
entries a
file Int32
stage = IO (Maybe IndexEntry) -> m (Maybe IndexEntry)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe IndexEntry) -> m (Maybe IndexEntry))
-> IO (Maybe IndexEntry) -> m (Maybe IndexEntry)
forall a b. (a -> b) -> a -> b
$ do
    Ptr IndexEntries
entries' <- IndexEntries -> IO (Ptr IndexEntries)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntries
entries
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr IndexEntry
result <- Ptr IndexEntries -> Ptr File -> Int32 -> IO (Ptr IndexEntry)
ggit_index_entries_get_by_path Ptr IndexEntries
entries' Ptr File
file' Int32
stage
    Maybe IndexEntry
maybeResult <- Ptr IndexEntry
-> (Ptr IndexEntry -> IO IndexEntry) -> IO (Maybe IndexEntry)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr IndexEntry
result ((Ptr IndexEntry -> IO IndexEntry) -> IO (Maybe IndexEntry))
-> (Ptr IndexEntry -> IO IndexEntry) -> IO (Maybe IndexEntry)
forall a b. (a -> b) -> a -> b
$ \Ptr IndexEntry
result' -> do
        IndexEntry
result'' <- ((ManagedPtr IndexEntry -> IndexEntry)
-> Ptr IndexEntry -> IO IndexEntry
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr IndexEntry -> IndexEntry
Ggit.IndexEntry.IndexEntry) Ptr IndexEntry
result'
        IndexEntry -> IO IndexEntry
forall (m :: * -> *) a. Monad m => a -> m a
return IndexEntry
result''
    IndexEntries -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntries
entries
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe IndexEntry -> IO (Maybe IndexEntry)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe IndexEntry
maybeResult

#if defined(ENABLE_OVERLOADING)
data IndexEntriesGetByPathMethodInfo
instance (signature ~ (a -> Int32 -> m (Maybe Ggit.IndexEntry.IndexEntry)), MonadIO m, Gio.File.IsFile a) => O.MethodInfo IndexEntriesGetByPathMethodInfo IndexEntries signature where
    overloadedMethod = indexEntriesGetByPath

#endif

-- method IndexEntries::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entries"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntries" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntries."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Ggit" , name = "IndexEntries" })
-- throws : False
-- Skip return : False

foreign import ccall "ggit_index_entries_ref" ggit_index_entries_ref :: 
    Ptr IndexEntries ->                     -- entries : TInterface (Name {namespace = "Ggit", name = "IndexEntries"})
    IO (Ptr IndexEntries)

-- | Atomically increments the reference count of /@entries@/ by one.
-- This function is MT-safe and may be called from any thread.
indexEntriesRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntries
    -- ^ /@entries@/: a t'GI.Ggit.Structs.IndexEntries.IndexEntries'.
    -> m (Maybe IndexEntries)
    -- ^ __Returns:__ a t'GI.Ggit.Structs.IndexEntries.IndexEntries' or 'P.Nothing'.
indexEntriesRef :: IndexEntries -> m (Maybe IndexEntries)
indexEntriesRef IndexEntries
entries = IO (Maybe IndexEntries) -> m (Maybe IndexEntries)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe IndexEntries) -> m (Maybe IndexEntries))
-> IO (Maybe IndexEntries) -> m (Maybe IndexEntries)
forall a b. (a -> b) -> a -> b
$ do
    Ptr IndexEntries
entries' <- IndexEntries -> IO (Ptr IndexEntries)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntries
entries
    Ptr IndexEntries
result <- Ptr IndexEntries -> IO (Ptr IndexEntries)
ggit_index_entries_ref Ptr IndexEntries
entries'
    Maybe IndexEntries
maybeResult <- Ptr IndexEntries
-> (Ptr IndexEntries -> IO IndexEntries) -> IO (Maybe IndexEntries)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr IndexEntries
result ((Ptr IndexEntries -> IO IndexEntries) -> IO (Maybe IndexEntries))
-> (Ptr IndexEntries -> IO IndexEntries) -> IO (Maybe IndexEntries)
forall a b. (a -> b) -> a -> b
$ \Ptr IndexEntries
result' -> do
        IndexEntries
result'' <- ((ManagedPtr IndexEntries -> IndexEntries)
-> Ptr IndexEntries -> IO IndexEntries
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr IndexEntries -> IndexEntries
IndexEntries) Ptr IndexEntries
result'
        IndexEntries -> IO IndexEntries
forall (m :: * -> *) a. Monad m => a -> m a
return IndexEntries
result''
    IndexEntries -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntries
entries
    Maybe IndexEntries -> IO (Maybe IndexEntries)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe IndexEntries
maybeResult

#if defined(ENABLE_OVERLOADING)
data IndexEntriesRefMethodInfo
instance (signature ~ (m (Maybe IndexEntries)), MonadIO m) => O.MethodInfo IndexEntriesRefMethodInfo IndexEntries signature where
    overloadedMethod = indexEntriesRef

#endif

-- method IndexEntries::size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entries"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntries" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntries."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "ggit_index_entries_size" ggit_index_entries_size :: 
    Ptr IndexEntries ->                     -- entries : TInterface (Name {namespace = "Ggit", name = "IndexEntries"})
    IO Word32

-- | Get the number of t'GI.Ggit.Structs.IndexEntry.IndexEntry' entries.
indexEntriesSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntries
    -- ^ /@entries@/: a t'GI.Ggit.Structs.IndexEntries.IndexEntries'.
    -> m Word32
    -- ^ __Returns:__ the number of entries.
indexEntriesSize :: IndexEntries -> m Word32
indexEntriesSize IndexEntries
entries = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr IndexEntries
entries' <- IndexEntries -> IO (Ptr IndexEntries)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntries
entries
    Word32
result <- Ptr IndexEntries -> IO Word32
ggit_index_entries_size Ptr IndexEntries
entries'
    IndexEntries -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntries
entries
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data IndexEntriesSizeMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo IndexEntriesSizeMethodInfo IndexEntries signature where
    overloadedMethod = indexEntriesSize

#endif

-- method IndexEntries::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entries"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntries" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntries."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ggit_index_entries_unref" ggit_index_entries_unref :: 
    Ptr IndexEntries ->                     -- entries : TInterface (Name {namespace = "Ggit", name = "IndexEntries"})
    IO ()

-- | Atomically decrements the reference count of /@entries@/ by one.
-- If the reference count drops to 0, /@entries@/ is freed.
indexEntriesUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntries
    -- ^ /@entries@/: a t'GI.Ggit.Structs.IndexEntries.IndexEntries'.
    -> m ()
indexEntriesUnref :: IndexEntries -> m ()
indexEntriesUnref IndexEntries
entries = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr IndexEntries
entries' <- IndexEntries -> IO (Ptr IndexEntries)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntries
entries
    Ptr IndexEntries -> IO ()
ggit_index_entries_unref Ptr IndexEntries
entries'
    IndexEntries -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntries
entries
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndexEntriesUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo IndexEntriesUnrefMethodInfo IndexEntries signature where
    overloadedMethod = indexEntriesUnref

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveIndexEntriesMethod (t :: Symbol) (o :: *) :: * where
    ResolveIndexEntriesMethod "ref" o = IndexEntriesRefMethodInfo
    ResolveIndexEntriesMethod "size" o = IndexEntriesSizeMethodInfo
    ResolveIndexEntriesMethod "unref" o = IndexEntriesUnrefMethodInfo
    ResolveIndexEntriesMethod "getByIndex" o = IndexEntriesGetByIndexMethodInfo
    ResolveIndexEntriesMethod "getByPath" o = IndexEntriesGetByPathMethodInfo
    ResolveIndexEntriesMethod l o = O.MethodResolutionFailed l o

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

#endif