{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Represents a file in a t'GI.Ggit.Objects.Diff.Diff'.

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

module GI.Ggit.Structs.DiffFile
    ( 

-- * Exported types
    DiffFile(..)                            ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveDiffFileMethod                   ,
#endif

-- ** getFlags #method:getFlags#

#if defined(ENABLE_OVERLOADING)
    DiffFileGetFlagsMethodInfo              ,
#endif
    diffFileGetFlags                        ,


-- ** getMode #method:getMode#

#if defined(ENABLE_OVERLOADING)
    DiffFileGetModeMethodInfo               ,
#endif
    diffFileGetMode                         ,


-- ** getOid #method:getOid#

#if defined(ENABLE_OVERLOADING)
    DiffFileGetOidMethodInfo                ,
#endif
    diffFileGetOid                          ,


-- ** getPath #method:getPath#

#if defined(ENABLE_OVERLOADING)
    DiffFileGetPathMethodInfo               ,
#endif
    diffFileGetPath                         ,


-- ** getSize #method:getSize#

#if defined(ENABLE_OVERLOADING)
    DiffFileGetSizeMethodInfo               ,
#endif
    diffFileGetSize                         ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    DiffFileRefMethodInfo                   ,
#endif
    diffFileRef                             ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    DiffFileUnrefMethodInfo                 ,
#endif
    diffFileUnref                           ,




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

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

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

foreign import ccall "ggit_diff_file_get_type" c_ggit_diff_file_get_type :: 
    IO GType

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

instance B.Types.TypedObject DiffFile where
    glibType :: IO GType
glibType = IO GType
c_ggit_diff_file_get_type

instance B.Types.GBoxed DiffFile

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


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

-- method DiffFile::get_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffFile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFile." , 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_file_get_flags" ggit_diff_file_get_flags :: 
    Ptr DiffFile ->                         -- file : TInterface (Name {namespace = "Ggit", name = "DiffFile"})
    IO CUInt

-- | Gets the @/GgitDifflags/@ for /@file@/.
diffFileGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffFile
    -- ^ /@file@/: a t'GI.Ggit.Structs.DiffFile.DiffFile'.
    -> m [Ggit.Flags.DiffFlag]
    -- ^ __Returns:__ the file\'s flags.
diffFileGetFlags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DiffFile -> m [DiffFlag]
diffFileGetFlags DiffFile
file = 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 DiffFile
file' <- DiffFile -> IO (Ptr DiffFile)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffFile
file
    CUInt
result <- Ptr DiffFile -> IO CUInt
ggit_diff_file_get_flags Ptr DiffFile
file'
    let result' :: [DiffFlag]
result' = CUInt -> [DiffFlag]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    DiffFile -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffFile
file
    [DiffFlag] -> IO [DiffFlag]
forall (m :: * -> *) a. Monad m => a -> m a
return [DiffFlag]
result'

#if defined(ENABLE_OVERLOADING)
data DiffFileGetFlagsMethodInfo
instance (signature ~ (m [Ggit.Flags.DiffFlag]), MonadIO m) => O.OverloadedMethod DiffFileGetFlagsMethodInfo DiffFile signature where
    overloadedMethod = diffFileGetFlags

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


#endif

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

foreign import ccall "ggit_diff_file_get_mode" ggit_diff_file_get_mode :: 
    Ptr DiffFile ->                         -- file : TInterface (Name {namespace = "Ggit", name = "DiffFile"})
    IO Word16

-- | Gets the mode for /@file@/.
diffFileGetMode ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffFile
    -- ^ /@file@/: a t'GI.Ggit.Structs.DiffFile.DiffFile'.
    -> m Word16
    -- ^ __Returns:__ the file\'s mode.
diffFileGetMode :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DiffFile -> m Word16
diffFileGetMode DiffFile
file = IO Word16 -> m Word16
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> m Word16) -> IO Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFile
file' <- DiffFile -> IO (Ptr DiffFile)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffFile
file
    Word16
result <- Ptr DiffFile -> IO Word16
ggit_diff_file_get_mode Ptr DiffFile
file'
    DiffFile -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffFile
file
    Word16 -> IO Word16
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result

#if defined(ENABLE_OVERLOADING)
data DiffFileGetModeMethodInfo
instance (signature ~ (m Word16), MonadIO m) => O.OverloadedMethod DiffFileGetModeMethodInfo DiffFile signature where
    overloadedMethod = diffFileGetMode

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


#endif

-- method DiffFile::get_oid
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffFile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFile." , 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_diff_file_get_oid" ggit_diff_file_get_oid :: 
    Ptr DiffFile ->                         -- file : TInterface (Name {namespace = "Ggit", name = "DiffFile"})
    IO (Ptr Ggit.OId.OId)

-- | Gets the t'GI.Ggit.Structs.OId.OId' for /@file@/.
diffFileGetOid ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffFile
    -- ^ /@file@/: a t'GI.Ggit.Structs.DiffFile.DiffFile'.
    -> m (Maybe Ggit.OId.OId)
    -- ^ __Returns:__ the file\'s t'GI.Ggit.Structs.OId.OId' or 'P.Nothing'.
diffFileGetOid :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DiffFile -> m (Maybe OId)
diffFileGetOid DiffFile
file = 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 DiffFile
file' <- DiffFile -> IO (Ptr DiffFile)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffFile
file
    Ptr OId
result <- Ptr DiffFile -> IO (Ptr OId)
ggit_diff_file_get_oid Ptr DiffFile
file'
    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
newBoxed ManagedPtr OId -> OId
Ggit.OId.OId) Ptr OId
result'
        OId -> IO OId
forall (m :: * -> *) a. Monad m => a -> m a
return OId
result''
    DiffFile -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffFile
file
    Maybe OId -> IO (Maybe OId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe OId
maybeResult

#if defined(ENABLE_OVERLOADING)
data DiffFileGetOidMethodInfo
instance (signature ~ (m (Maybe Ggit.OId.OId)), MonadIO m) => O.OverloadedMethod DiffFileGetOidMethodInfo DiffFile signature where
    overloadedMethod = diffFileGetOid

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


#endif

-- method DiffFile::get_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffFile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFile." , 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_diff_file_get_path" ggit_diff_file_get_path :: 
    Ptr DiffFile ->                         -- file : TInterface (Name {namespace = "Ggit", name = "DiffFile"})
    IO CString

-- | Gets the path of /@file@/ or 'P.Nothing' if it is unknown.
diffFileGetPath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffFile
    -- ^ /@file@/: a t'GI.Ggit.Structs.DiffFile.DiffFile'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the file\'s path, or 'P.Nothing'.
diffFileGetPath :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DiffFile -> m (Maybe Text)
diffFileGetPath DiffFile
file = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFile
file' <- DiffFile -> IO (Ptr DiffFile)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffFile
file
    CString
result <- Ptr DiffFile -> IO CString
ggit_diff_file_get_path Ptr DiffFile
file'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    DiffFile -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffFile
file
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data DiffFileGetPathMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod DiffFileGetPathMethodInfo DiffFile signature where
    overloadedMethod = diffFileGetPath

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


#endif

-- method DiffFile::get_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffFile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFile." , 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_diff_file_get_size" ggit_diff_file_get_size :: 
    Ptr DiffFile ->                         -- file : TInterface (Name {namespace = "Ggit", name = "DiffFile"})
    IO Int64

-- | Gets the size for /@file@/.
diffFileGetSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffFile
    -- ^ /@file@/: a t'GI.Ggit.Structs.DiffFile.DiffFile'.
    -> m Int64
    -- ^ __Returns:__ the file\'s size.
diffFileGetSize :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DiffFile -> m Int64
diffFileGetSize DiffFile
file = 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 DiffFile
file' <- DiffFile -> IO (Ptr DiffFile)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffFile
file
    Int64
result <- Ptr DiffFile -> IO Int64
ggit_diff_file_get_size Ptr DiffFile
file'
    DiffFile -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffFile
file
    Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result

#if defined(ENABLE_OVERLOADING)
data DiffFileGetSizeMethodInfo
instance (signature ~ (m Int64), MonadIO m) => O.OverloadedMethod DiffFileGetSizeMethodInfo DiffFile signature where
    overloadedMethod = diffFileGetSize

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


#endif

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

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

#if defined(ENABLE_OVERLOADING)
data DiffFileRefMethodInfo
instance (signature ~ (m (Maybe DiffFile)), MonadIO m) => O.OverloadedMethod DiffFileRefMethodInfo DiffFile signature where
    overloadedMethod = diffFileRef

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


#endif

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

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

#if defined(ENABLE_OVERLOADING)
data DiffFileUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod DiffFileUnrefMethodInfo DiffFile signature where
    overloadedMethod = diffFileUnref

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


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveDiffFileMethod (t :: Symbol) (o :: *) :: * where
    ResolveDiffFileMethod "ref" o = DiffFileRefMethodInfo
    ResolveDiffFileMethod "unref" o = DiffFileUnrefMethodInfo
    ResolveDiffFileMethod "getFlags" o = DiffFileGetFlagsMethodInfo
    ResolveDiffFileMethod "getMode" o = DiffFileGetModeMethodInfo
    ResolveDiffFileMethod "getOid" o = DiffFileGetOidMethodInfo
    ResolveDiffFileMethod "getPath" o = DiffFileGetPathMethodInfo
    ResolveDiffFileMethod "getSize" o = DiffFileGetSizeMethodInfo
    ResolveDiffFileMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveDiffFileMethod t DiffFile, O.OverloadedMethod info DiffFile p) => OL.IsLabel t (DiffFile -> 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 ~ ResolveDiffFileMethod t DiffFile, O.OverloadedMethod info DiffFile p, R.HasField t DiffFile p) => R.HasField t DiffFile p where
    getField = O.overloadedMethod @info

#endif

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

#endif