{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Represents the hunk of a diff.

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

module GI.Ggit.Structs.DiffHunk
    ( 

-- * Exported types
    DiffHunk(..)                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [ref]("GI.Ggit.Structs.DiffHunk#g:method:ref"), [unref]("GI.Ggit.Structs.DiffHunk#g:method:unref").
-- 
-- ==== Getters
-- [getHeader]("GI.Ggit.Structs.DiffHunk#g:method:getHeader"), [getNewLines]("GI.Ggit.Structs.DiffHunk#g:method:getNewLines"), [getNewStart]("GI.Ggit.Structs.DiffHunk#g:method:getNewStart"), [getOldLines]("GI.Ggit.Structs.DiffHunk#g:method:getOldLines"), [getOldStart]("GI.Ggit.Structs.DiffHunk#g:method:getOldStart").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveDiffHunkMethod                   ,
#endif

-- ** getHeader #method:getHeader#

#if defined(ENABLE_OVERLOADING)
    DiffHunkGetHeaderMethodInfo             ,
#endif
    diffHunkGetHeader                       ,


-- ** getNewLines #method:getNewLines#

#if defined(ENABLE_OVERLOADING)
    DiffHunkGetNewLinesMethodInfo           ,
#endif
    diffHunkGetNewLines                     ,


-- ** getNewStart #method:getNewStart#

#if defined(ENABLE_OVERLOADING)
    DiffHunkGetNewStartMethodInfo           ,
#endif
    diffHunkGetNewStart                     ,


-- ** getOldLines #method:getOldLines#

#if defined(ENABLE_OVERLOADING)
    DiffHunkGetOldLinesMethodInfo           ,
#endif
    diffHunkGetOldLines                     ,


-- ** getOldStart #method:getOldStart#

#if defined(ENABLE_OVERLOADING)
    DiffHunkGetOldStartMethodInfo           ,
#endif
    diffHunkGetOldStart                     ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    DiffHunkRefMethodInfo                   ,
#endif
    diffHunkRef                             ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    DiffHunkUnrefMethodInfo                 ,
#endif
    diffHunkUnref                           ,




    ) 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


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

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

foreign import ccall "ggit_diff_hunk_get_type" c_ggit_diff_hunk_get_type :: 
    IO GType

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

instance B.Types.TypedObject DiffHunk where
    glibType :: IO GType
glibType = IO GType
c_ggit_diff_hunk_get_type

instance B.Types.GBoxed DiffHunk

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


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

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

foreign import ccall "ggit_diff_hunk_get_header" ggit_diff_hunk_get_header :: 
    Ptr DiffHunk ->                         -- hunk : TInterface (Name {namespace = "Ggit", name = "DiffHunk"})
    IO CString

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

#if defined(ENABLE_OVERLOADING)
data DiffHunkGetHeaderMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod DiffHunkGetHeaderMethodInfo DiffHunk signature where
    overloadedMethod = diffHunkGetHeader

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


#endif

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

foreign import ccall "ggit_diff_hunk_get_new_lines" ggit_diff_hunk_get_new_lines :: 
    Ptr DiffHunk ->                         -- hunk : TInterface (Name {namespace = "Ggit", name = "DiffHunk"})
    IO Int32

-- | Gets the number of lines in the new file.
diffHunkGetNewLines ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffHunk
    -- ^ /@hunk@/: a t'GI.Ggit.Structs.DiffHunk.DiffHunk'.
    -> m Int32
    -- ^ __Returns:__ the number of lines in the new file.
diffHunkGetNewLines :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DiffHunk -> m Int32
diffHunkGetNewLines DiffHunk
hunk = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffHunk
hunk' <- DiffHunk -> IO (Ptr DiffHunk)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffHunk
hunk
    Int32
result <- Ptr DiffHunk -> IO Int32
ggit_diff_hunk_get_new_lines Ptr DiffHunk
hunk'
    DiffHunk -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffHunk
hunk
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DiffHunkGetNewLinesMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod DiffHunkGetNewLinesMethodInfo DiffHunk signature where
    overloadedMethod = diffHunkGetNewLines

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


#endif

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

foreign import ccall "ggit_diff_hunk_get_new_start" ggit_diff_hunk_get_new_start :: 
    Ptr DiffHunk ->                         -- hunk : TInterface (Name {namespace = "Ggit", name = "DiffHunk"})
    IO Int32

-- | Gets the starting line number in the new file.
diffHunkGetNewStart ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffHunk
    -- ^ /@hunk@/: a t'GI.Ggit.Structs.DiffHunk.DiffHunk'.
    -> m Int32
    -- ^ __Returns:__ the starting line number in the new file.
diffHunkGetNewStart :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DiffHunk -> m Int32
diffHunkGetNewStart DiffHunk
hunk = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffHunk
hunk' <- DiffHunk -> IO (Ptr DiffHunk)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffHunk
hunk
    Int32
result <- Ptr DiffHunk -> IO Int32
ggit_diff_hunk_get_new_start Ptr DiffHunk
hunk'
    DiffHunk -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffHunk
hunk
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DiffHunkGetNewStartMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod DiffHunkGetNewStartMethodInfo DiffHunk signature where
    overloadedMethod = diffHunkGetNewStart

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


#endif

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

foreign import ccall "ggit_diff_hunk_get_old_lines" ggit_diff_hunk_get_old_lines :: 
    Ptr DiffHunk ->                         -- hunk : TInterface (Name {namespace = "Ggit", name = "DiffHunk"})
    IO Int32

-- | Gets the number of lines in the old file.
diffHunkGetOldLines ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffHunk
    -- ^ /@hunk@/: a t'GI.Ggit.Structs.DiffHunk.DiffHunk'.
    -> m Int32
    -- ^ __Returns:__ the number of lines in the old file.
diffHunkGetOldLines :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DiffHunk -> m Int32
diffHunkGetOldLines DiffHunk
hunk = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffHunk
hunk' <- DiffHunk -> IO (Ptr DiffHunk)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffHunk
hunk
    Int32
result <- Ptr DiffHunk -> IO Int32
ggit_diff_hunk_get_old_lines Ptr DiffHunk
hunk'
    DiffHunk -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffHunk
hunk
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DiffHunkGetOldLinesMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod DiffHunkGetOldLinesMethodInfo DiffHunk signature where
    overloadedMethod = diffHunkGetOldLines

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


#endif

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

foreign import ccall "ggit_diff_hunk_get_old_start" ggit_diff_hunk_get_old_start :: 
    Ptr DiffHunk ->                         -- hunk : TInterface (Name {namespace = "Ggit", name = "DiffHunk"})
    IO Int32

-- | Gets the starting line number in the old file.
diffHunkGetOldStart ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffHunk
    -- ^ /@hunk@/: a t'GI.Ggit.Structs.DiffHunk.DiffHunk'.
    -> m Int32
    -- ^ __Returns:__ the starting line number in the old file.
diffHunkGetOldStart :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DiffHunk -> m Int32
diffHunkGetOldStart DiffHunk
hunk = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffHunk
hunk' <- DiffHunk -> IO (Ptr DiffHunk)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffHunk
hunk
    Int32
result <- Ptr DiffHunk -> IO Int32
ggit_diff_hunk_get_old_start Ptr DiffHunk
hunk'
    DiffHunk -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffHunk
hunk
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DiffHunkGetOldStartMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod DiffHunkGetOldStartMethodInfo DiffHunk signature where
    overloadedMethod = diffHunkGetOldStart

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


#endif

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

foreign import ccall "ggit_diff_hunk_ref" ggit_diff_hunk_ref :: 
    Ptr DiffHunk ->                         -- hunk : TInterface (Name {namespace = "Ggit", name = "DiffHunk"})
    IO (Ptr DiffHunk)

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

#if defined(ENABLE_OVERLOADING)
data DiffHunkRefMethodInfo
instance (signature ~ (m (Maybe DiffHunk)), MonadIO m) => O.OverloadedMethod DiffHunkRefMethodInfo DiffHunk signature where
    overloadedMethod = diffHunkRef

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


#endif

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

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

#if defined(ENABLE_OVERLOADING)
data DiffHunkUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod DiffHunkUnrefMethodInfo DiffHunk signature where
    overloadedMethod = diffHunkUnref

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


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveDiffHunkMethod (t :: Symbol) (o :: *) :: * where
    ResolveDiffHunkMethod "ref" o = DiffHunkRefMethodInfo
    ResolveDiffHunkMethod "unref" o = DiffHunkUnrefMethodInfo
    ResolveDiffHunkMethod "getHeader" o = DiffHunkGetHeaderMethodInfo
    ResolveDiffHunkMethod "getNewLines" o = DiffHunkGetNewLinesMethodInfo
    ResolveDiffHunkMethod "getNewStart" o = DiffHunkGetNewStartMethodInfo
    ResolveDiffHunkMethod "getOldLines" o = DiffHunkGetOldLinesMethodInfo
    ResolveDiffHunkMethod "getOldStart" o = DiffHunkGetOldStartMethodInfo
    ResolveDiffHunkMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif