{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- 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(..)                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [ref]("GI.Ggit.Structs.DiffDelta#g:method:ref"), [unref]("GI.Ggit.Structs.DiffDelta#g:method:unref").
-- 
-- ==== Getters
-- [getFlags]("GI.Ggit.Structs.DiffDelta#g:method:getFlags"), [getNewFile]("GI.Ggit.Structs.DiffDelta#g:method:getNewFile"), [getOldFile]("GI.Ggit.Structs.DiffDelta#g:method:getOldFile"), [getSimilarity]("GI.Ggit.Structs.DiffDelta#g:method:getSimilarity"), [getStatus]("GI.Ggit.Structs.DiffDelta#g:method:getStatus").
-- 
-- ==== Setters
-- /None/.

#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.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import {-# 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 (SP.ManagedPtr DiffDelta)
    deriving (DiffDelta -> DiffDelta -> Bool
(DiffDelta -> DiffDelta -> Bool)
-> (DiffDelta -> DiffDelta -> Bool) -> Eq DiffDelta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DiffDelta -> DiffDelta -> Bool
== :: DiffDelta -> DiffDelta -> Bool
$c/= :: DiffDelta -> DiffDelta -> Bool
/= :: DiffDelta -> DiffDelta -> Bool
Eq)

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

foreign import ccall "ggit_diff_delta_get_type" c_ggit_diff_delta_get_type :: 
    IO GType

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

instance B.Types.TypedObject DiffDelta where
    glibType :: IO GType
glibType = IO GType
c_ggit_diff_delta_get_type

instance B.Types.GBoxed DiffDelta

-- | Convert 'DiffDelta' 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 DiffDelta) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_ggit_diff_delta_get_type
    gvalueSet_ :: Ptr GValue -> Maybe DiffDelta -> IO ()
gvalueSet_ Ptr GValue
gv Maybe DiffDelta
P.Nothing = Ptr GValue -> Ptr DiffDelta -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr DiffDelta
forall a. Ptr a
FP.nullPtr :: FP.Ptr DiffDelta)
    gvalueSet_ Ptr GValue
gv (P.Just DiffDelta
obj) = DiffDelta -> (Ptr DiffDelta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr DiffDelta
obj (Ptr GValue -> Ptr DiffDelta -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe DiffDelta)
gvalueGet_ Ptr GValue
gv = do
        Ptr DiffDelta
ptr <- Ptr GValue -> IO (Ptr DiffDelta)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr DiffDelta)
        if Ptr DiffDelta
ptr Ptr DiffDelta -> Ptr DiffDelta -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr DiffDelta
forall a. Ptr a
FP.nullPtr
        then DiffDelta -> Maybe DiffDelta
forall a. a -> Maybe a
P.Just (DiffDelta -> Maybe DiffDelta)
-> IO DiffDelta -> IO (Maybe DiffDelta)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr DiffDelta -> DiffDelta)
-> Ptr DiffDelta -> IO DiffDelta
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr DiffDelta -> DiffDelta
DiffDelta Ptr DiffDelta
ptr
        else Maybe DiffDelta -> IO (Maybe DiffDelta)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DiffDelta
forall a. Maybe a
P.Nothing
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DiffDelta
type instance O.AttributeList DiffDelta = DiffDeltaAttributeList
type DiffDeltaAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DiffDelta -> m [DiffFlag]
diffDeltaGetFlags DiffDelta
delta = IO [DiffFlag] -> m [DiffFlag]
forall a. IO a -> m a
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 a. a -> IO a
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.OverloadedMethod DiffDeltaGetFlagsMethodInfo DiffDelta signature where
    overloadedMethod = diffDeltaGetFlags

instance O.OverloadedMethodInfo DiffDeltaGetFlagsMethodInfo DiffDelta where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.DiffDelta.diffDeltaGetFlags",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.14/docs/GI-Ggit-Structs-DiffDelta.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DiffDelta -> m (Maybe DiffFile)
diffDeltaGetNewFile DiffDelta
delta = IO (Maybe DiffFile) -> m (Maybe DiffFile)
forall a. IO a -> m a
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
$ \Ptr DiffFile
result' -> do
        DiffFile
result'' <- ((ManagedPtr DiffFile -> DiffFile) -> Ptr DiffFile -> IO DiffFile
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr DiffFile -> DiffFile
Ggit.DiffFile.DiffFile) Ptr DiffFile
result'
        DiffFile -> IO DiffFile
forall a. a -> IO a
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 a. a -> IO a
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.OverloadedMethod DiffDeltaGetNewFileMethodInfo DiffDelta signature where
    overloadedMethod = diffDeltaGetNewFile

instance O.OverloadedMethodInfo DiffDeltaGetNewFileMethodInfo DiffDelta where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.DiffDelta.diffDeltaGetNewFile",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.14/docs/GI-Ggit-Structs-DiffDelta.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DiffDelta -> m (Maybe DiffFile)
diffDeltaGetOldFile DiffDelta
delta = IO (Maybe DiffFile) -> m (Maybe DiffFile)
forall a. IO a -> m a
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
$ \Ptr DiffFile
result' -> do
        DiffFile
result'' <- ((ManagedPtr DiffFile -> DiffFile) -> Ptr DiffFile -> IO DiffFile
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr DiffFile -> DiffFile
Ggit.DiffFile.DiffFile) Ptr DiffFile
result'
        DiffFile -> IO DiffFile
forall a. a -> IO a
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 a. a -> IO a
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.OverloadedMethod DiffDeltaGetOldFileMethodInfo DiffDelta signature where
    overloadedMethod = diffDeltaGetOldFile

instance O.OverloadedMethodInfo DiffDeltaGetOldFileMethodInfo DiffDelta where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.DiffDelta.diffDeltaGetOldFile",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.14/docs/GI-Ggit-Structs-DiffDelta.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DiffDelta -> m Word32
diffDeltaGetSimilarity DiffDelta
delta = 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 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

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

instance O.OverloadedMethodInfo DiffDeltaGetSimilarityMethodInfo DiffDelta where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.DiffDelta.diffDeltaGetSimilarity",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.14/docs/GI-Ggit-Structs-DiffDelta.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DiffDelta -> m DeltaType
diffDeltaGetStatus DiffDelta
delta = IO DeltaType -> m DeltaType
forall a. IO a -> m a
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 a. a -> IO a
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.OverloadedMethod DiffDeltaGetStatusMethodInfo DiffDelta signature where
    overloadedMethod = diffDeltaGetStatus

instance O.OverloadedMethodInfo DiffDeltaGetStatusMethodInfo DiffDelta where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.DiffDelta.diffDeltaGetStatus",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.14/docs/GI-Ggit-Structs-DiffDelta.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DiffDelta -> m (Maybe DiffDelta)
diffDeltaRef DiffDelta
delta = IO (Maybe DiffDelta) -> m (Maybe DiffDelta)
forall a. IO a -> m a
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
$ \Ptr DiffDelta
result' -> do
        DiffDelta
result'' <- ((ManagedPtr DiffDelta -> DiffDelta)
-> Ptr DiffDelta -> IO DiffDelta
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr DiffDelta -> DiffDelta
DiffDelta) Ptr DiffDelta
result'
        DiffDelta -> IO DiffDelta
forall a. a -> IO a
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 a. a -> IO a
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.OverloadedMethod DiffDeltaRefMethodInfo DiffDelta signature where
    overloadedMethod = diffDeltaRef

instance O.OverloadedMethodInfo DiffDeltaRefMethodInfo DiffDelta where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.DiffDelta.diffDeltaRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.14/docs/GI-Ggit-Structs-DiffDelta.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DiffDelta -> m ()
diffDeltaUnref DiffDelta
delta = 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 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveDiffDeltaMethod (t :: Symbol) (o :: DK.Type) :: DK.Type 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.OverloadedMethod 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

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

#endif

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

#endif