{-# 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 rebase object.

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

module GI.Ggit.Objects.Rebase
    ( 

-- * Exported types
    Rebase(..)                              ,
    IsRebase                                ,
    toRebase                                ,
    noRebase                                ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveRebaseMethod                     ,
#endif


-- ** abort #method:abort#

#if defined(ENABLE_OVERLOADING)
    RebaseAbortMethodInfo                   ,
#endif
    rebaseAbort                             ,


-- ** commit #method:commit#

#if defined(ENABLE_OVERLOADING)
    RebaseCommitMethodInfo                  ,
#endif
    rebaseCommit                            ,


-- ** finish #method:finish#

#if defined(ENABLE_OVERLOADING)
    RebaseFinishMethodInfo                  ,
#endif
    rebaseFinish                            ,


-- ** getOperationByIndex #method:getOperationByIndex#

#if defined(ENABLE_OVERLOADING)
    RebaseGetOperationByIndexMethodInfo     ,
#endif
    rebaseGetOperationByIndex               ,


-- ** getOperationEntryCount #method:getOperationEntryCount#

#if defined(ENABLE_OVERLOADING)
    RebaseGetOperationEntryCountMethodInfo  ,
#endif
    rebaseGetOperationEntryCount            ,


-- ** getOperationIndex #method:getOperationIndex#

#if defined(ENABLE_OVERLOADING)
    RebaseGetOperationIndexMethodInfo       ,
#endif
    rebaseGetOperationIndex                 ,


-- ** next #method:next#

#if defined(ENABLE_OVERLOADING)
    RebaseNextMethodInfo                    ,
#endif
    rebaseNext                              ,




    ) 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.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 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 GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Ggit.Objects.Native as Ggit.Native
import {-# SOURCE #-} qualified GI.Ggit.Objects.ObjectFactoryBase as Ggit.ObjectFactoryBase
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.RebaseOperation as Ggit.RebaseOperation

-- | Memory-managed wrapper type.
newtype Rebase = Rebase (ManagedPtr Rebase)
    deriving (Rebase -> Rebase -> Bool
(Rebase -> Rebase -> Bool)
-> (Rebase -> Rebase -> Bool) -> Eq Rebase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rebase -> Rebase -> Bool
$c/= :: Rebase -> Rebase -> Bool
== :: Rebase -> Rebase -> Bool
$c== :: Rebase -> Rebase -> Bool
Eq)
foreign import ccall "ggit_rebase_get_type"
    c_ggit_rebase_get_type :: IO GType

instance GObject Rebase where
    gobjectType :: IO GType
gobjectType = IO GType
c_ggit_rebase_get_type
    

-- | Convert 'Rebase' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Rebase where
    toGValue :: Rebase -> IO GValue
toGValue o :: Rebase
o = do
        GType
gtype <- IO GType
c_ggit_rebase_get_type
        Rebase -> (Ptr Rebase -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Rebase
o (GType -> (GValue -> Ptr Rebase -> IO ()) -> Ptr Rebase -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Rebase -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO Rebase
fromGValue gv :: GValue
gv = do
        Ptr Rebase
ptr <- GValue -> IO (Ptr Rebase)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr Rebase)
        (ManagedPtr Rebase -> Rebase) -> Ptr Rebase -> IO Rebase
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Rebase -> Rebase
Rebase Ptr Rebase
ptr
        
    

-- | Type class for types which can be safely cast to `Rebase`, for instance with `toRebase`.
class (GObject o, O.IsDescendantOf Rebase o) => IsRebase o
instance (GObject o, O.IsDescendantOf Rebase o) => IsRebase o

instance O.HasParentTypes Rebase
type instance O.ParentTypes Rebase = '[Ggit.Native.Native, Ggit.ObjectFactoryBase.ObjectFactoryBase, GObject.Object.Object]

-- | Cast to `Rebase`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toRebase :: (MonadIO m, IsRebase o) => o -> m Rebase
toRebase :: o -> m Rebase
toRebase = IO Rebase -> m Rebase
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Rebase -> m Rebase) -> (o -> IO Rebase) -> o -> m Rebase
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Rebase -> Rebase) -> o -> IO Rebase
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr Rebase -> Rebase
Rebase

-- | A convenience alias for `Nothing` :: `Maybe` `Rebase`.
noRebase :: Maybe Rebase
noRebase :: Maybe Rebase
noRebase = Maybe Rebase
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveRebaseMethod (t :: Symbol) (o :: *) :: * where
    ResolveRebaseMethod "abort" o = RebaseAbortMethodInfo
    ResolveRebaseMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveRebaseMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveRebaseMethod "commit" o = RebaseCommitMethodInfo
    ResolveRebaseMethod "finish" o = RebaseFinishMethodInfo
    ResolveRebaseMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveRebaseMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveRebaseMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveRebaseMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveRebaseMethod "next" o = RebaseNextMethodInfo
    ResolveRebaseMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveRebaseMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveRebaseMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveRebaseMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveRebaseMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveRebaseMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveRebaseMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveRebaseMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveRebaseMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveRebaseMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveRebaseMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveRebaseMethod "getOperationByIndex" o = RebaseGetOperationByIndexMethodInfo
    ResolveRebaseMethod "getOperationEntryCount" o = RebaseGetOperationEntryCountMethodInfo
    ResolveRebaseMethod "getOperationIndex" o = RebaseGetOperationIndexMethodInfo
    ResolveRebaseMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveRebaseMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveRebaseMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveRebaseMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveRebaseMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveRebaseMethod l o = O.MethodResolutionFailed l o

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Rebase
type instance O.AttributeList Rebase = RebaseAttributeList
type RebaseAttributeList = ('[ '("native", Ggit.Native.NativeNativePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Rebase = RebaseSignalList
type RebaseSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

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

foreign import ccall "ggit_rebase_abort" ggit_rebase_abort :: 
    Ptr Rebase ->                           -- rebase : TInterface (Name {namespace = "Ggit", name = "Rebase"})
    Ptr (Ptr GError) ->                     -- error
    IO ()

-- | Aborts a rebase that is currently in progress, resetting the repository
-- and working directory to their state before rebase began.
rebaseAbort ::
    (B.CallStack.HasCallStack, MonadIO m, IsRebase a) =>
    a
    -- ^ /@rebase@/: a t'GI.Ggit.Objects.Rebase.Rebase'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
rebaseAbort :: a -> m ()
rebaseAbort rebase :: a
rebase = 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 Rebase
rebase' <- a -> IO (Ptr Rebase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
rebase
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        (Ptr (Ptr GError) -> IO ()) -> IO ()
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO ()) -> IO ())
-> (Ptr (Ptr GError) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Rebase -> Ptr (Ptr GError) -> IO ()
ggit_rebase_abort Ptr Rebase
rebase'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
rebase
        () -> 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 RebaseAbortMethodInfo
instance (signature ~ (m ()), MonadIO m, IsRebase a) => O.MethodInfo RebaseAbortMethodInfo a signature where
    overloadedMethod = rebaseAbort

#endif

-- method Rebase::commit
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rebase"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Rebase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitRebase." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "author"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Signature" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GgitSignature or %NULL to keep the author from\nthe original commit."
--                 , 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 = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the message for this commit, or %NULL to use\nthe message from the original commit."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Ggit" , name = "OId" })
-- throws : True
-- Skip return : False

foreign import ccall "ggit_rebase_commit" ggit_rebase_commit :: 
    Ptr Rebase ->                           -- rebase : TInterface (Name {namespace = "Ggit", name = "Rebase"})
    Ptr Ggit.Signature.Signature ->         -- author : TInterface (Name {namespace = "Ggit", name = "Signature"})
    Ptr Ggit.Signature.Signature ->         -- committer : TInterface (Name {namespace = "Ggit", name = "Signature"})
    CString ->                              -- message : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Ggit.OId.OId)

-- | Commits the current patch.  You must have resolved any conflicts that
-- were introduced during the patch application from the 'GI.Ggit.Objects.Rebase.rebaseNext'
-- invocation.
rebaseCommit ::
    (B.CallStack.HasCallStack, MonadIO m, IsRebase a, Ggit.Signature.IsSignature b, Ggit.Signature.IsSignature c) =>
    a
    -- ^ /@rebase@/: a t'GI.Ggit.Objects.Rebase.Rebase'.
    -> Maybe (b)
    -- ^ /@author@/: a t'GI.Ggit.Objects.Signature.Signature' or 'P.Nothing' to keep the author from
    -- the original commit.
    -> c
    -- ^ /@committer@/: a t'GI.Ggit.Objects.Signature.Signature'.
    -> Maybe (T.Text)
    -- ^ /@message@/: the message for this commit, or 'P.Nothing' to use
    -- the message from the original commit.
    -> m (Maybe Ggit.OId.OId)
    -- ^ __Returns:__ a t'GI.Ggit.Structs.OId.OId' of the newly created commit or 'P.Nothing'. /(Can throw 'Data.GI.Base.GError.GError')/
rebaseCommit :: a -> Maybe b -> c -> Maybe Text -> m (Maybe OId)
rebaseCommit rebase :: a
rebase author :: Maybe b
author committer :: c
committer message :: Maybe Text
message = 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 Rebase
rebase' <- a -> IO (Ptr Rebase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
rebase
    Ptr Signature
maybeAuthor <- case Maybe b
author of
        Nothing -> Ptr Signature -> IO (Ptr Signature)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Signature
forall a. Ptr a
nullPtr
        Just jAuthor :: b
jAuthor -> do
            Ptr Signature
jAuthor' <- b -> IO (Ptr Signature)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jAuthor
            Ptr Signature -> IO (Ptr Signature)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Signature
jAuthor'
    Ptr Signature
committer' <- c -> IO (Ptr Signature)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
committer
    Ptr CChar
maybeMessage <- case Maybe Text
message of
        Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just jMessage :: Text
jMessage -> do
            Ptr CChar
jMessage' <- Text -> IO (Ptr CChar)
textToCString Text
jMessage
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jMessage'
    IO (Maybe OId) -> IO () -> IO (Maybe OId)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr OId
result <- (Ptr (Ptr GError) -> IO (Ptr OId)) -> IO (Ptr OId)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr OId)) -> IO (Ptr OId))
-> (Ptr (Ptr GError) -> IO (Ptr OId)) -> IO (Ptr OId)
forall a b. (a -> b) -> a -> b
$ Ptr Rebase
-> Ptr Signature
-> Ptr Signature
-> Ptr CChar
-> Ptr (Ptr GError)
-> IO (Ptr OId)
ggit_rebase_commit Ptr Rebase
rebase' Ptr Signature
maybeAuthor Ptr Signature
committer' Ptr CChar
maybeMessage
        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
$ \result' :: Ptr OId
result' -> do
            OId
result'' <- ((ManagedPtr OId -> OId) -> Ptr OId -> IO OId
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr OId -> OId
Ggit.OId.OId) Ptr OId
result'
            OId -> IO OId
forall (m :: * -> *) a. Monad m => a -> m a
return OId
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
rebase
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
author b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
committer
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeMessage
        Maybe OId -> IO (Maybe OId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe OId
maybeResult
     ) (do
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeMessage
     )

#if defined(ENABLE_OVERLOADING)
data RebaseCommitMethodInfo
instance (signature ~ (Maybe (b) -> c -> Maybe (T.Text) -> m (Maybe Ggit.OId.OId)), MonadIO m, IsRebase a, Ggit.Signature.IsSignature b, Ggit.Signature.IsSignature c) => O.MethodInfo RebaseCommitMethodInfo a signature where
    overloadedMethod = rebaseCommit

#endif

-- method Rebase::finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rebase"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Rebase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitRebase." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "signature"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Signature" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the identity that is finishing the rebase or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : True
-- Skip return : False

foreign import ccall "ggit_rebase_finish" ggit_rebase_finish :: 
    Ptr Rebase ->                           -- rebase : TInterface (Name {namespace = "Ggit", name = "Rebase"})
    Ptr Ggit.Signature.Signature ->         -- signature : TInterface (Name {namespace = "Ggit", name = "Signature"})
    Ptr (Ptr GError) ->                     -- error
    IO ()

-- | Finishes a rebase that is currently in progress once all patches have
-- been applied.
rebaseFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsRebase a, Ggit.Signature.IsSignature b) =>
    a
    -- ^ /@rebase@/: a t'GI.Ggit.Objects.Rebase.Rebase'.
    -> Maybe (b)
    -- ^ /@signature@/: the identity that is finishing the rebase or 'P.Nothing'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
rebaseFinish :: a -> Maybe b -> m ()
rebaseFinish rebase :: a
rebase signature :: Maybe b
signature = 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 Rebase
rebase' <- a -> IO (Ptr Rebase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
rebase
    Ptr Signature
maybeSignature <- case Maybe b
signature of
        Nothing -> Ptr Signature -> IO (Ptr Signature)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Signature
forall a. Ptr a
nullPtr
        Just jSignature :: b
jSignature -> do
            Ptr Signature
jSignature' <- b -> IO (Ptr Signature)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jSignature
            Ptr Signature -> IO (Ptr Signature)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Signature
jSignature'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        (Ptr (Ptr GError) -> IO ()) -> IO ()
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO ()) -> IO ())
-> (Ptr (Ptr GError) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Rebase -> Ptr Signature -> Ptr (Ptr GError) -> IO ()
ggit_rebase_finish Ptr Rebase
rebase' Ptr Signature
maybeSignature
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
rebase
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
signature b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> 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 RebaseFinishMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsRebase a, Ggit.Signature.IsSignature b) => O.MethodInfo RebaseFinishMethodInfo a signature where
    overloadedMethod = rebaseFinish

#endif

-- method Rebase::get_operation_by_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rebase"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Rebase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitRebase." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "idx"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The index of the rebase operation to retrieve."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Ggit" , name = "RebaseOperation" })
-- throws : False
-- Skip return : False

foreign import ccall "ggit_rebase_get_operation_by_index" ggit_rebase_get_operation_by_index :: 
    Ptr Rebase ->                           -- rebase : TInterface (Name {namespace = "Ggit", name = "Rebase"})
    Word64 ->                               -- idx : TBasicType TUInt64
    IO (Ptr Ggit.RebaseOperation.RebaseOperation)

-- | Gets the rebase operation specified by /@idx@/.
rebaseGetOperationByIndex ::
    (B.CallStack.HasCallStack, MonadIO m, IsRebase a) =>
    a
    -- ^ /@rebase@/: a t'GI.Ggit.Objects.Rebase.Rebase'.
    -> Word64
    -- ^ /@idx@/: The index of the rebase operation to retrieve.
    -> m (Maybe Ggit.RebaseOperation.RebaseOperation)
    -- ^ __Returns:__ The rebase operation or 'P.Nothing' if /@idx@/ was out of bounds.
rebaseGetOperationByIndex :: a -> Word64 -> m (Maybe RebaseOperation)
rebaseGetOperationByIndex rebase :: a
rebase idx :: Word64
idx = IO (Maybe RebaseOperation) -> m (Maybe RebaseOperation)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe RebaseOperation) -> m (Maybe RebaseOperation))
-> IO (Maybe RebaseOperation) -> m (Maybe RebaseOperation)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Rebase
rebase' <- a -> IO (Ptr Rebase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
rebase
    Ptr RebaseOperation
result <- Ptr Rebase -> Word64 -> IO (Ptr RebaseOperation)
ggit_rebase_get_operation_by_index Ptr Rebase
rebase' Word64
idx
    Maybe RebaseOperation
maybeResult <- Ptr RebaseOperation
-> (Ptr RebaseOperation -> IO RebaseOperation)
-> IO (Maybe RebaseOperation)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr RebaseOperation
result ((Ptr RebaseOperation -> IO RebaseOperation)
 -> IO (Maybe RebaseOperation))
-> (Ptr RebaseOperation -> IO RebaseOperation)
-> IO (Maybe RebaseOperation)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr RebaseOperation
result' -> do
        RebaseOperation
result'' <- ((ManagedPtr RebaseOperation -> RebaseOperation)
-> Ptr RebaseOperation -> IO RebaseOperation
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr RebaseOperation -> RebaseOperation
Ggit.RebaseOperation.RebaseOperation) Ptr RebaseOperation
result'
        RebaseOperation -> IO RebaseOperation
forall (m :: * -> *) a. Monad m => a -> m a
return RebaseOperation
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
rebase
    Maybe RebaseOperation -> IO (Maybe RebaseOperation)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RebaseOperation
maybeResult

#if defined(ENABLE_OVERLOADING)
data RebaseGetOperationByIndexMethodInfo
instance (signature ~ (Word64 -> m (Maybe Ggit.RebaseOperation.RebaseOperation)), MonadIO m, IsRebase a) => O.MethodInfo RebaseGetOperationByIndexMethodInfo a signature where
    overloadedMethod = rebaseGetOperationByIndex

#endif

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

foreign import ccall "ggit_rebase_get_operation_entry_count" ggit_rebase_get_operation_entry_count :: 
    Ptr Rebase ->                           -- rebase : TInterface (Name {namespace = "Ggit", name = "Rebase"})
    IO Word64

-- | Gets the count of rebase operations that are to be applied.
rebaseGetOperationEntryCount ::
    (B.CallStack.HasCallStack, MonadIO m, IsRebase a) =>
    a
    -- ^ /@rebase@/: a t'GI.Ggit.Objects.Rebase.Rebase'.
    -> m Word64
    -- ^ __Returns:__ the count of rebase operations that are to be applied.
rebaseGetOperationEntryCount :: a -> m Word64
rebaseGetOperationEntryCount rebase :: a
rebase = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Rebase
rebase' <- a -> IO (Ptr Rebase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
rebase
    Word64
result <- Ptr Rebase -> IO Word64
ggit_rebase_get_operation_entry_count Ptr Rebase
rebase'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
rebase
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data RebaseGetOperationEntryCountMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsRebase a) => O.MethodInfo RebaseGetOperationEntryCountMethodInfo a signature where
    overloadedMethod = rebaseGetOperationEntryCount

#endif

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

foreign import ccall "ggit_rebase_get_operation_index" ggit_rebase_get_operation_index :: 
    Ptr Rebase ->                           -- rebase : TInterface (Name {namespace = "Ggit", name = "Rebase"})
    IO Word64

-- | Gets the index of the rebase operation that is currently being applied.
-- If the first operation has not yet been applied (because you have
-- called 'GI.Ggit.Objects.Repository.repositoryRebaseInit' but not yet 'GI.Ggit.Objects.Rebase.rebaseNext')
-- then this returns /@gGITREBASENOOPERATION@/.
rebaseGetOperationIndex ::
    (B.CallStack.HasCallStack, MonadIO m, IsRebase a) =>
    a
    -- ^ /@rebase@/: a t'GI.Ggit.Objects.Rebase.Rebase'.
    -> m Word64
    -- ^ __Returns:__ The index of the rebase operation currently being applied.
rebaseGetOperationIndex :: a -> m Word64
rebaseGetOperationIndex rebase :: a
rebase = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Rebase
rebase' <- a -> IO (Ptr Rebase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
rebase
    Word64
result <- Ptr Rebase -> IO Word64
ggit_rebase_get_operation_index Ptr Rebase
rebase'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
rebase
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data RebaseGetOperationIndexMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsRebase a) => O.MethodInfo RebaseGetOperationIndexMethodInfo a signature where
    overloadedMethod = rebaseGetOperationIndex

#endif

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

foreign import ccall "ggit_rebase_next" ggit_rebase_next :: 
    Ptr Rebase ->                           -- rebase : TInterface (Name {namespace = "Ggit", name = "Rebase"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Ggit.RebaseOperation.RebaseOperation)

-- | Performs the next rebase operation and returns the information about it.
-- If the operation is one that applies a patch (which is any operation except
-- /@gGITREBASEOPERATIONEXEC@/) then the patch will be applied and the index and
-- working directory will be updated with the changes. If there are conflicts,
-- you will need to address those before committing the changes.
rebaseNext ::
    (B.CallStack.HasCallStack, MonadIO m, IsRebase a) =>
    a
    -- ^ /@rebase@/: a t'GI.Ggit.Objects.Rebase.Rebase'.
    -> m (Maybe Ggit.RebaseOperation.RebaseOperation)
    -- ^ __Returns:__ the rebase operation that is to be performed next or 'P.Nothing'. /(Can throw 'Data.GI.Base.GError.GError')/
rebaseNext :: a -> m (Maybe RebaseOperation)
rebaseNext rebase :: a
rebase = IO (Maybe RebaseOperation) -> m (Maybe RebaseOperation)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe RebaseOperation) -> m (Maybe RebaseOperation))
-> IO (Maybe RebaseOperation) -> m (Maybe RebaseOperation)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Rebase
rebase' <- a -> IO (Ptr Rebase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
rebase
    IO (Maybe RebaseOperation) -> IO () -> IO (Maybe RebaseOperation)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr RebaseOperation
result <- (Ptr (Ptr GError) -> IO (Ptr RebaseOperation))
-> IO (Ptr RebaseOperation)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr RebaseOperation))
 -> IO (Ptr RebaseOperation))
-> (Ptr (Ptr GError) -> IO (Ptr RebaseOperation))
-> IO (Ptr RebaseOperation)
forall a b. (a -> b) -> a -> b
$ Ptr Rebase -> Ptr (Ptr GError) -> IO (Ptr RebaseOperation)
ggit_rebase_next Ptr Rebase
rebase'
        Maybe RebaseOperation
maybeResult <- Ptr RebaseOperation
-> (Ptr RebaseOperation -> IO RebaseOperation)
-> IO (Maybe RebaseOperation)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr RebaseOperation
result ((Ptr RebaseOperation -> IO RebaseOperation)
 -> IO (Maybe RebaseOperation))
-> (Ptr RebaseOperation -> IO RebaseOperation)
-> IO (Maybe RebaseOperation)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr RebaseOperation
result' -> do
            RebaseOperation
result'' <- ((ManagedPtr RebaseOperation -> RebaseOperation)
-> Ptr RebaseOperation -> IO RebaseOperation
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr RebaseOperation -> RebaseOperation
Ggit.RebaseOperation.RebaseOperation) Ptr RebaseOperation
result'
            RebaseOperation -> IO RebaseOperation
forall (m :: * -> *) a. Monad m => a -> m a
return RebaseOperation
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
rebase
        Maybe RebaseOperation -> IO (Maybe RebaseOperation)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RebaseOperation
maybeResult
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data RebaseNextMethodInfo
instance (signature ~ (m (Maybe Ggit.RebaseOperation.RebaseOperation)), MonadIO m, IsRebase a) => O.MethodInfo RebaseNextMethodInfo a signature where
    overloadedMethod = rebaseNext

#endif