{-# LANGUAGE TypeApplications #-}


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

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

module GI.Ggit.Structs.BlameHunk
    ( 

-- * Exported types
    BlameHunk(..)                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [isBoundary]("GI.Ggit.Structs.BlameHunk#g:method:isBoundary"), [ref]("GI.Ggit.Structs.BlameHunk#g:method:ref"), [unref]("GI.Ggit.Structs.BlameHunk#g:method:unref").
-- 
-- ==== Getters
-- [getFinalCommitId]("GI.Ggit.Structs.BlameHunk#g:method:getFinalCommitId"), [getFinalSignature]("GI.Ggit.Structs.BlameHunk#g:method:getFinalSignature"), [getFinalStartLineNumber]("GI.Ggit.Structs.BlameHunk#g:method:getFinalStartLineNumber"), [getLinesInHunk]("GI.Ggit.Structs.BlameHunk#g:method:getLinesInHunk"), [getOrigCommitId]("GI.Ggit.Structs.BlameHunk#g:method:getOrigCommitId"), [getOrigPath]("GI.Ggit.Structs.BlameHunk#g:method:getOrigPath"), [getOrigSignature]("GI.Ggit.Structs.BlameHunk#g:method:getOrigSignature"), [getOrigStartLineNumber]("GI.Ggit.Structs.BlameHunk#g:method:getOrigStartLineNumber").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveBlameHunkMethod                  ,
#endif

-- ** getFinalCommitId #method:getFinalCommitId#

#if defined(ENABLE_OVERLOADING)
    BlameHunkGetFinalCommitIdMethodInfo     ,
#endif
    blameHunkGetFinalCommitId               ,


-- ** getFinalSignature #method:getFinalSignature#

#if defined(ENABLE_OVERLOADING)
    BlameHunkGetFinalSignatureMethodInfo    ,
#endif
    blameHunkGetFinalSignature              ,


-- ** getFinalStartLineNumber #method:getFinalStartLineNumber#

#if defined(ENABLE_OVERLOADING)
    BlameHunkGetFinalStartLineNumberMethodInfo,
#endif
    blameHunkGetFinalStartLineNumber        ,


-- ** getLinesInHunk #method:getLinesInHunk#

#if defined(ENABLE_OVERLOADING)
    BlameHunkGetLinesInHunkMethodInfo       ,
#endif
    blameHunkGetLinesInHunk                 ,


-- ** getOrigCommitId #method:getOrigCommitId#

#if defined(ENABLE_OVERLOADING)
    BlameHunkGetOrigCommitIdMethodInfo      ,
#endif
    blameHunkGetOrigCommitId                ,


-- ** getOrigPath #method:getOrigPath#

#if defined(ENABLE_OVERLOADING)
    BlameHunkGetOrigPathMethodInfo          ,
#endif
    blameHunkGetOrigPath                    ,


-- ** getOrigSignature #method:getOrigSignature#

#if defined(ENABLE_OVERLOADING)
    BlameHunkGetOrigSignatureMethodInfo     ,
#endif
    blameHunkGetOrigSignature               ,


-- ** getOrigStartLineNumber #method:getOrigStartLineNumber#

#if defined(ENABLE_OVERLOADING)
    BlameHunkGetOrigStartLineNumberMethodInfo,
#endif
    blameHunkGetOrigStartLineNumber         ,


-- ** isBoundary #method:isBoundary#

#if defined(ENABLE_OVERLOADING)
    BlameHunkIsBoundaryMethodInfo           ,
#endif
    blameHunkIsBoundary                     ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    BlameHunkRefMethodInfo                  ,
#endif
    blameHunkRef                            ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    BlameHunkUnrefMethodInfo                ,
#endif
    blameHunkUnref                          ,




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

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

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

foreign import ccall "ggit_blame_hunk_get_type" c_ggit_blame_hunk_get_type :: 
    IO GType

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

instance B.Types.TypedObject BlameHunk where
    glibType :: IO GType
glibType = IO GType
c_ggit_blame_hunk_get_type

instance B.Types.GBoxed BlameHunk

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


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

-- method BlameHunk::get_final_commit_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "blame_hunk"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "BlameHunk" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitBlameHunk." , 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_blame_hunk_get_final_commit_id" ggit_blame_hunk_get_final_commit_id :: 
    Ptr BlameHunk ->                        -- blame_hunk : TInterface (Name {namespace = "Ggit", name = "BlameHunk"})
    IO (Ptr Ggit.OId.OId)

-- | Get the id of the commit where this hunk was last changed.
blameHunkGetFinalCommitId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BlameHunk
    -- ^ /@blameHunk@/: a t'GI.Ggit.Structs.BlameHunk.BlameHunk'.
    -> m (Maybe Ggit.OId.OId)
    -- ^ __Returns:__ a t'GI.Ggit.Structs.OId.OId' or 'P.Nothing'.
blameHunkGetFinalCommitId :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BlameHunk -> m (Maybe OId)
blameHunkGetFinalCommitId BlameHunk
blameHunk = 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 BlameHunk
blameHunk' <- BlameHunk -> IO (Ptr BlameHunk)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BlameHunk
blameHunk
    Ptr OId
result <- Ptr BlameHunk -> IO (Ptr OId)
ggit_blame_hunk_get_final_commit_id Ptr BlameHunk
blameHunk'
    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''
    BlameHunk -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BlameHunk
blameHunk
    Maybe OId -> IO (Maybe OId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe OId
maybeResult

#if defined(ENABLE_OVERLOADING)
data BlameHunkGetFinalCommitIdMethodInfo
instance (signature ~ (m (Maybe Ggit.OId.OId)), MonadIO m) => O.OverloadedMethod BlameHunkGetFinalCommitIdMethodInfo BlameHunk signature where
    overloadedMethod = blameHunkGetFinalCommitId

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


#endif

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

foreign import ccall "ggit_blame_hunk_get_final_signature" ggit_blame_hunk_get_final_signature :: 
    Ptr BlameHunk ->                        -- blame_hunk : TInterface (Name {namespace = "Ggit", name = "BlameHunk"})
    IO (Ptr Ggit.Signature.Signature)

-- | Get the signature of the final version of the hunk.
blameHunkGetFinalSignature ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BlameHunk
    -- ^ /@blameHunk@/: a t'GI.Ggit.Structs.BlameHunk.BlameHunk'.
    -> m (Maybe Ggit.Signature.Signature)
    -- ^ __Returns:__ a t'GI.Ggit.Objects.Signature.Signature' or 'P.Nothing'.
blameHunkGetFinalSignature :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BlameHunk -> m (Maybe Signature)
blameHunkGetFinalSignature BlameHunk
blameHunk = IO (Maybe Signature) -> m (Maybe Signature)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Signature) -> m (Maybe Signature))
-> IO (Maybe Signature) -> m (Maybe Signature)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BlameHunk
blameHunk' <- BlameHunk -> IO (Ptr BlameHunk)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BlameHunk
blameHunk
    Ptr Signature
result <- Ptr BlameHunk -> IO (Ptr Signature)
ggit_blame_hunk_get_final_signature Ptr BlameHunk
blameHunk'
    Maybe Signature
maybeResult <- Ptr Signature
-> (Ptr Signature -> IO Signature) -> IO (Maybe Signature)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Signature
result ((Ptr Signature -> IO Signature) -> IO (Maybe Signature))
-> (Ptr Signature -> IO Signature) -> IO (Maybe Signature)
forall a b. (a -> b) -> a -> b
$ \Ptr Signature
result' -> do
        Signature
result'' <- ((ManagedPtr Signature -> Signature)
-> Ptr Signature -> IO Signature
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Signature -> Signature
Ggit.Signature.Signature) Ptr Signature
result'
        Signature -> IO Signature
forall (m :: * -> *) a. Monad m => a -> m a
return Signature
result''
    BlameHunk -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BlameHunk
blameHunk
    Maybe Signature -> IO (Maybe Signature)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Signature
maybeResult

#if defined(ENABLE_OVERLOADING)
data BlameHunkGetFinalSignatureMethodInfo
instance (signature ~ (m (Maybe Ggit.Signature.Signature)), MonadIO m) => O.OverloadedMethod BlameHunkGetFinalSignatureMethodInfo BlameHunk signature where
    overloadedMethod = blameHunkGetFinalSignature

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


#endif

-- method BlameHunk::get_final_start_line_number
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "blame_hunk"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "BlameHunk" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitBlameHunk." , 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_blame_hunk_get_final_start_line_number" ggit_blame_hunk_get_final_start_line_number :: 
    Ptr BlameHunk ->                        -- blame_hunk : TInterface (Name {namespace = "Ggit", name = "BlameHunk"})
    IO Word16

-- | Get the line number where the hunk begins in the final version of the file.
-- Line numbers start at 1.
blameHunkGetFinalStartLineNumber ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BlameHunk
    -- ^ /@blameHunk@/: a t'GI.Ggit.Structs.BlameHunk.BlameHunk'.
    -> m Word16
    -- ^ __Returns:__ the final hunk line number.
blameHunkGetFinalStartLineNumber :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BlameHunk -> m Word16
blameHunkGetFinalStartLineNumber BlameHunk
blameHunk = 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 BlameHunk
blameHunk' <- BlameHunk -> IO (Ptr BlameHunk)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BlameHunk
blameHunk
    Word16
result <- Ptr BlameHunk -> IO Word16
ggit_blame_hunk_get_final_start_line_number Ptr BlameHunk
blameHunk'
    BlameHunk -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BlameHunk
blameHunk
    Word16 -> IO Word16
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result

#if defined(ENABLE_OVERLOADING)
data BlameHunkGetFinalStartLineNumberMethodInfo
instance (signature ~ (m Word16), MonadIO m) => O.OverloadedMethod BlameHunkGetFinalStartLineNumberMethodInfo BlameHunk signature where
    overloadedMethod = blameHunkGetFinalStartLineNumber

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


#endif

-- method BlameHunk::get_lines_in_hunk
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "blame_hunk"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "BlameHunk" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitBlameHunk." , 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_blame_hunk_get_lines_in_hunk" ggit_blame_hunk_get_lines_in_hunk :: 
    Ptr BlameHunk ->                        -- blame_hunk : TInterface (Name {namespace = "Ggit", name = "BlameHunk"})
    IO Word16

-- | Get the number of lines in the hunk.
blameHunkGetLinesInHunk ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BlameHunk
    -- ^ /@blameHunk@/: a t'GI.Ggit.Structs.BlameHunk.BlameHunk'.
    -> m Word16
    -- ^ __Returns:__ the number of lines in the hunk.
blameHunkGetLinesInHunk :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BlameHunk -> m Word16
blameHunkGetLinesInHunk BlameHunk
blameHunk = 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 BlameHunk
blameHunk' <- BlameHunk -> IO (Ptr BlameHunk)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BlameHunk
blameHunk
    Word16
result <- Ptr BlameHunk -> IO Word16
ggit_blame_hunk_get_lines_in_hunk Ptr BlameHunk
blameHunk'
    BlameHunk -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BlameHunk
blameHunk
    Word16 -> IO Word16
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result

#if defined(ENABLE_OVERLOADING)
data BlameHunkGetLinesInHunkMethodInfo
instance (signature ~ (m Word16), MonadIO m) => O.OverloadedMethod BlameHunkGetLinesInHunkMethodInfo BlameHunk signature where
    overloadedMethod = blameHunkGetLinesInHunk

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


#endif

-- method BlameHunk::get_orig_commit_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "blame_hunk"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "BlameHunk" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitBlameHunk." , 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_blame_hunk_get_orig_commit_id" ggit_blame_hunk_get_orig_commit_id :: 
    Ptr BlameHunk ->                        -- blame_hunk : TInterface (Name {namespace = "Ggit", name = "BlameHunk"})
    IO (Ptr Ggit.OId.OId)

-- | Get the id of the commit where the hunk was found. This is usually the same
-- the final commit id, except when @/GGIT_BLAME_TRACK_COPIES_ANY_COMMIT/@ was used.
blameHunkGetOrigCommitId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BlameHunk
    -- ^ /@blameHunk@/: a t'GI.Ggit.Structs.BlameHunk.BlameHunk'.
    -> m (Maybe Ggit.OId.OId)
    -- ^ __Returns:__ a t'GI.Ggit.Structs.OId.OId' or 'P.Nothing'.
blameHunkGetOrigCommitId :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BlameHunk -> m (Maybe OId)
blameHunkGetOrigCommitId BlameHunk
blameHunk = 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 BlameHunk
blameHunk' <- BlameHunk -> IO (Ptr BlameHunk)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BlameHunk
blameHunk
    Ptr OId
result <- Ptr BlameHunk -> IO (Ptr OId)
ggit_blame_hunk_get_orig_commit_id Ptr BlameHunk
blameHunk'
    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''
    BlameHunk -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BlameHunk
blameHunk
    Maybe OId -> IO (Maybe OId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe OId
maybeResult

#if defined(ENABLE_OVERLOADING)
data BlameHunkGetOrigCommitIdMethodInfo
instance (signature ~ (m (Maybe Ggit.OId.OId)), MonadIO m) => O.OverloadedMethod BlameHunkGetOrigCommitIdMethodInfo BlameHunk signature where
    overloadedMethod = blameHunkGetOrigCommitId

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


#endif

-- method BlameHunk::get_orig_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "blame_hunk"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "BlameHunk" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitBlameHunk." , 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_blame_hunk_get_orig_path" ggit_blame_hunk_get_orig_path :: 
    Ptr BlameHunk ->                        -- blame_hunk : TInterface (Name {namespace = "Ggit", name = "BlameHunk"})
    IO CString

-- | Get the path of the file where this hunk originated, as of the commit
-- specified by @/ggit_blame_hunk_get_orig_commit_id/@.
blameHunkGetOrigPath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BlameHunk
    -- ^ /@blameHunk@/: a t'GI.Ggit.Structs.BlameHunk.BlameHunk'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the path or 'P.Nothing'.
blameHunkGetOrigPath :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BlameHunk -> m (Maybe Text)
blameHunkGetOrigPath BlameHunk
blameHunk = 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 BlameHunk
blameHunk' <- BlameHunk -> IO (Ptr BlameHunk)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BlameHunk
blameHunk
    CString
result <- Ptr BlameHunk -> IO CString
ggit_blame_hunk_get_orig_path Ptr BlameHunk
blameHunk'
    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''
    BlameHunk -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BlameHunk
blameHunk
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data BlameHunkGetOrigPathMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod BlameHunkGetOrigPathMethodInfo BlameHunk signature where
    overloadedMethod = blameHunkGetOrigPath

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


#endif

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

foreign import ccall "ggit_blame_hunk_get_orig_signature" ggit_blame_hunk_get_orig_signature :: 
    Ptr BlameHunk ->                        -- blame_hunk : TInterface (Name {namespace = "Ggit", name = "BlameHunk"})
    IO (Ptr Ggit.Signature.Signature)

-- | Get the signature of the commit specified by @/ggit_blame_hunk_get_orig_commit_id/@.
blameHunkGetOrigSignature ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BlameHunk
    -- ^ /@blameHunk@/: a t'GI.Ggit.Structs.BlameHunk.BlameHunk'.
    -> m (Maybe Ggit.Signature.Signature)
    -- ^ __Returns:__ a t'GI.Ggit.Objects.Signature.Signature' or 'P.Nothing'.
blameHunkGetOrigSignature :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BlameHunk -> m (Maybe Signature)
blameHunkGetOrigSignature BlameHunk
blameHunk = IO (Maybe Signature) -> m (Maybe Signature)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Signature) -> m (Maybe Signature))
-> IO (Maybe Signature) -> m (Maybe Signature)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BlameHunk
blameHunk' <- BlameHunk -> IO (Ptr BlameHunk)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BlameHunk
blameHunk
    Ptr Signature
