{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Represents the changes done to one file.

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

module GI.Ggit.Structs.DiffDelta
    ( 

-- * Exported types
    DiffDelta(..)                           ,
    noDiffDelta                             ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveDiffDeltaMethod                  ,
#endif


-- ** getFlags #method:getFlags#

#if defined(ENABLE_OVERLOADING)
    DiffDeltaGetFlagsMethodInfo             ,
#endif
    diffDeltaGetFlags                       ,


-- ** getNewFile #method:getNewFile#

#if defined(ENABLE_OVERLOADING)
    DiffDeltaGetNewFileMethodInfo           ,
#endif
    diffDeltaGetNewFile                     ,


-- ** getOldFile #method:getOldFile#

#if defined(ENABLE_OVERLOADING)
    DiffDeltaGetOldFileMethodInfo           ,
#endif
    diffDeltaGetOldFile                     ,


-- ** getSimilarity #method:getSimilarity#

#if defined(ENABLE_OVERLOADING)
    DiffDeltaGetSimilarityMethodInfo        ,
#endif
    diffDeltaGetSimilarity                  ,


-- ** getStatus #method:getStatus#

#if defined(ENABLE_OVERLOADING)
    DiffDeltaGetStatusMethodInfo            ,
#endif
    diffDeltaGetStatus                      ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    DiffDeltaRefMethodInfo                  ,
#endif
    diffDeltaRef                            ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    DiffDeltaUnrefMethodInfo                ,
#endif
    diffDeltaUnref                          ,




    ) 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.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 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.Enums as Ggit.Enums
import {-# SOURCE #-} qualified GI.Ggit.Flags as Ggit.Flags
import {-# SOURCE #-} qualified GI.Ggit.Structs.DiffFile as Ggit.DiffFile

-- | Memory-managed wrapper type.
newtype DiffDelta = DiffDelta (ManagedPtr DiffDelta)
    deriving (DiffDelta -> DiffDelta -> Bool
(DiffDelta -> DiffDelta -> Bool)
-> (DiffDelta -> DiffDelta -> Bool) -> Eq DiffDelta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiffDelta -> DiffDelta -> Bool
$c/= :: DiffDelta -> DiffDelta -> Bool
== :: DiffDelta -> DiffDelta -> Bool
$c== :: DiffDelta -> DiffDelta -> Bool
Eq)
foreign import ccall "ggit_diff_delta_get_type" c_ggit_diff_delta_get_type :: 
    IO GType

instance BoxedObject DiffDelta where
    boxedType :: DiffDelta -> IO GType
boxedType _ = IO GType
c_ggit_diff_delta_get_type

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

-- | A convenience alias for `Nothing` :: `Maybe` `DiffDelta`.
noDiffDelta :: Maybe DiffDelta
noDiffDelta :: Maybe DiffDelta
noDiffDelta = Maybe DiffDelta
forall a. Maybe a
Nothing


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

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

foreign import ccall "ggit_diff_delta_get_flags" ggit_diff_delta_get_flags :: 
    Ptr DiffDelta ->                        -- delta : TInterface (Name {namespace = "Ggit", name = "DiffDelta"})
    IO CUInt

-- | Gets flags for /@delta@/.
diffDeltaGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffDelta
    -- ^ /@delta@/: a t'GI.Ggit.Structs.DiffDelta.DiffDelta'.
    -> m [Ggit.Flags.DiffFlag]
    -- ^ __Returns:__ the delta flags
diffDeltaGetFlags :: DiffDelta -> m [DiffFlag]
diffDeltaGetFlags delta :: DiffDelta
delta = IO [DiffFlag] -> m [DiffFlag]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DiffFlag] -> m [DiffFlag]) -> IO [DiffFlag] -> m [DiffFlag]
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffDelta
delta' <- DiffDelta -> IO (Ptr DiffDelta)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffDelta
delta
    CUInt
result <- Ptr DiffDelta -> IO CUInt
ggit_diff_delta_get_flags Ptr DiffDelta
delta'
    let result' :: [DiffFlag]
result' = CUInt -> [DiffFlag]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    DiffDelta -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffDelta
delta
    [DiffFlag] -> IO [DiffFlag]
forall (m :: * -> *) a. Monad m => a -> m a
return [DiffFlag]
result'

#if defined(ENABLE_OVERLOADING)
data DiffDeltaGetFlagsMethodInfo
instance (signature ~ (m [Ggit.Flags.DiffFlag]), MonadIO m) => O.MethodInfo DiffDeltaGetFlagsMethodInfo DiffDelta signature where
    overloadedMethod = diffDeltaGetFlags

#endif

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

foreign import ccall "ggit_diff_delta_get_new_file" ggit_diff_delta_get_new_file :: 
    Ptr DiffDelta ->                        -- delta : TInterface (Name {namespace = "Ggit", name = "DiffDelta"})
    IO (Ptr Ggit.DiffFile.DiffFile)

-- | Gets the new file for /@delta@/.
diffDeltaGetNewFile ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffDelta
    -- ^ /@delta@/: a t'GI.Ggit.Structs.DiffDelta.DiffDelta'.
    -> m (Maybe Ggit.DiffFile.DiffFile)
    -- ^ __Returns:__ the delta\'s new file or 'P.Nothing'.
diffDeltaGetNewFile :: DiffDelta -> m (Maybe DiffFile)
diffDeltaGetNewFile delta :: DiffDelta
delta = IO (Maybe DiffFile) -> m (Maybe DiffFile)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DiffFile) -> m (Maybe DiffFile))
-> IO (Maybe DiffFile) -> m (Maybe DiffFile)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffDelta
delta' <- DiffDelta -> IO (Ptr DiffDelta)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffDelta
delta
    Ptr DiffFile
result <- Ptr DiffDelta -> IO (Ptr DiffFile)
ggit_diff_delta_get_new_file Ptr DiffDelta
delta'
    Maybe DiffFile
maybeResult <- Ptr DiffFile
-> (Ptr DiffFile -> IO DiffFile) -> IO (Maybe DiffFile)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr DiffFile
result ((Ptr DiffFile -> IO DiffFile) -> IO (Maybe DiffFile))
-> (Ptr DiffFile -> IO DiffFile) -> IO (Maybe DiffFile)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr DiffFile
result' -> do
        DiffFile
result'' <- ((ManagedPtr DiffFile -> DiffFile) -> Ptr DiffFile -> IO DiffFile
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr DiffFile -> DiffFile
Ggit.DiffFile.DiffFile) Ptr DiffFile
result'
        DiffFile -> IO DiffFile
forall (m :: * -> *) a. Monad m => a -> m a
return DiffFile
result''
    DiffDelta -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffDelta
delta
    Maybe DiffFile -> IO (Maybe DiffFile)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DiffFile
maybeResult

#if defined(ENABLE_OVERLOADING)
data DiffDeltaGetNewFileMethodInfo
instance (signature ~ (m (Maybe Ggit.DiffFile.DiffFile)), MonadIO m) => O.MethodInfo DiffDeltaGetNewFileMethodInfo DiffDelta signature where
    overloadedMethod = diffDeltaGetNewFile

#endif

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

foreign import ccall "ggit_diff_delta_get_old_file" ggit_diff_delta_get_old_file :: 
    Ptr DiffDelta ->                        -- delta : TInterface (Name {namespace = "Ggit", name = "DiffDelta"})
    IO (Ptr Ggit.DiffFile.DiffFile)

-- | Gets the old file for /@delta@/.
diffDeltaGetOldFile ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffDelta
    -- ^ /@delta@/: a t'GI.Ggit.Structs.DiffDelta.DiffDelta'.
    -> m (Maybe Ggit.DiffFile.DiffFile)
    -- ^ __Returns:__ the delta\'s old file or 'P.Nothing'.
diffDeltaGetOldFile :: DiffDelta -> m (Maybe DiffFile)
diffDeltaGetOldFile delta :: DiffDelta
delta = IO (Maybe DiffFile) -> m (Maybe DiffFile)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DiffFile) -> m (Maybe DiffFile))
-> IO (Maybe DiffFile) -> m (Maybe DiffFile)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffDelta
delta' <- DiffDelta -> IO (Ptr DiffDelta)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffDelta
delta
    Ptr DiffFile
result <- Ptr DiffDelta -> IO (Ptr DiffFile)
ggit_diff_delta_get_old_file Ptr DiffDelta
delta'
    Maybe DiffFile
maybeResult <- Ptr DiffFile
-> (Ptr DiffFile -> IO DiffFile) -> IO (Maybe DiffFile)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr DiffFile
result ((Ptr DiffFile -> IO DiffFile) -> IO (Maybe DiffFile))
-> (Ptr DiffFile -> IO DiffFile) -> IO (Maybe DiffFile)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr DiffFile
result' -> do
        DiffFile
result'' <- ((ManagedPtr DiffFile -> DiffFile) -> Ptr DiffFile -> IO DiffFile
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr DiffFile -> DiffFile
Ggit.DiffFile.DiffFile) Ptr DiffFile
result'
        DiffFile -> IO DiffFile
forall (m :: * -> *) a. Monad m => a -> m a
return DiffFile
result''
    DiffDelta -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffDelta
delta
    Maybe DiffFile -> IO (Maybe DiffFile)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DiffFile
maybeResult

#if defined(ENABLE_OVERLOADING)
data DiffDeltaGetOldFileMethodInfo
instance (signature ~ (m (Maybe Ggit.DiffFile.DiffFile)), MonadIO m) => O.MethodInfo DiffDeltaGetOldFileMethodInfo DiffDelta signature where
    overloadedMethod = diffDeltaGetOldFile

#endif

-- method DiffDelta::get_similarity
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "delta"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffDelta" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffDelta." , 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_diff_delta_get_similarity" ggit_diff_delta_get_similarity :: 
    Ptr DiffDelta ->                        -- delta : TInterface (Name {namespace = "Ggit", name = "DiffDelta"})
    IO Word32

-- | Gets the similarity between /@delta@/ files.
diffDeltaGetSimilarity ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffDelta
    -- ^ /@delta@/: a t'GI.Ggit.Structs.DiffDelta.DiffDelta'.
    -> m Word32
    -- ^ __Returns:__ the delta\'s similarity.
diffDeltaGetSimilarity :: DiffDelta -> m Word32
diffDeltaGetSimilarity delta :: DiffDelta
delta = 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 DiffDelta
delta' <- DiffDelta -> IO (Ptr DiffDelta)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffDelta
delta
    Word32
result <- Ptr DiffDelta -> IO Word32
ggit_diff_delta_get_similarity Ptr DiffDelta
delta'
    DiffDelta -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffDelta
delta
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data DiffDeltaGetSimilarityMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo DiffDeltaGetSimilarityMethodInfo DiffDelta signature where
    overloadedMethod = diffDeltaGetSimilarity

#endif

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

foreign import ccall "ggit_diff_delta_get_status" ggit_diff_delta_get_status :: 
    Ptr DiffDelta ->                        -- delta : TInterface (Name {namespace = "Ggit", name = "DiffDelta"})
    IO CUInt

-- | Gets the t'GI.Ggit.Enums.DeltaType' for /@delta@/.
diffDeltaGetStatus ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffDelta
    -- ^ /@delta@/: a t'GI.Ggit.Structs.DiffDelta.DiffDelta'.
    -> m Ggit.Enums.DeltaType
    -- ^ __Returns:__ the delta\'s status.
diffDeltaGetStatus :: DiffDelta -> m DeltaType
diffDeltaGetStatus delta :: DiffDelta
delta = IO DeltaType -> m DeltaType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DeltaType -> m DeltaType) -> IO DeltaType -> m DeltaType
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffDelta
delta' <- DiffDelta -> IO (Ptr DiffDelta)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffDelta
delta
    CUInt
result <- Ptr DiffDelta -> IO CUInt
ggit_diff_delta_get_status Ptr DiffDelta
delta'
    let result' :: DeltaType
result' = (Int -> DeltaType
forall a. Enum a => Int -> a
toEnum (Int -> DeltaType) -> (CUInt -> Int) -> CUInt -> DeltaType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    DiffDelta -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffDelta
delta
    DeltaType -> IO DeltaType
forall (m :: * -> *) a. Monad m => a -> m a
return DeltaType
result'

#if defined(ENABLE_OVERLOADING)
data DiffDeltaGetStatusMethodInfo
instance (signature ~ (m Ggit.Enums.DeltaType), MonadIO m) => O.MethodInfo DiffDeltaGetStatusMethodInfo DiffDelta signature where
    overloadedMethod = diffDeltaGetStatus

#endif

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

foreign import ccall "ggit_diff_delta_ref" ggit_diff_delta_ref :: 
    Ptr DiffDelta ->                        -- delta : TInterface (Name {namespace = "Ggit", name = "DiffDelta"})
    IO (Ptr DiffDelta)

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

#if defined(ENABLE_OVERLOADING)
data DiffDeltaRefMethodInfo
instance (signature ~ (m (Maybe DiffDelta)), MonadIO m) => O.MethodInfo DiffDeltaRefMethodInfo DiffDelta signature where
    overloadedMethod = diffDeltaRef

#endif

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

foreign import ccall "ggit_diff_delta_unref" ggit_diff_delta_unref :: 
    Ptr DiffDelta ->                        -- delta : TInterface (Name {namespace = "Ggit", name = "DiffDelta"})
    IO ()

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

#if defined(ENABLE_OVERLOADING)
data DiffDeltaUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo DiffDeltaUnrefMethodInfo DiffDelta signature where
    overloadedMethod = diffDeltaUnref

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveDiffDeltaMethod (t :: Symbol) (o :: *) :: * where
    ResolveDiffDeltaMethod "ref" o = DiffDeltaRefMethodInfo
    ResolveDiffDeltaMethod "unref" o = DiffDeltaUnrefMethodInfo
    ResolveDiffDeltaMethod "getFlags" o = DiffDeltaGetFlagsMethodInfo
    ResolveDiffDeltaMethod "getNewFile" o = DiffDeltaGetNewFileMethodInfo
    ResolveDiffDeltaMethod "getOldFile" o = DiffDeltaGetOldFileMethodInfo
    ResolveDiffDeltaMethod "getSimilarity" o = DiffDeltaGetSimilarityMethodInfo
    ResolveDiffDeltaMethod "getStatus" o = DiffDeltaGetStatusMethodInfo
    ResolveDiffDeltaMethod l o = O.MethodResolutionFailed l o

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

#endif