{-# LANGUAGE TypeApplications #-}


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

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

module GI.Ggit.Structs.IndexEntry
    ( 

-- * Exported types
    IndexEntry(..)                          ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveIndexEntryMethod                 ,
#endif


-- ** getDev #method:getDev#

#if defined(ENABLE_OVERLOADING)
    IndexEntryGetDevMethodInfo              ,
#endif
    indexEntryGetDev                        ,


-- ** getFileSize #method:getFileSize#

#if defined(ENABLE_OVERLOADING)
    IndexEntryGetFileSizeMethodInfo         ,
#endif
    indexEntryGetFileSize                   ,


-- ** getFlags #method:getFlags#

#if defined(ENABLE_OVERLOADING)
    IndexEntryGetFlagsMethodInfo            ,
#endif
    indexEntryGetFlags                      ,


-- ** getFlagsExtended #method:getFlagsExtended#

#if defined(ENABLE_OVERLOADING)
    IndexEntryGetFlagsExtendedMethodInfo    ,
#endif
    indexEntryGetFlagsExtended              ,


-- ** getGid #method:getGid#

#if defined(ENABLE_OVERLOADING)
    IndexEntryGetGidMethodInfo              ,
#endif
    indexEntryGetGid                        ,


-- ** getId #method:getId#

#if defined(ENABLE_OVERLOADING)
    IndexEntryGetIdMethodInfo               ,
#endif
    indexEntryGetId                         ,


-- ** getIno #method:getIno#

#if defined(ENABLE_OVERLOADING)
    IndexEntryGetInoMethodInfo              ,
#endif
    indexEntryGetIno                        ,


-- ** getMode #method:getMode#

#if defined(ENABLE_OVERLOADING)
    IndexEntryGetModeMethodInfo             ,
#endif
    indexEntryGetMode                       ,


-- ** getPath #method:getPath#

#if defined(ENABLE_OVERLOADING)
    IndexEntryGetPathMethodInfo             ,
#endif
    indexEntryGetPath                       ,


-- ** getUid #method:getUid#

#if defined(ENABLE_OVERLOADING)
    IndexEntryGetUidMethodInfo              ,
#endif
    indexEntryGetUid                        ,


-- ** isConflict #method:isConflict#

#if defined(ENABLE_OVERLOADING)
    IndexEntryIsConflictMethodInfo          ,
#endif
    indexEntryIsConflict                    ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    IndexEntryRefMethodInfo                 ,
#endif
    indexEntryRef                           ,


-- ** setCommit #method:setCommit#

#if defined(ENABLE_OVERLOADING)
    IndexEntrySetCommitMethodInfo           ,
#endif
    indexEntrySetCommit                     ,


-- ** setDev #method:setDev#

#if defined(ENABLE_OVERLOADING)
    IndexEntrySetDevMethodInfo              ,
#endif
    indexEntrySetDev                        ,


-- ** setFileSize #method:setFileSize#

#if defined(ENABLE_OVERLOADING)
    IndexEntrySetFileSizeMethodInfo         ,
#endif
    indexEntrySetFileSize                   ,


-- ** setFlags #method:setFlags#

#if defined(ENABLE_OVERLOADING)
    IndexEntrySetFlagsMethodInfo            ,
#endif
    indexEntrySetFlags                      ,


-- ** setFlagsExtended #method:setFlagsExtended#

#if defined(ENABLE_OVERLOADING)
    IndexEntrySetFlagsExtendedMethodInfo    ,
#endif
    indexEntrySetFlagsExtended              ,


-- ** setGid #method:setGid#

#if defined(ENABLE_OVERLOADING)
    IndexEntrySetGidMethodInfo              ,
#endif
    indexEntrySetGid                        ,


-- ** setId #method:setId#

#if defined(ENABLE_OVERLOADING)
    IndexEntrySetIdMethodInfo               ,
#endif
    indexEntrySetId                         ,


-- ** setIno #method:setIno#

#if defined(ENABLE_OVERLOADING)
    IndexEntrySetInoMethodInfo              ,
#endif
    indexEntrySetIno                        ,


-- ** setMode #method:setMode#

#if defined(ENABLE_OVERLOADING)
    IndexEntrySetModeMethodInfo             ,
#endif
    indexEntrySetMode                       ,


-- ** setPath #method:setPath#

#if defined(ENABLE_OVERLOADING)
    IndexEntrySetPathMethodInfo             ,
#endif
    indexEntrySetPath                       ,


-- ** setUid #method:setUid#

#if defined(ENABLE_OVERLOADING)
    IndexEntrySetUidMethodInfo              ,
#endif
    indexEntrySetUid                        ,


-- ** stat #method:stat#

#if defined(ENABLE_OVERLOADING)
    IndexEntryStatMethodInfo                ,
#endif
    indexEntryStat                          ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    IndexEntryUnrefMethodInfo               ,
#endif
    indexEntryUnref                         ,




    ) 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.Objects.Commit as Ggit.Commit
import {-# SOURCE #-} qualified GI.Ggit.Structs.OId as Ggit.OId
import qualified GI.Gio.Interfaces.File as Gio.File

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

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

foreign import ccall "ggit_index_entry_get_type" c_ggit_index_entry_get_type :: 
    IO GType

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

instance B.Types.TypedObject IndexEntry where
    glibType :: IO GType
glibType = IO GType
c_ggit_index_entry_get_type

instance B.Types.GBoxed IndexEntry

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


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

-- method IndexEntry::get_dev
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntry." , 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_entry_get_dev" ggit_index_entry_get_dev :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    IO Word32

-- | Get the dev of the index entry.
indexEntryGetDev ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> m Word32
    -- ^ __Returns:__ the dev.
indexEntryGetDev :: IndexEntry -> m Word32
indexEntryGetDev IndexEntry
entry = 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 IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    Word32
result <- Ptr IndexEntry -> IO Word32
ggit_index_entry_get_dev Ptr IndexEntry
entry'
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data IndexEntryGetDevMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo IndexEntryGetDevMethodInfo IndexEntry signature where
    overloadedMethod = indexEntryGetDev

#endif

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

foreign import ccall "ggit_index_entry_get_file_size" ggit_index_entry_get_file_size :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    IO Int64

-- | Get the file size of the index entry.
indexEntryGetFileSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> m Int64
    -- ^ __Returns:__ the file size.
indexEntryGetFileSize :: IndexEntry -> m Int64
indexEntryGetFileSize IndexEntry
entry = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    Int64
result <- Ptr IndexEntry -> IO Int64
ggit_index_entry_get_file_size Ptr IndexEntry
entry'
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result

#if defined(ENABLE_OVERLOADING)
data IndexEntryGetFileSizeMethodInfo
instance (signature ~ (m Int64), MonadIO m) => O.MethodInfo IndexEntryGetFileSizeMethodInfo IndexEntry signature where
    overloadedMethod = indexEntryGetFileSize

#endif

-- method IndexEntry::get_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntry." , 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_entry_get_flags" ggit_index_entry_get_flags :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    IO Word32

-- | Get the flags of the index entry.
indexEntryGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> m Word32
    -- ^ __Returns:__ the flags.
indexEntryGetFlags :: IndexEntry -> m Word32
indexEntryGetFlags IndexEntry
entry = 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 IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    Word32
result <- Ptr IndexEntry -> IO Word32
ggit_index_entry_get_flags Ptr IndexEntry
entry'
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data IndexEntryGetFlagsMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo IndexEntryGetFlagsMethodInfo IndexEntry signature where
    overloadedMethod = indexEntryGetFlags

#endif

-- method IndexEntry::get_flags_extended
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntry." , 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_entry_get_flags_extended" ggit_index_entry_get_flags_extended :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    IO Word32

-- | Get the extended flags of the index entry.
indexEntryGetFlagsExtended ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> m Word32
    -- ^ __Returns:__ the extended flags.
indexEntryGetFlagsExtended :: IndexEntry -> m Word32
indexEntryGetFlagsExtended IndexEntry
entry = 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 IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    Word32
result <- Ptr IndexEntry -> IO Word32
ggit_index_entry_get_flags_extended Ptr IndexEntry
entry'
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data IndexEntryGetFlagsExtendedMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo IndexEntryGetFlagsExtendedMethodInfo IndexEntry signature where
    overloadedMethod = indexEntryGetFlagsExtended

#endif

-- method IndexEntry::get_gid
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntry." , 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_entry_get_gid" ggit_index_entry_get_gid :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    IO Word32

-- | Get the gid of the index entry.
indexEntryGetGid ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> m Word32
    -- ^ __Returns:__ the gid.
indexEntryGetGid :: IndexEntry -> m Word32
indexEntryGetGid IndexEntry
entry = 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 IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    Word32
result <- Ptr IndexEntry -> IO Word32
ggit_index_entry_get_gid Ptr IndexEntry
entry'
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data IndexEntryGetGidMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo IndexEntryGetGidMethodInfo IndexEntry signature where
    overloadedMethod = indexEntryGetGid

#endif

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

foreign import ccall "ggit_index_entry_get_id" ggit_index_entry_get_id :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    IO (Ptr Ggit.OId.OId)

-- | Get the oid of the index entry.
indexEntryGetId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> m (Maybe Ggit.OId.OId)
    -- ^ __Returns:__ the oid or 'P.Nothing'.
indexEntryGetId :: IndexEntry -> m (Maybe OId)
indexEntryGetId IndexEntry
entry = IO (Maybe OId) -> m (Maybe OId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe OId) -> m (Maybe OId))
-> IO (Maybe OId) -> m (Maybe OId)
forall a b. (a -> b) -> a -> b
$ do
    Ptr IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    Ptr OId
result <- Ptr IndexEntry -> IO (Ptr OId)
ggit_index_entry_get_id Ptr IndexEntry
entry'
    Maybe OId
maybeResult <- Ptr OId -> (Ptr OId -> IO OId) -> IO (Maybe OId)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr OId
result ((Ptr OId -> IO OId) -> IO (Maybe OId))
-> (Ptr OId -> IO OId) -> IO (Maybe OId)
forall a b. (a -> b) -> a -> b
$ \Ptr OId
result' -> do
        OId
result'' <- ((ManagedPtr OId -> OId) -> Ptr OId -> IO OId
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr OId -> OId
Ggit.OId.OId) Ptr OId
result'
        OId -> IO OId
forall (m :: * -> *) a. Monad m => a -> m a
return OId
result''
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    Maybe OId -> IO (Maybe OId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe OId
maybeResult

#if defined(ENABLE_OVERLOADING)
data IndexEntryGetIdMethodInfo
instance (signature ~ (m (Maybe Ggit.OId.OId)), MonadIO m) => O.MethodInfo IndexEntryGetIdMethodInfo IndexEntry signature where
    overloadedMethod = indexEntryGetId

#endif

-- method IndexEntry::get_ino
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntry." , 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_entry_get_ino" ggit_index_entry_get_ino :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    IO Word32

-- | Get the ino of the index entry.
indexEntryGetIno ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> m Word32
    -- ^ __Returns:__ the ino.
indexEntryGetIno :: IndexEntry -> m Word32
indexEntryGetIno IndexEntry
entry = 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 IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    Word32
result <- Ptr IndexEntry -> IO Word32
ggit_index_entry_get_ino Ptr IndexEntry
entry'
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data IndexEntryGetInoMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo IndexEntryGetInoMethodInfo IndexEntry signature where
    overloadedMethod = indexEntryGetIno

#endif

-- method IndexEntry::get_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntry." , 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_entry_get_mode" ggit_index_entry_get_mode :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    IO Word32

-- | Get the mode of the index entry.
indexEntryGetMode ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> m Word32
    -- ^ __Returns:__ the mode.
indexEntryGetMode :: IndexEntry -> m Word32
indexEntryGetMode IndexEntry
entry = 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 IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    Word32
result <- Ptr IndexEntry -> IO Word32
ggit_index_entry_get_mode Ptr IndexEntry
entry'
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data IndexEntryGetModeMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo IndexEntryGetModeMethodInfo IndexEntry signature where
    overloadedMethod = indexEntryGetMode

#endif

-- method IndexEntry::get_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "ggit_index_entry_get_path" ggit_index_entry_get_path :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    IO CString

-- | /No description available in the introspection data./
indexEntryGetPath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntry
    -> m T.Text
indexEntryGetPath :: IndexEntry -> m Text
indexEntryGetPath IndexEntry
entry = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    CString
result <- Ptr IndexEntry -> IO CString
ggit_index_entry_get_path Ptr IndexEntry
entry'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"indexEntryGetPath" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data IndexEntryGetPathMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo IndexEntryGetPathMethodInfo IndexEntry signature where
    overloadedMethod = indexEntryGetPath

#endif

-- method IndexEntry::get_uid
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntry." , 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_entry_get_uid" ggit_index_entry_get_uid :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    IO Word32

-- | Get the uid of the index entry.
indexEntryGetUid ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> m Word32
    -- ^ __Returns:__ the uid.
indexEntryGetUid :: IndexEntry -> m Word32
indexEntryGetUid IndexEntry
entry = 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 IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    Word32
result <- Ptr IndexEntry -> IO Word32
ggit_index_entry_get_uid Ptr IndexEntry
entry'
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data IndexEntryGetUidMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo IndexEntryGetUidMethodInfo IndexEntry signature where
    overloadedMethod = indexEntryGetUid

#endif

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

foreign import ccall "ggit_index_entry_is_conflict" ggit_index_entry_is_conflict :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    IO CInt

-- | Get whether the entry represents a conflict.
indexEntryIsConflict ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the entry is a conflict, or 'P.False' otherwise.
indexEntryIsConflict :: IndexEntry -> m Bool
indexEntryIsConflict IndexEntry
entry = IO Bool -> m Bool
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 IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    CInt
result <- Ptr IndexEntry -> IO CInt
ggit_index_entry_is_conflict Ptr IndexEntry
entry'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data IndexEntryIsConflictMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo IndexEntryIsConflictMethodInfo IndexEntry signature where
    overloadedMethod = indexEntryIsConflict

#endif

-- method IndexEntry::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntry." , 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_entry_ref" ggit_index_entry_ref :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    IO (Ptr IndexEntry)

-- | Atomically increments the reference count of /@entry@/ by one.
-- This function is MT-safe and may be called from any thread.
indexEntryRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> m (Maybe IndexEntry)
    -- ^ __Returns:__ a t'GI.Ggit.Structs.IndexEntry.IndexEntry' or 'P.Nothing'.
indexEntryRef :: IndexEntry -> m (Maybe IndexEntry)
indexEntryRef IndexEntry
entry = 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 IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    Ptr IndexEntry
result <- Ptr IndexEntry -> IO (Ptr IndexEntry)
ggit_index_entry_ref Ptr IndexEntry
entry'
    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
newBoxed ManagedPtr IndexEntry -> IndexEntry
IndexEntry) Ptr IndexEntry
result'
        IndexEntry -> IO IndexEntry
forall (m :: * -> *) a. Monad m => a -> m a
return IndexEntry
result''
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    Maybe IndexEntry -> IO (Maybe IndexEntry)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe IndexEntry
maybeResult

#if defined(ENABLE_OVERLOADING)
data IndexEntryRefMethodInfo
instance (signature ~ (m (Maybe IndexEntry)), MonadIO m) => O.MethodInfo IndexEntryRefMethodInfo IndexEntry signature where
    overloadedMethod = indexEntryRef

#endif

-- method IndexEntry::set_commit
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntry." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "commit"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Commit" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitCommit." , 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_entry_set_commit" ggit_index_entry_set_commit :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    Ptr Ggit.Commit.Commit ->               -- commit : TInterface (Name {namespace = "Ggit", name = "Commit"})
    IO ()

-- | Set the index entry to point to a given commit. This sets the index entry
-- id to the commit id, changes the mode to @/GGIT_FILE_MODE_COMMIT/@ and updates
-- the timestamps to when the commit was made.
indexEntrySetCommit ::
    (B.CallStack.HasCallStack, MonadIO m, Ggit.Commit.IsCommit a) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> a
    -- ^ /@commit@/: a t'GI.Ggit.Objects.Commit.Commit'.
    -> m ()
indexEntrySetCommit :: IndexEntry -> a -> m ()
indexEntrySetCommit IndexEntry
entry a
commit = 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 IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    Ptr Commit
commit' <- a -> IO (Ptr Commit)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
commit
    Ptr IndexEntry -> Ptr Commit -> IO ()
ggit_index_entry_set_commit Ptr IndexEntry
entry' Ptr Commit
commit'
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
commit
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndexEntrySetCommitMethodInfo
instance (signature ~ (a -> m ()), MonadIO m, Ggit.Commit.IsCommit a) => O.MethodInfo IndexEntrySetCommitMethodInfo IndexEntry signature where
    overloadedMethod = indexEntrySetCommit

#endif

-- method IndexEntry::set_dev
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntry." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dev"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the dev." , 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_entry_set_dev" ggit_index_entry_set_dev :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    Word32 ->                               -- dev : TBasicType TUInt
    IO ()

-- | Set the dev of the index entry.
indexEntrySetDev ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> Word32
    -- ^ /@dev@/: the dev.
    -> m ()
indexEntrySetDev :: IndexEntry -> Word32 -> m ()
indexEntrySetDev IndexEntry
entry Word32
dev = 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 IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    Ptr IndexEntry -> Word32 -> IO ()
ggit_index_entry_set_dev Ptr IndexEntry
entry' Word32
dev
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndexEntrySetDevMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.MethodInfo IndexEntrySetDevMethodInfo IndexEntry signature where
    overloadedMethod = indexEntrySetDev

#endif

-- method IndexEntry::set_file_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntry." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "file_size"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the file size." , 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_entry_set_file_size" ggit_index_entry_set_file_size :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    Int64 ->                                -- file_size : TBasicType TInt64
    IO ()

-- | Set the file size of the index entry.
indexEntrySetFileSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> Int64
    -- ^ /@fileSize@/: the file size.
    -> m ()
indexEntrySetFileSize :: IndexEntry -> Int64 -> m ()
indexEntrySetFileSize IndexEntry
entry Int64
fileSize = 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 IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    Ptr IndexEntry -> Int64 -> IO ()
ggit_index_entry_set_file_size Ptr IndexEntry
entry' Int64
fileSize
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndexEntrySetFileSizeMethodInfo
instance (signature ~ (Int64 -> m ()), MonadIO m) => O.MethodInfo IndexEntrySetFileSizeMethodInfo IndexEntry signature where
    overloadedMethod = indexEntrySetFileSize

#endif

-- method IndexEntry::set_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntry." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the flags." , 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_entry_set_flags" ggit_index_entry_set_flags :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    Word32 ->                               -- flags : TBasicType TUInt
    IO ()

-- | Set the flags of the index entry.
indexEntrySetFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> Word32
    -- ^ /@flags@/: the flags.
    -> m ()
indexEntrySetFlags :: IndexEntry -> Word32 -> m ()
indexEntrySetFlags IndexEntry
entry Word32
flags = 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 IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    Ptr IndexEntry -> Word32 -> IO ()
ggit_index_entry_set_flags Ptr IndexEntry
entry' Word32
flags
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndexEntrySetFlagsMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.MethodInfo IndexEntrySetFlagsMethodInfo IndexEntry signature where
    overloadedMethod = indexEntrySetFlags

#endif

-- method IndexEntry::set_flags_extended
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntry." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags_extended"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the extended flags."
--                 , 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_entry_set_flags_extended" ggit_index_entry_set_flags_extended :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    Word32 ->                               -- flags_extended : TBasicType TUInt
    IO ()

-- | Set the extended flags of the index entry.
indexEntrySetFlagsExtended ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> Word32
    -- ^ /@flagsExtended@/: the extended flags.
    -> m ()
indexEntrySetFlagsExtended :: IndexEntry -> Word32 -> m ()
indexEntrySetFlagsExtended IndexEntry
entry Word32
flagsExtended = 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 IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    Ptr IndexEntry -> Word32 -> IO ()
ggit_index_entry_set_flags_extended Ptr IndexEntry
entry' Word32
flagsExtended
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndexEntrySetFlagsExtendedMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.MethodInfo IndexEntrySetFlagsExtendedMethodInfo IndexEntry signature where
    overloadedMethod = indexEntrySetFlagsExtended

#endif

-- method IndexEntry::set_gid
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntry." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "gid"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the gid." , 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_entry_set_gid" ggit_index_entry_set_gid :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    Word32 ->                               -- gid : TBasicType TUInt
    IO ()

-- | Set the gid of the index entry.
indexEntrySetGid ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> Word32
    -- ^ /@gid@/: the gid.
    -> m ()
indexEntrySetGid :: IndexEntry -> Word32 -> m ()
indexEntrySetGid IndexEntry
entry Word32
gid = 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 IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    Ptr IndexEntry -> Word32 -> IO ()
ggit_index_entry_set_gid Ptr IndexEntry
entry' Word32
gid
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndexEntrySetGidMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.MethodInfo IndexEntrySetGidMethodInfo IndexEntry signature where
    overloadedMethod = indexEntrySetGid

#endif

-- method IndexEntry::set_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntry." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TInterface Name { namespace = "Ggit" , name = "OId" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the oid." , 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_entry_set_id" ggit_index_entry_set_id :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    Ptr Ggit.OId.OId ->                     -- id : TInterface (Name {namespace = "Ggit", name = "OId"})
    IO ()

-- | Set the oid of the index entry.
indexEntrySetId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> Maybe (Ggit.OId.OId)
    -- ^ /@id@/: the oid.
    -> m ()
indexEntrySetId :: IndexEntry -> Maybe OId -> m ()
indexEntrySetId IndexEntry
entry Maybe OId
id = 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 IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    Ptr OId
maybeId <- case Maybe OId
id of
        Maybe OId
Nothing -> Ptr OId -> IO (Ptr OId)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr OId
forall a. Ptr a
nullPtr
        Just OId
jId -> do
            Ptr OId
jId' <- OId -> IO (Ptr OId)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr OId
jId
            Ptr OId -> IO (Ptr OId)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr OId
jId'
    Ptr IndexEntry -> Ptr OId -> IO ()
ggit_index_entry_set_id Ptr IndexEntry
entry' Ptr OId
maybeId
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    Maybe OId -> (OId -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe OId
id OId -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndexEntrySetIdMethodInfo
instance (signature ~ (Maybe (Ggit.OId.OId) -> m ()), MonadIO m) => O.MethodInfo IndexEntrySetIdMethodInfo IndexEntry signature where
    overloadedMethod = indexEntrySetId

#endif

-- method IndexEntry::set_ino
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntry." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ino"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the ino." , 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_entry_set_ino" ggit_index_entry_set_ino :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    Word32 ->                               -- ino : TBasicType TUInt
    IO ()

-- | Set the ino of the index entry.
indexEntrySetIno ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> Word32
    -- ^ /@ino@/: the ino.
    -> m ()
indexEntrySetIno :: IndexEntry -> Word32 -> m ()
indexEntrySetIno IndexEntry
entry Word32
ino = 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 IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    Ptr IndexEntry -> Word32 -> IO ()
ggit_index_entry_set_ino Ptr IndexEntry
entry' Word32
ino
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndexEntrySetInoMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.MethodInfo IndexEntrySetInoMethodInfo IndexEntry signature where
    overloadedMethod = indexEntrySetIno

#endif

-- method IndexEntry::set_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntry." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the mode." , 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_entry_set_mode" ggit_index_entry_set_mode :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    Word32 ->                               -- mode : TBasicType TUInt
    IO ()

-- | Set the mode of the index entry.
indexEntrySetMode ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> Word32
    -- ^ /@mode@/: the mode.
    -> m ()
indexEntrySetMode :: IndexEntry -> Word32 -> m ()
indexEntrySetMode IndexEntry
entry Word32
mode = 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 IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    Ptr IndexEntry -> Word32 -> IO ()
ggit_index_entry_set_mode Ptr IndexEntry
entry' Word32
mode
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndexEntrySetModeMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.MethodInfo IndexEntrySetModeMethodInfo IndexEntry signature where
    overloadedMethod = indexEntrySetMode

#endif

-- method IndexEntry::set_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntry." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the path." , 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_entry_set_path" ggit_index_entry_set_path :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    CString ->                              -- path : TBasicType TUTF8
    IO ()

-- | Set the path of the index entry. The path should be relative to the working
-- directory.
indexEntrySetPath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> Maybe (T.Text)
    -- ^ /@path@/: the path.
    -> m ()
indexEntrySetPath :: IndexEntry -> Maybe Text -> m ()
indexEntrySetPath IndexEntry
entry Maybe Text
path = 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 IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    CString
maybePath <- case Maybe Text
path of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jPath -> do
            CString
jPath' <- Text -> IO CString
textToCString Text
jPath
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jPath'
    Ptr IndexEntry -> CString -> IO ()
ggit_index_entry_set_path Ptr IndexEntry
entry' CString
maybePath
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybePath
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndexEntrySetPathMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m) => O.MethodInfo IndexEntrySetPathMethodInfo IndexEntry signature where
    overloadedMethod = indexEntrySetPath

#endif

-- method IndexEntry::set_uid
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntry." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uid"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the uid." , 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_entry_set_uid" ggit_index_entry_set_uid :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    Word32 ->                               -- uid : TBasicType TUInt
    IO ()

-- | Set the uid of the index entry.
indexEntrySetUid ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> Word32
    -- ^ /@uid@/: the uid.
    -> m ()
indexEntrySetUid :: IndexEntry -> Word32 -> m ()
indexEntrySetUid IndexEntry
entry Word32
uid = 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 IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    Ptr IndexEntry -> Word32 -> IO ()
ggit_index_entry_set_uid Ptr IndexEntry
entry' Word32
uid
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndexEntrySetUidMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.MethodInfo IndexEntrySetUidMethodInfo IndexEntry signature where
    overloadedMethod = indexEntrySetUid

#endif

-- method IndexEntry::stat
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntry." , 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 file to stat." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ggit_index_entry_stat" ggit_index_entry_stat :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    Ptr Gio.File.File ->                    -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Fill the entry fields from statting /@file@/.
indexEntryStat ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.File.IsFile a) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> a
    -- ^ /@file@/: the file to stat.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
indexEntryStat :: IndexEntry -> a -> m ()
indexEntryStat IndexEntry
entry a
file = 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 IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr IndexEntry -> Ptr File -> Ptr (Ptr GError) -> IO CInt
ggit_index_entry_stat Ptr IndexEntry
entry' Ptr File
file'
        IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data IndexEntryStatMethodInfo
instance (signature ~ (a -> m ()), MonadIO m, Gio.File.IsFile a) => O.MethodInfo IndexEntryStatMethodInfo IndexEntry signature where
    overloadedMethod = indexEntryStat

#endif

-- method IndexEntry::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "IndexEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntry." , 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_entry_unref" ggit_index_entry_unref :: 
    Ptr IndexEntry ->                       -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntry"})
    IO ()

-- | Atomically decrements the reference count of /@entry@/ by one.
-- If the reference count drops to 0, /@entry@/ is freed.
indexEntryUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntry
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntry.IndexEntry'.
    -> m ()
indexEntryUnref :: IndexEntry -> m ()
indexEntryUnref IndexEntry
entry = 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 IndexEntry
entry' <- IndexEntry -> IO (Ptr IndexEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntry
entry
    Ptr IndexEntry -> IO ()
ggit_index_entry_unref Ptr IndexEntry
entry'
    IndexEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntry
entry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndexEntryUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo IndexEntryUnrefMethodInfo IndexEntry signature where
    overloadedMethod = indexEntryUnref

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveIndexEntryMethod (t :: Symbol) (o :: *) :: * where
    ResolveIndexEntryMethod "isConflict" o = IndexEntryIsConflictMethodInfo
    ResolveIndexEntryMethod "ref" o = IndexEntryRefMethodInfo
    ResolveIndexEntryMethod "stat" o = IndexEntryStatMethodInfo
    ResolveIndexEntryMethod "unref" o = IndexEntryUnrefMethodInfo
    ResolveIndexEntryMethod "getDev" o = IndexEntryGetDevMethodInfo
    ResolveIndexEntryMethod "getFileSize" o = IndexEntryGetFileSizeMethodInfo
    ResolveIndexEntryMethod "getFlags" o = IndexEntryGetFlagsMethodInfo
    ResolveIndexEntryMethod "getFlagsExtended" o = IndexEntryGetFlagsExtendedMethodInfo
    ResolveIndexEntryMethod "getGid" o = IndexEntryGetGidMethodInfo
    ResolveIndexEntryMethod "getId" o = IndexEntryGetIdMethodInfo
    ResolveIndexEntryMethod "getIno" o = IndexEntryGetInoMethodInfo
    ResolveIndexEntryMethod "getMode" o = IndexEntryGetModeMethodInfo
    ResolveIndexEntryMethod "getPath" o = IndexEntryGetPathMethodInfo
    ResolveIndexEntryMethod "getUid" o = IndexEntryGetUidMethodInfo
    ResolveIndexEntryMethod "setCommit" o = IndexEntrySetCommitMethodInfo
    ResolveIndexEntryMethod "setDev" o = IndexEntrySetDevMethodInfo
    ResolveIndexEntryMethod "setFileSize" o = IndexEntrySetFileSizeMethodInfo
    ResolveIndexEntryMethod "setFlags" o = IndexEntrySetFlagsMethodInfo
    ResolveIndexEntryMethod "setFlagsExtended" o = IndexEntrySetFlagsExtendedMethodInfo
    ResolveIndexEntryMethod "setGid" o = IndexEntrySetGidMethodInfo
    ResolveIndexEntryMethod "setId" o = IndexEntrySetIdMethodInfo
    ResolveIndexEntryMethod "setIno" o = IndexEntrySetInoMethodInfo
    ResolveIndexEntryMethod "setMode" o = IndexEntrySetModeMethodInfo
    ResolveIndexEntryMethod "setPath" o = IndexEntrySetPathMethodInfo
    ResolveIndexEntryMethod "setUid" o = IndexEntrySetUidMethodInfo
    ResolveIndexEntryMethod l o = O.MethodResolutionFailed l o

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

#endif