result <- Ptr BlameHunk -> IO (Ptr Signature)
ggit_blame_hunk_get_orig_signature Ptr BlameHunk
blameHunk'
    Maybe Signature
maybeResult <- Ptr Signature
-> (Ptr Signature -> IO Signature) -> IO (Maybe Signature)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Signature
result ((Ptr Signature -> IO Signature) -> IO (Maybe Signature))
-> (Ptr Signature -> IO Signature) -> IO (Maybe Signature)
forall a b. (a -> b) -> a -> b
$ \Ptr Signature
result' -> do
        Signature
result'' <- ((ManagedPtr Signature -> Signature)
-> Ptr Signature -> IO Signature
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Signature -> Signature
Ggit.Signature.Signature) Ptr Signature
result'
        Signature -> IO Signature
forall (m :: * -> *) a. Monad m => a -> m a
return Signature
result''
    BlameHunk -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BlameHunk
blameHunk
    Maybe Signature -> IO (Maybe Signature)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Signature
maybeResult

#if defined(ENABLE_OVERLOADING)
data BlameHunkGetOrigSignatureMethodInfo
instance (signature ~ (m (Maybe Ggit.Signature.Signature)), MonadIO m) => O.OverloadedMethod BlameHunkGetOrigSignatureMethodInfo BlameHunk signature where
    overloadedMethod = blameHunkGetOrigSignature

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


#endif

-- method BlameHunk::get_orig_start_line_number
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "blame_hunk"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "BlameHunk" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitBlameHunk." , 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_blame_hunk_get_orig_start_line_number" ggit_blame_hunk_get_orig_start_line_number :: 
    Ptr BlameHunk ->                        -- blame_hunk : TInterface (Name {namespace = "Ggit", name = "BlameHunk"})
    IO Word16

-- | Get the line number where the hunk begins in the file specified by
-- @/ggit_blame_hunk_get_orig_path/@ at the commit specified by
-- @/ggit_blame_hunk_get_orig_commit_id/@. Line numbers start at 1.
blameHunkGetOrigStartLineNumber ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BlameHunk
    -- ^ /@blameHunk@/: a t'GI.Ggit.Structs.BlameHunk.BlameHunk'.
    -> m Word16
    -- ^ __Returns:__ the orig hunk line number.
blameHunkGetOrigStartLineNumber :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BlameHunk -> m Word16
blameHunkGetOrigStartLineNumber BlameHunk
blameHunk = 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 BlameHunk
blameHunk' <- BlameHunk -> IO (Ptr BlameHunk)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BlameHunk
blameHunk
    Word16
result <- Ptr BlameHunk -> IO Word16
ggit_blame_hunk_get_orig_start_line_number Ptr BlameHunk
blameHunk'
    BlameHunk -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BlameHunk
blameHunk
    Word16 -> IO Word16
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result

#if defined(ENABLE_OVERLOADING)
data BlameHunkGetOrigStartLineNumberMethodInfo
instance (signature ~ (m Word16), MonadIO m) => O.OverloadedMethod BlameHunkGetOrigStartLineNumberMethodInfo BlameHunk signature where
    overloadedMethod = blameHunkGetOrigStartLineNumber

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


#endif

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

foreign import ccall "ggit_blame_hunk_is_boundary" ggit_blame_hunk_is_boundary :: 
    Ptr BlameHunk ->                        -- blame_hunk : TInterface (Name {namespace = "Ggit", name = "BlameHunk"})
    IO CInt

-- | Get whether the hunk has been tracked to a boundary commit (the root,
-- or the commit specified in @/ggit_blame_options_set_oldest_commit/@).
blameHunkIsBoundary ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BlameHunk
    -- ^ /@blameHunk@/: a t'GI.Ggit.Structs.BlameHunk.BlameHunk'.
    -> m Bool
    -- ^ __Returns:__ whether the hunk is at a boundary commit.
blameHunkIsBoundary :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BlameHunk -> m Bool
blameHunkIsBoundary BlameHunk
blameHunk = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BlameHunk
blameHunk' <- BlameHunk -> IO (Ptr BlameHunk)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BlameHunk
blameHunk
    CInt
result <- Ptr BlameHunk -> IO CInt
ggit_blame_hunk_is_boundary Ptr BlameHunk
blameHunk'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BlameHunk -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BlameHunk
blameHunk
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BlameHunkIsBoundaryMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod BlameHunkIsBoundaryMethodInfo BlameHunk signature where
    overloadedMethod = blameHunkIsBoundary

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


#endif

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

foreign import ccall "ggit_blame_hunk_ref" ggit_blame_hunk_ref :: 
    Ptr BlameHunk ->                        -- blame_hunk : TInterface (Name {namespace = "Ggit", name = "BlameHunk"})
    IO (Ptr BlameHunk)

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

#if defined(ENABLE_OVERLOADING)
data BlameHunkRefMethodInfo
instance (signature ~ (m (Maybe BlameHunk)), MonadIO m) => O.OverloadedMethod BlameHunkRefMethodInfo BlameHunk signature where
    overloadedMethod = blameHunkRef

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


#endif

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

foreign import ccall "ggit_blame_hunk_unref" ggit_blame_hunk_unref :: 
    Ptr BlameHunk ->                        -- blame_hunk : TInterface (Name {namespace = "Ggit", name = "BlameHunk"})
    IO ()

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

#if defined(ENABLE_OVERLOADING)
data BlameHunkUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod BlameHunkUnrefMethodInfo BlameHunk signature where
    overloadedMethod = blameHunkUnref

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


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveBlameHunkMethod (t :: Symbol) (o :: *) :: * where
    ResolveBlameHunkMethod "isBoundary" o = BlameHunkIsBoundaryMethodInfo
    ResolveBlameHunkMethod "ref" o = BlameHunkRefMethodInfo
    ResolveBlameHunkMethod "unref" o = BlameHunkUnrefMethodInfo
    ResolveBlameHunkMethod "getFinalCommitId" o = BlameHunkGetFinalCommitIdMethodInfo
    ResolveBlameHunkMethod "getFinalSignature" o = BlameHunkGetFinalSignatureMethodInfo
    ResolveBlameHunkMethod "getFinalStartLineNumber" o = BlameHunkGetFinalStartLineNumberMethodInfo
    ResolveBlameHunkMethod "getLinesInHunk" o = BlameHunkGetLinesInHunkMethodInfo
    ResolveBlameHunkMethod "getOrigCommitId" o = BlameHunkGetOrigCommitIdMethodInfo
    ResolveBlameHunkMethod "getOrigPath" o = BlameHunkGetOrigPathMethodInfo
    ResolveBlameHunkMethod "getOrigSignature" o = BlameHunkGetOrigSignatureMethodInfo
    ResolveBlameHunkMethod "getOrigStartLineNumber" o = BlameHunkGetOrigStartLineNumberMethodInfo
    ResolveBlameHunkMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif