{-# LANGUAGE TypeApplications #-}


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

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

module GI.Ggit.Structs.IndexEntryResolveUndo
    ( 

-- * Exported types
    IndexEntryResolveUndo(..)               ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [ref]("GI.Ggit.Structs.IndexEntryResolveUndo#g:method:ref"), [unref]("GI.Ggit.Structs.IndexEntryResolveUndo#g:method:unref").
-- 
-- ==== Getters
-- [getFile]("GI.Ggit.Structs.IndexEntryResolveUndo#g:method:getFile"), [getId]("GI.Ggit.Structs.IndexEntryResolveUndo#g:method:getId"), [getMode]("GI.Ggit.Structs.IndexEntryResolveUndo#g:method:getMode").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveIndexEntryResolveUndoMethod      ,
#endif

-- ** getFile #method:getFile#

#if defined(ENABLE_OVERLOADING)
    IndexEntryResolveUndoGetFileMethodInfo  ,
#endif
    indexEntryResolveUndoGetFile            ,


-- ** getId #method:getId#

#if defined(ENABLE_OVERLOADING)
    IndexEntryResolveUndoGetIdMethodInfo    ,
#endif
    indexEntryResolveUndoGetId              ,


-- ** getMode #method:getMode#

#if defined(ENABLE_OVERLOADING)
    IndexEntryResolveUndoGetModeMethodInfo  ,
#endif
    indexEntryResolveUndoGetMode            ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    IndexEntryResolveUndoRefMethodInfo      ,
#endif
    indexEntryResolveUndoRef                ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    IndexEntryResolveUndoUnrefMethodInfo    ,
#endif
    indexEntryResolveUndoUnref              ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import {-# SOURCE #-} qualified GI.Ggit.Structs.OId as Ggit.OId
import qualified GI.Gio.Interfaces.File as Gio.File

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

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

foreign import ccall "ggit_index_entry_resolve_undo_get_type" c_ggit_index_entry_resolve_undo_get_type :: 
    IO GType

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

instance B.Types.TypedObject IndexEntryResolveUndo where
    glibType :: IO GType
glibType = IO GType
c_ggit_index_entry_resolve_undo_get_type

instance B.Types.GBoxed IndexEntryResolveUndo

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


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

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

foreign import ccall "ggit_index_entry_resolve_undo_get_file" ggit_index_entry_resolve_undo_get_file :: 
    Ptr IndexEntryResolveUndo ->            -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntryResolveUndo"})
    IO (Ptr Gio.File.File)

-- | Get the file of the index entry.
indexEntryResolveUndoGetFile ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntryResolveUndo
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntryResolveUndo.IndexEntryResolveUndo'.
    -> m (Maybe Gio.File.File)
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.File.File' or 'P.Nothing'.
indexEntryResolveUndoGetFile :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IndexEntryResolveUndo -> m (Maybe File)
indexEntryResolveUndoGetFile IndexEntryResolveUndo
entry = IO (Maybe File) -> m (Maybe File)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe File) -> m (Maybe File))
-> IO (Maybe File) -> m (Maybe File)
forall a b. (a -> b) -> a -> b
$ do
    Ptr IndexEntryResolveUndo
entry' <- IndexEntryResolveUndo -> IO (Ptr IndexEntryResolveUndo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntryResolveUndo
entry
    Ptr File
result <- Ptr IndexEntryResolveUndo -> IO (Ptr File)
ggit_index_entry_resolve_undo_get_file Ptr IndexEntryResolveUndo
entry'
    Maybe File
maybeResult <- Ptr File -> (Ptr File -> IO File) -> IO (Maybe File)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr File
result ((Ptr File -> IO File) -> IO (Maybe File))
-> (Ptr File -> IO File) -> IO (Maybe File)
forall a b. (a -> b) -> a -> b
$ \Ptr File
result' -> do
        File
result'' <- ((ManagedPtr File -> File) -> Ptr File -> IO File
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr File -> File
Gio.File.File) Ptr File
result'
        File -> IO File
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return File
result''
    IndexEntryResolveUndo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntryResolveUndo
entry
    Maybe File -> IO (Maybe File)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe File
maybeResult

#if defined(ENABLE_OVERLOADING)
data IndexEntryResolveUndoGetFileMethodInfo
instance (signature ~ (m (Maybe Gio.File.File)), MonadIO m) => O.OverloadedMethod IndexEntryResolveUndoGetFileMethodInfo IndexEntryResolveUndo signature where
    overloadedMethod = indexEntryResolveUndoGetFile

instance O.OverloadedMethodInfo IndexEntryResolveUndoGetFileMethodInfo IndexEntryResolveUndo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.IndexEntryResolveUndo.indexEntryResolveUndoGetFile",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.12/docs/GI-Ggit-Structs-IndexEntryResolveUndo.html#v:indexEntryResolveUndoGetFile"
        })


#endif

-- method IndexEntryResolveUndo::get_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface
--                 Name { namespace = "Ggit" , name = "IndexEntryResolveUndo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntryResolveUndo."
--                 , 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 "the stage (0, 1 or 2)."
--                 , 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_resolve_undo_get_id" ggit_index_entry_resolve_undo_get_id :: 
    Ptr IndexEntryResolveUndo ->            -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntryResolveUndo"})
    Int32 ->                                -- stage : TBasicType TInt
    IO (Ptr Ggit.OId.OId)

-- | Get the oid of the index entry.
indexEntryResolveUndoGetId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntryResolveUndo
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntryResolveUndo.IndexEntryResolveUndo'.
    -> Int32
    -- ^ /@stage@/: the stage (0, 1 or 2).
    -> m (Maybe Ggit.OId.OId)
    -- ^ __Returns:__ the oid or 'P.Nothing'.
indexEntryResolveUndoGetId :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IndexEntryResolveUndo -> Int32 -> m (Maybe OId)
indexEntryResolveUndoGetId IndexEntryResolveUndo
entry Int32
stage = IO (Maybe OId) -> m (Maybe OId)
forall a. IO a -> m a
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 IndexEntryResolveUndo
entry' <- IndexEntryResolveUndo -> IO (Ptr IndexEntryResolveUndo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntryResolveUndo
entry
    Ptr OId
result <- Ptr IndexEntryResolveUndo -> Int32 -> IO (Ptr OId)
ggit_index_entry_resolve_undo_get_id Ptr IndexEntryResolveUndo
entry' Int32
stage
    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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return OId
result''
    IndexEntryResolveUndo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntryResolveUndo
entry
    Maybe OId -> IO (Maybe OId)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe OId
maybeResult

#if defined(ENABLE_OVERLOADING)
data IndexEntryResolveUndoGetIdMethodInfo
instance (signature ~ (Int32 -> m (Maybe Ggit.OId.OId)), MonadIO m) => O.OverloadedMethod IndexEntryResolveUndoGetIdMethodInfo IndexEntryResolveUndo signature where
    overloadedMethod = indexEntryResolveUndoGetId

instance O.OverloadedMethodInfo IndexEntryResolveUndoGetIdMethodInfo IndexEntryResolveUndo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.IndexEntryResolveUndo.indexEntryResolveUndoGetId",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.12/docs/GI-Ggit-Structs-IndexEntryResolveUndo.html#v:indexEntryResolveUndoGetId"
        })


#endif

-- method IndexEntryResolveUndo::get_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "entry"
--           , argType =
--               TInterface
--                 Name { namespace = "Ggit" , name = "IndexEntryResolveUndo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitIndexEntryResolveUndo."
--                 , 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 "the stage (0, 1 or 2)."
--                 , 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_resolve_undo_get_mode" ggit_index_entry_resolve_undo_get_mode :: 
    Ptr IndexEntryResolveUndo ->            -- entry : TInterface (Name {namespace = "Ggit", name = "IndexEntryResolveUndo"})
    Int32 ->                                -- stage : TBasicType TInt
    IO Word32

-- | Get the mode of the index entry. The returned mode contains the modes from
-- stage 1, 2 and 3.
indexEntryResolveUndoGetMode ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IndexEntryResolveUndo
    -- ^ /@entry@/: a t'GI.Ggit.Structs.IndexEntryResolveUndo.IndexEntryResolveUndo'.
    -> Int32
    -- ^ /@stage@/: the stage (0, 1 or 2).
    -> m Word32
    -- ^ __Returns:__ the mode.
indexEntryResolveUndoGetMode :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IndexEntryResolveUndo -> Int32 -> m Word32
indexEntryResolveUndoGetMode IndexEntryResolveUndo
entry Int32
stage = IO Word32 -> m Word32
forall a. IO a -> m a
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 IndexEntryResolveUndo
entry' <- IndexEntryResolveUndo -> IO (Ptr IndexEntryResolveUndo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IndexEntryResolveUndo
entry
    Word32
result <- Ptr IndexEntryResolveUndo -> Int32 -> IO Word32
ggit_index_entry_resolve_undo_get_mode Ptr IndexEntryResolveUndo
entry' Int32
stage
    IndexEntryResolveUndo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IndexEntryResolveUndo
entry
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data IndexEntryResolveUndoGetModeMethodInfo
instance (signature ~ (Int32 -> m Word32), MonadIO m) => O.OverloadedMethod IndexEntryResolveUndoGetModeMethodInfo IndexEntryResolveUndo signature where
    overloadedMethod = indexEntryResolveUndoGetMode

instance O.OverloadedMethodInfo IndexEntryResolveUndoGetModeMethodInfo IndexEntryResolveUndo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.IndexEntryResolveUndo.indexEntryResolveUndoGetMode",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.12/docs/GI-Ggit-Structs-IndexEntryResolveUndo.html#v:indexEntryResolveUndoGetMode"
        })


#endif

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

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

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

#if defined(ENABLE_OVERLOADING)
data IndexEntryResolveUndoRefMethodInfo
instance (signature ~ (m (Maybe IndexEntryResolveUndo)), MonadIO m) => O.OverloadedMethod IndexEntryResolveUndoRefMethodInfo IndexEntryResolveUndo signature where
    overloadedMethod = indexEntryResolveUndoRef

instance O.OverloadedMethodInfo IndexEntryResolveUndoRefMethodInfo IndexEntryResolveUndo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.IndexEntryResolveUndo.indexEntryResolveUndoRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.12/docs/GI-Ggit-Structs-IndexEntryResolveUndo.html#v:indexEntryResolveUndoRef"
        })


#endif

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

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

#if defined(ENABLE_OVERLOADING)
data IndexEntryResolveUndoUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod IndexEntryResolveUndoUnrefMethodInfo IndexEntryResolveUndo signature where
    overloadedMethod = indexEntryResolveUndoUnref

instance O.OverloadedMethodInfo IndexEntryResolveUndoUnrefMethodInfo IndexEntryResolveUndo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.IndexEntryResolveUndo.indexEntryResolveUndoUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.12/docs/GI-Ggit-Structs-IndexEntryResolveUndo.html#v:indexEntryResolveUndoUnref"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveIndexEntryResolveUndoMethod (t :: Symbol) (o :: *) :: * where
    ResolveIndexEntryResolveUndoMethod "ref" o = IndexEntryResolveUndoRefMethodInfo
    ResolveIndexEntryResolveUndoMethod "unref" o = IndexEntryResolveUndoUnrefMethodInfo
    ResolveIndexEntryResolveUndoMethod "getFile" o = IndexEntryResolveUndoGetFileMethodInfo
    ResolveIndexEntryResolveUndoMethod "getId" o = IndexEntryResolveUndoGetIdMethodInfo
    ResolveIndexEntryResolveUndoMethod "getMode" o = IndexEntryResolveUndoGetModeMethodInfo
    ResolveIndexEntryResolveUndoMethod l o = O.MethodResolutionFailed l o

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

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

#endif

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

#endif