{-# LANGUAGE TypeApplications #-}


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

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

module GI.Ggit.Structs.ReflogEntry
    ( 

-- * Exported types
    ReflogEntry(..)                         ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [ref]("GI.Ggit.Structs.ReflogEntry#g:method:ref"), [unref]("GI.Ggit.Structs.ReflogEntry#g:method:unref").
-- 
-- ==== Getters
-- [getCommitter]("GI.Ggit.Structs.ReflogEntry#g:method:getCommitter"), [getMessage]("GI.Ggit.Structs.ReflogEntry#g:method:getMessage"), [getNewId]("GI.Ggit.Structs.ReflogEntry#g:method:getNewId"), [getOldId]("GI.Ggit.Structs.ReflogEntry#g:method:getOldId").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveReflogEntryMethod                ,
#endif

-- ** getCommitter #method:getCommitter#

#if defined(ENABLE_OVERLOADING)
    ReflogEntryGetCommitterMethodInfo       ,
#endif
    reflogEntryGetCommitter                 ,


-- ** getMessage #method:getMessage#

#if defined(ENABLE_OVERLOADING)
    ReflogEntryGetMessageMethodInfo         ,
#endif
    reflogEntryGetMessage                   ,


-- ** getNewId #method:getNewId#

#if defined(ENABLE_OVERLOADING)
    ReflogEntryGetNewIdMethodInfo           ,
#endif
    reflogEntryGetNewId                     ,


-- ** getOldId #method:getOldId#

#if defined(ENABLE_OVERLOADING)
    ReflogEntryGetOldIdMethodInfo           ,
#endif
    reflogEntryGetOldId                     ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    ReflogEntryRefMethodInfo                ,
#endif
    reflogEntryRef                          ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    ReflogEntryUnrefMethodInfo              ,
#endif
    reflogEntryUnref                        ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.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 ReflogEntry = ReflogEntry (SP.ManagedPtr ReflogEntry)
    deriving (ReflogEntry -> ReflogEntry -> Bool
(ReflogEntry -> ReflogEntry -> Bool)
-> (ReflogEntry -> ReflogEntry -> Bool) -> Eq ReflogEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReflogEntry -> ReflogEntry -> Bool
== :: ReflogEntry -> ReflogEntry -> Bool
$c/= :: ReflogEntry -> ReflogEntry -> Bool
/= :: ReflogEntry -> ReflogEntry -> Bool
Eq)

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

foreign import ccall "ggit_reflog_entry_get_type" c_ggit_reflog_entry_get_type :: 
    IO GType

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

instance B.Types.TypedObject ReflogEntry where
    glibType :: IO GType
glibType = IO GType
c_ggit_reflog_entry_get_type

instance B.Types.GBoxed ReflogEntry

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


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

-- method ReflogEntry::get_committer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reflog_entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "ReflogEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitReflogEntry."
--                 , 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_reflog_entry_get_committer" ggit_reflog_entry_get_committer :: 
    Ptr ReflogEntry ->                      -- reflog_entry : TInterface (Name {namespace = "Ggit", name = "ReflogEntry"})
    IO (Ptr Ggit.Signature.Signature)

-- | Gets the committer as a t'GI.Ggit.Objects.Signature.Signature'.
reflogEntryGetCommitter ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ReflogEntry
    -- ^ /@reflogEntry@/: a t'GI.Ggit.Structs.ReflogEntry.ReflogEntry'.
    -> m (Maybe Ggit.Signature.Signature)
    -- ^ __Returns:__ the committer or 'P.Nothing'.
reflogEntryGetCommitter :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ReflogEntry -> m (Maybe Signature)
reflogEntryGetCommitter ReflogEntry
reflogEntry = IO (Maybe Signature) -> m (Maybe Signature)
forall a. IO a -> m a
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 ReflogEntry
reflogEntry' <- ReflogEntry -> IO (Ptr ReflogEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ReflogEntry
reflogEntry
    Ptr Signature
result <- Ptr ReflogEntry -> IO (Ptr Signature)
ggit_reflog_entry_get_committer Ptr ReflogEntry
reflogEntry'
    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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Signature
result''
    ReflogEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ReflogEntry
reflogEntry
    Maybe Signature -> IO (Maybe Signature)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Signature
maybeResult

#if defined(ENABLE_OVERLOADING)
data ReflogEntryGetCommitterMethodInfo
instance (signature ~ (m (Maybe Ggit.Signature.Signature)), MonadIO m) => O.OverloadedMethod ReflogEntryGetCommitterMethodInfo ReflogEntry signature where
    overloadedMethod = reflogEntryGetCommitter

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


#endif

-- method ReflogEntry::get_message
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reflog_entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "ReflogEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitReflogEntry."
--                 , 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_reflog_entry_get_message" ggit_reflog_entry_get_message :: 
    Ptr ReflogEntry ->                      -- reflog_entry : TInterface (Name {namespace = "Ggit", name = "ReflogEntry"})
    IO CString

-- | Gets the message.
reflogEntryGetMessage ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ReflogEntry
    -- ^ /@reflogEntry@/: a t'GI.Ggit.Structs.ReflogEntry.ReflogEntry'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the message or 'P.Nothing'.
reflogEntryGetMessage :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ReflogEntry -> m (Maybe Text)
reflogEntryGetMessage ReflogEntry
reflogEntry = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
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 ReflogEntry
reflogEntry' <- ReflogEntry -> IO (Ptr ReflogEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ReflogEntry
reflogEntry
    CString
result <- Ptr ReflogEntry -> IO CString
ggit_reflog_entry_get_message Ptr ReflogEntry
reflogEntry'
    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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    ReflogEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ReflogEntry
reflogEntry
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data ReflogEntryGetMessageMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod ReflogEntryGetMessageMethodInfo ReflogEntry signature where
    overloadedMethod = reflogEntryGetMessage

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


#endif

-- method ReflogEntry::get_new_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reflog_entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "ReflogEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitReflogEntry."
--                 , 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_reflog_entry_get_new_id" ggit_reflog_entry_get_new_id :: 
    Ptr ReflogEntry ->                      -- reflog_entry : TInterface (Name {namespace = "Ggit", name = "ReflogEntry"})
    IO (Ptr Ggit.OId.OId)

-- | Gets the new t'GI.Ggit.Structs.OId.OId'.
reflogEntryGetNewId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ReflogEntry
    -- ^ /@reflogEntry@/: a t'GI.Ggit.Structs.ReflogEntry.ReflogEntry'.
    -> m (Maybe Ggit.OId.OId)
    -- ^ __Returns:__ the new oid or 'P.Nothing'.
reflogEntryGetNewId :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ReflogEntry -> m (Maybe OId)
reflogEntryGetNewId ReflogEntry
reflogEntry = IO (Maybe OId) -> m (Maybe OId)
forall a. IO a -> m a
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 ReflogEntry
reflogEntry' <- ReflogEntry -> IO (Ptr ReflogEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ReflogEntry
reflogEntry
    Ptr OId
result <- Ptr ReflogEntry -> IO (Ptr OId)
ggit_reflog_entry_get_new_id Ptr ReflogEntry
reflogEntry'
    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
wrapBoxed ManagedPtr OId -> OId
Ggit.OId.OId) Ptr OId
result'
        OId -> IO OId
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return OId
result''
    ReflogEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ReflogEntry
reflogEntry
    Maybe OId -> IO (Maybe OId)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe OId
maybeResult

#if defined(ENABLE_OVERLOADING)
data ReflogEntryGetNewIdMethodInfo
instance (signature ~ (m (Maybe Ggit.OId.OId)), MonadIO m) => O.OverloadedMethod ReflogEntryGetNewIdMethodInfo ReflogEntry signature where
    overloadedMethod = reflogEntryGetNewId

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


#endif

-- method ReflogEntry::get_old_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reflog_entry"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "ReflogEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitReflogEntry."
--                 , 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_reflog_entry_get_old_id" ggit_reflog_entry_get_old_id :: 
    Ptr ReflogEntry ->                      -- reflog_entry : TInterface (Name {namespace = "Ggit", name = "ReflogEntry"})
    IO (Ptr Ggit.OId.OId)

-- | Gets the old t'GI.Ggit.Structs.OId.OId'.
reflogEntryGetOldId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ReflogEntry
    -- ^ /@reflogEntry@/: a t'GI.Ggit.Structs.ReflogEntry.ReflogEntry'.
    -> m (Maybe Ggit.OId.OId)
    -- ^ __Returns:__ the old oid or 'P.Nothing'.
reflogEntryGetOldId :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ReflogEntry -> m (Maybe OId)
reflogEntryGetOldId ReflogEntry
reflogEntry = IO (Maybe OId) -> m (Maybe OId)
forall a. IO a -> m a
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 ReflogEntry
reflogEntry' <- ReflogEntry -> IO (Ptr ReflogEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ReflogEntry
reflogEntry
    Ptr OId
result <- Ptr ReflogEntry -> IO (Ptr OId)
ggit_reflog_entry_get_old_id Ptr ReflogEntry
reflogEntry'
    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
wrapBoxed ManagedPtr OId -> OId
Ggit.OId.OId) Ptr OId
result'
        OId -> IO OId
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return OId
result''
    ReflogEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ReflogEntry
reflogEntry
    Maybe OId -> IO (Maybe OId)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe OId
maybeResult

#if defined(ENABLE_OVERLOADING)
data ReflogEntryGetOldIdMethodInfo
instance (signature ~ (m (Maybe Ggit.OId.OId)), MonadIO m) => O.OverloadedMethod ReflogEntryGetOldIdMethodInfo ReflogEntry signature where
    overloadedMethod = reflogEntryGetOldId

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


#endif

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

foreign import ccall "ggit_reflog_entry_ref" ggit_reflog_entry_ref :: 
    Ptr ReflogEntry ->                      -- reflog_entry : TInterface (Name {namespace = "Ggit", name = "ReflogEntry"})
    IO (Ptr ReflogEntry)

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

#if defined(ENABLE_OVERLOADING)
data ReflogEntryRefMethodInfo
instance (signature ~ (m (Maybe ReflogEntry)), MonadIO m) => O.OverloadedMethod ReflogEntryRefMethodInfo ReflogEntry signature where
    overloadedMethod = reflogEntryRef

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


#endif

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

foreign import ccall "ggit_reflog_entry_unref" ggit_reflog_entry_unref :: 
    Ptr ReflogEntry ->                      -- reflog_entry : TInterface (Name {namespace = "Ggit", name = "ReflogEntry"})
    IO ()

-- | Atomically decrements the reference count of /@reflogEntry@/ by one.
-- If the reference count drops to 0, /@reflogEntry@/ is freed.
reflogEntryUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ReflogEntry
    -- ^ /@reflogEntry@/: a t'GI.Ggit.Structs.ReflogEntry.ReflogEntry'.
    -> m ()
reflogEntryUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ReflogEntry -> m ()
reflogEntryUnref ReflogEntry
reflogEntry = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ReflogEntry
reflogEntry' <- ReflogEntry -> IO (Ptr ReflogEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ReflogEntry
reflogEntry
    Ptr ReflogEntry -> IO ()
ggit_reflog_entry_unref Ptr ReflogEntry
reflogEntry'
    ReflogEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ReflogEntry
reflogEntry
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ReflogEntryUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod ReflogEntryUnrefMethodInfo ReflogEntry signature where
    overloadedMethod = reflogEntryUnref

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


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveReflogEntryMethod (t :: Symbol) (o :: *) :: * where
    ResolveReflogEntryMethod "ref" o = ReflogEntryRefMethodInfo
    ResolveReflogEntryMethod "unref" o = ReflogEntryUnrefMethodInfo
    ResolveReflogEntryMethod "getCommitter" o = ReflogEntryGetCommitterMethodInfo
    ResolveReflogEntryMethod "getMessage" o = ReflogEntryGetMessageMethodInfo
    ResolveReflogEntryMethod "getNewId" o = ReflogEntryGetNewIdMethodInfo
    ResolveReflogEntryMethod "getOldId" o = ReflogEntryGetOldIdMethodInfo
    ResolveReflogEntryMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif