{-# LANGUAGE TypeApplications #-}


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

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

module GI.Ggit.Structs.Reflog
    ( 

-- * Exported types
    Reflog(..)                              ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveReflogMethod                     ,
#endif


-- ** append #method:append#

#if defined(ENABLE_OVERLOADING)
    ReflogAppendMethodInfo                  ,
#endif
    reflogAppend                            ,


-- ** getEntryCount #method:getEntryCount#

#if defined(ENABLE_OVERLOADING)
    ReflogGetEntryCountMethodInfo           ,
#endif
    reflogGetEntryCount                     ,


-- ** getEntryFromIndex #method:getEntryFromIndex#

#if defined(ENABLE_OVERLOADING)
    ReflogGetEntryFromIndexMethodInfo       ,
#endif
    reflogGetEntryFromIndex                 ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    ReflogRefMethodInfo                     ,
#endif
    reflogRef                               ,


-- ** rename #method:rename#

#if defined(ENABLE_OVERLOADING)
    ReflogRenameMethodInfo                  ,
#endif
    reflogRename                            ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    ReflogUnrefMethodInfo                   ,
#endif
    reflogUnref                             ,


-- ** write #method:write#

#if defined(ENABLE_OVERLOADING)
    ReflogWriteMethodInfo                   ,
#endif
    reflogWrite                             ,




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

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

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

foreign import ccall "ggit_reflog_get_type" c_ggit_reflog_get_type :: 
    IO GType

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

instance B.Types.TypedObject Reflog where
    glibType :: IO GType
glibType = IO GType
c_ggit_reflog_get_type

instance B.Types.GBoxed Reflog

-- | Convert 'Reflog' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Reflog where
    toGValue :: Reflog -> IO GValue
toGValue Reflog
o = do
        GType
gtype <- IO GType
c_ggit_reflog_get_type
        Reflog -> (Ptr Reflog -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Reflog
o (GType -> (GValue -> Ptr Reflog -> IO ()) -> Ptr Reflog -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Reflog -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO Reflog
fromGValue GValue
gv = do
        Ptr Reflog
ptr <- GValue -> IO (Ptr Reflog)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr Reflog)
        (ManagedPtr Reflog -> Reflog) -> Ptr Reflog -> IO Reflog
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Reflog -> Reflog
Reflog Ptr Reflog
ptr
        
    


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

-- method Reflog::append
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reflog"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Reflog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitReflog." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "oid"
--           , argType = TInterface Name { namespace = "Ggit" , name = "OId" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitOId." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "committer"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Signature" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitSignature." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "message"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the message." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ggit_reflog_append" ggit_reflog_append :: 
    Ptr Reflog ->                           -- reflog : TInterface (Name {namespace = "Ggit", name = "Reflog"})
    Ptr Ggit.OId.OId ->                     -- oid : TInterface (Name {namespace = "Ggit", name = "OId"})
    Ptr Ggit.Signature.Signature ->         -- committer : TInterface (Name {namespace = "Ggit", name = "Signature"})
    CString ->                              -- message : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Creates a reflog entry.
reflogAppend ::
    (B.CallStack.HasCallStack, MonadIO m, Ggit.Signature.IsSignature a) =>
    Reflog
    -- ^ /@reflog@/: a t'GI.Ggit.Structs.Reflog.Reflog'.
    -> Ggit.OId.OId
    -- ^ /@oid@/: a t'GI.Ggit.Structs.OId.OId'.
    -> a
    -- ^ /@committer@/: a t'GI.Ggit.Objects.Signature.Signature'.
    -> T.Text
    -- ^ /@message@/: the message.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
reflogAppend :: Reflog -> OId -> a -> Text -> m ()
reflogAppend Reflog
reflog OId
oid a
committer Text
message = 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 Reflog
reflog' <- Reflog -> IO (Ptr Reflog)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Reflog
reflog
    Ptr OId
oid' <- OId -> IO (Ptr OId)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr OId
oid
    Ptr Signature
committer' <- a -> IO (Ptr Signature)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
committer
    CString
message' <- Text -> IO CString
textToCString Text
message
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Reflog
-> Ptr OId
-> Ptr Signature
-> CString
-> Ptr (Ptr GError)
-> IO CInt
ggit_reflog_append Ptr Reflog
reflog' Ptr OId
oid' Ptr Signature
committer' CString
message'
        Reflog -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Reflog
reflog
        OId -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr OId
oid
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
committer
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
message'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
message'
     )

#if defined(ENABLE_OVERLOADING)
data ReflogAppendMethodInfo
instance (signature ~ (Ggit.OId.OId -> a -> T.Text -> m ()), MonadIO m, Ggit.Signature.IsSignature a) => O.MethodInfo ReflogAppendMethodInfo Reflog signature where
    overloadedMethod = reflogAppend

#endif

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

foreign import ccall "ggit_reflog_get_entry_count" ggit_reflog_get_entry_count :: 
    Ptr Reflog ->                           -- reflog : TInterface (Name {namespace = "Ggit", name = "Reflog"})
    IO Word32

-- | Gets the number of log entries in /@reflog@/.
reflogGetEntryCount ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Reflog
    -- ^ /@reflog@/: a t'GI.Ggit.Structs.Reflog.Reflog'.
    -> m Word32
    -- ^ __Returns:__ the number of log entries.
reflogGetEntryCount :: Reflog -> m Word32
reflogGetEntryCount Reflog
reflog = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Reflog
reflog' <- Reflog -> IO (Ptr Reflog)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Reflog
reflog
    Word32
result <- Ptr Reflog -> IO Word32
ggit_reflog_get_entry_count Ptr Reflog
reflog'
    Reflog -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Reflog
reflog
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data ReflogGetEntryCountMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo ReflogGetEntryCountMethodInfo Reflog signature where
    overloadedMethod = reflogGetEntryCount

#endif

-- method Reflog::get_entry_from_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reflog"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Reflog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitReflog." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "idx"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the position to lookup."
--                 , 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_get_entry_from_index" ggit_reflog_get_entry_from_index :: 
    Ptr Reflog ->                           -- reflog : TInterface (Name {namespace = "Ggit", name = "Reflog"})
    Word32 ->                               -- idx : TBasicType TUInt
    IO (Ptr Ggit.ReflogEntry.ReflogEntry)

-- | Gets the t'GI.Ggit.Structs.ReflogEntry.ReflogEntry' at /@idx@/ in /@reflog@/, or 'P.Nothing' if not found.
reflogGetEntryFromIndex ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Reflog
    -- ^ /@reflog@/: a t'GI.Ggit.Structs.Reflog.Reflog'.
    -> Word32
    -- ^ /@idx@/: the position to lookup.
    -> m (Maybe Ggit.ReflogEntry.ReflogEntry)
    -- ^ __Returns:__ the reflog entry at the index, or 'P.Nothing' if not found.
reflogGetEntryFromIndex :: Reflog -> Word32 -> m (Maybe ReflogEntry)
reflogGetEntryFromIndex Reflog
reflog Word32
idx = IO (Maybe ReflogEntry) -> m (Maybe ReflogEntry)
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 Reflog
reflog' <- Reflog -> IO (Ptr Reflog)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Reflog
reflog
    Ptr ReflogEntry
result <- Ptr Reflog -> Word32 -> IO (Ptr ReflogEntry)
ggit_reflog_get_entry_from_index Ptr Reflog
reflog' Word32
idx
    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
wrapBoxed ManagedPtr ReflogEntry -> ReflogEntry
Ggit.ReflogEntry.ReflogEntry) Ptr ReflogEntry
result'
        ReflogEntry -> IO ReflogEntry
forall (m :: * -> *) a. Monad m => a -> m a
return ReflogEntry
result''
    Reflog -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Reflog
reflog
    Maybe ReflogEntry -> IO (Maybe ReflogEntry)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ReflogEntry
maybeResult

#if defined(ENABLE_OVERLOADING)
data ReflogGetEntryFromIndexMethodInfo
instance (signature ~ (Word32 -> m (Maybe Ggit.ReflogEntry.ReflogEntry)), MonadIO m) => O.MethodInfo ReflogGetEntryFromIndexMethodInfo Reflog signature where
    overloadedMethod = reflogGetEntryFromIndex

#endif

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

foreign import ccall "ggit_reflog_ref" ggit_reflog_ref :: 
    Ptr Reflog ->                           -- reflog : TInterface (Name {namespace = "Ggit", name = "Reflog"})
    IO (Ptr Reflog)

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

#if defined(ENABLE_OVERLOADING)
data ReflogRefMethodInfo
instance (signature ~ (m (Maybe Reflog)), MonadIO m) => O.MethodInfo ReflogRefMethodInfo Reflog signature where
    overloadedMethod = reflogRef

#endif

-- method Reflog::rename
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reflog"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Reflog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitReflog." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "new_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new name of the reference."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ggit_reflog_rename" ggit_reflog_rename :: 
    Ptr Reflog ->                           -- reflog : TInterface (Name {namespace = "Ggit", name = "Reflog"})
    CString ->                              -- new_name : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Renames the reflog for to /@newName@/, on error /@error@/ is set.
reflogRename ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Reflog
    -- ^ /@reflog@/: a t'GI.Ggit.Structs.Reflog.Reflog'.
    -> T.Text
    -- ^ /@newName@/: the new name of the reference.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
reflogRename :: Reflog -> Text -> m ()
reflogRename Reflog
reflog Text
newName = 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 Reflog
reflog' <- Reflog -> IO (Ptr Reflog)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Reflog
reflog
    CString
newName' <- Text -> IO CString
textToCString Text
newName
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Reflog -> CString -> Ptr (Ptr GError) -> IO CInt
ggit_reflog_rename Ptr Reflog
reflog' CString
newName'
        Reflog -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Reflog
reflog
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
newName'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
newName'
     )

#if defined(ENABLE_OVERLOADING)
data ReflogRenameMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.MethodInfo ReflogRenameMethodInfo Reflog signature where
    overloadedMethod = reflogRename

#endif

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

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

#if defined(ENABLE_OVERLOADING)
data ReflogUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo ReflogUnrefMethodInfo Reflog signature where
    overloadedMethod = reflogUnref

#endif

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

foreign import ccall "ggit_reflog_write" ggit_reflog_write :: 
    Ptr Reflog ->                           -- reflog : TInterface (Name {namespace = "Ggit", name = "Reflog"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Write the reflog to disk.
reflogWrite ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Reflog
    -- ^ /@reflog@/: a t'GI.Ggit.Structs.Reflog.Reflog'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
reflogWrite :: Reflog -> m ()
reflogWrite Reflog
reflog = 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 Reflog
reflog' <- Reflog -> IO (Ptr Reflog)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Reflog
reflog
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Reflog -> Ptr (Ptr GError) -> IO CInt
ggit_reflog_write Ptr Reflog
reflog'
        Reflog -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Reflog
reflog
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ReflogWriteMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo ReflogWriteMethodInfo Reflog signature where
    overloadedMethod = reflogWrite

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveReflogMethod (t :: Symbol) (o :: *) :: * where
    ResolveReflogMethod "append" o = ReflogAppendMethodInfo
    ResolveReflogMethod "ref" o = ReflogRefMethodInfo
    ResolveReflogMethod "rename" o = ReflogRenameMethodInfo
    ResolveReflogMethod "unref" o = ReflogUnrefMethodInfo
    ResolveReflogMethod "write" o = ReflogWriteMethodInfo
    ResolveReflogMethod "getEntryCount" o = ReflogGetEntryCountMethodInfo
    ResolveReflogMethod "getEntryFromIndex" o = ReflogGetEntryFromIndexMethodInfo
    ResolveReflogMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveReflogMethod t Reflog, O.MethodInfo info Reflog p) => OL.IsLabel t (Reflog -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif