{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Represents the options used when rebasing.

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

module GI.Ggit.Structs.RebaseOptions
    ( 

-- * Exported types
    RebaseOptions(..)                       ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copy]("GI.Ggit.Structs.RebaseOptions#g:method:copy"), [free]("GI.Ggit.Structs.RebaseOptions#g:method:free").
-- 
-- ==== Getters
-- [getCheckoutOptions]("GI.Ggit.Structs.RebaseOptions#g:method:getCheckoutOptions"), [getQuiet]("GI.Ggit.Structs.RebaseOptions#g:method:getQuiet"), [getRewriteNotesRef]("GI.Ggit.Structs.RebaseOptions#g:method:getRewriteNotesRef").
-- 
-- ==== Setters
-- [setCheckoutOptions]("GI.Ggit.Structs.RebaseOptions#g:method:setCheckoutOptions"), [setQuiet]("GI.Ggit.Structs.RebaseOptions#g:method:setQuiet"), [setRewriteNotesRef]("GI.Ggit.Structs.RebaseOptions#g:method:setRewriteNotesRef").

#if defined(ENABLE_OVERLOADING)
    ResolveRebaseOptionsMethod              ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    RebaseOptionsCopyMethodInfo             ,
#endif
    rebaseOptionsCopy                       ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    RebaseOptionsFreeMethodInfo             ,
#endif
    rebaseOptionsFree                       ,


-- ** getCheckoutOptions #method:getCheckoutOptions#

#if defined(ENABLE_OVERLOADING)
    RebaseOptionsGetCheckoutOptionsMethodInfo,
#endif
    rebaseOptionsGetCheckoutOptions         ,


-- ** getQuiet #method:getQuiet#

#if defined(ENABLE_OVERLOADING)
    RebaseOptionsGetQuietMethodInfo         ,
#endif
    rebaseOptionsGetQuiet                   ,


-- ** getRewriteNotesRef #method:getRewriteNotesRef#

#if defined(ENABLE_OVERLOADING)
    RebaseOptionsGetRewriteNotesRefMethodInfo,
#endif
    rebaseOptionsGetRewriteNotesRef         ,


-- ** new #method:new#

    rebaseOptionsNew                        ,


-- ** setCheckoutOptions #method:setCheckoutOptions#

#if defined(ENABLE_OVERLOADING)
    RebaseOptionsSetCheckoutOptionsMethodInfo,
#endif
    rebaseOptionsSetCheckoutOptions         ,


-- ** setQuiet #method:setQuiet#

#if defined(ENABLE_OVERLOADING)
    RebaseOptionsSetQuietMethodInfo         ,
#endif
    rebaseOptionsSetQuiet                   ,


-- ** setRewriteNotesRef #method:setRewriteNotesRef#

#if defined(ENABLE_OVERLOADING)
    RebaseOptionsSetRewriteNotesRefMethodInfo,
#endif
    rebaseOptionsSetRewriteNotesRef         ,




    ) 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.Kind as DK
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.CheckoutOptions as Ggit.CheckoutOptions

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

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

foreign import ccall "ggit_rebase_options_get_type" c_ggit_rebase_options_get_type :: 
    IO GType

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

instance B.Types.TypedObject RebaseOptions where
    glibType :: IO GType
glibType = IO GType
c_ggit_rebase_options_get_type

instance B.Types.GBoxed RebaseOptions

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


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList RebaseOptions
type instance O.AttributeList RebaseOptions = RebaseOptionsAttributeList
type RebaseOptionsAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

-- method RebaseOptions::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Ggit" , name = "RebaseOptions" })
-- throws : False
-- Skip return : False

foreign import ccall "ggit_rebase_options_new" ggit_rebase_options_new :: 
    IO (Ptr RebaseOptions)

-- | Creates a new t'GI.Ggit.Structs.RebaseOptions.RebaseOptions'.
rebaseOptionsNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m RebaseOptions
    -- ^ __Returns:__ a newly allocated t'GI.Ggit.Structs.RebaseOptions.RebaseOptions'.
rebaseOptionsNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m RebaseOptions
rebaseOptionsNew  = IO RebaseOptions -> m RebaseOptions
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RebaseOptions -> m RebaseOptions)
-> IO RebaseOptions -> m RebaseOptions
forall a b. (a -> b) -> a -> b
$ do
    Ptr RebaseOptions
result <- IO (Ptr RebaseOptions)
ggit_rebase_options_new
    Text -> Ptr RebaseOptions -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"rebaseOptionsNew" Ptr RebaseOptions
result
    RebaseOptions
result' <- ((ManagedPtr RebaseOptions -> RebaseOptions)
-> Ptr RebaseOptions -> IO RebaseOptions
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr RebaseOptions -> RebaseOptions
RebaseOptions) Ptr RebaseOptions
result
    RebaseOptions -> IO RebaseOptions
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RebaseOptions
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "ggit_rebase_options_copy" ggit_rebase_options_copy :: 
    Ptr RebaseOptions ->                    -- rebase_options : TInterface (Name {namespace = "Ggit", name = "RebaseOptions"})
    IO (Ptr RebaseOptions)

-- | Copies /@rebaseOptions@/ into a newly allocated t'GI.Ggit.Structs.RebaseOptions.RebaseOptions'.
rebaseOptionsCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RebaseOptions
    -- ^ /@rebaseOptions@/: a t'GI.Ggit.Structs.RebaseOptions.RebaseOptions'.
    -> m (Maybe RebaseOptions)
    -- ^ __Returns:__ a newly allocated t'GI.Ggit.Structs.RebaseOptions.RebaseOptions' or 'P.Nothing'.
rebaseOptionsCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RebaseOptions -> m (Maybe RebaseOptions)
rebaseOptionsCopy RebaseOptions
rebaseOptions = IO (Maybe RebaseOptions) -> m (Maybe RebaseOptions)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe RebaseOptions) -> m (Maybe RebaseOptions))
-> IO (Maybe RebaseOptions) -> m (Maybe RebaseOptions)
forall a b. (a -> b) -> a -> b
$ do
    Ptr RebaseOptions
rebaseOptions' <- RebaseOptions -> IO (Ptr RebaseOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RebaseOptions
rebaseOptions
    Ptr RebaseOptions
result <- Ptr RebaseOptions -> IO (Ptr RebaseOptions)
ggit_rebase_options_copy Ptr RebaseOptions
rebaseOptions'
    Maybe RebaseOptions
maybeResult <- Ptr RebaseOptions
-> (Ptr RebaseOptions -> IO RebaseOptions)
-> IO (Maybe RebaseOptions)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr RebaseOptions
result ((Ptr RebaseOptions -> IO RebaseOptions)
 -> IO (Maybe RebaseOptions))
-> (Ptr RebaseOptions -> IO RebaseOptions)
-> IO (Maybe RebaseOptions)
forall a b. (a -> b) -> a -> b
$ \Ptr RebaseOptions
result' -> do
        RebaseOptions
result'' <- ((ManagedPtr RebaseOptions -> RebaseOptions)
-> Ptr RebaseOptions -> IO RebaseOptions
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr RebaseOptions -> RebaseOptions
RebaseOptions) Ptr RebaseOptions
result'
        RebaseOptions -> IO RebaseOptions
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RebaseOptions
result''
    RebaseOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RebaseOptions
rebaseOptions
    Maybe RebaseOptions -> IO (Maybe RebaseOptions)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RebaseOptions
maybeResult

#if defined(ENABLE_OVERLOADING)
data RebaseOptionsCopyMethodInfo
instance (signature ~ (m (Maybe RebaseOptions)), MonadIO m) => O.OverloadedMethod RebaseOptionsCopyMethodInfo RebaseOptions signature where
    overloadedMethod = rebaseOptionsCopy

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


#endif

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

foreign import ccall "ggit_rebase_options_free" ggit_rebase_options_free :: 
    Ptr RebaseOptions ->                    -- rebase_options : TInterface (Name {namespace = "Ggit", name = "RebaseOptions"})
    IO ()

-- | Frees /@rebaseOptions@/.
rebaseOptionsFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RebaseOptions
    -- ^ /@rebaseOptions@/: a t'GI.Ggit.Structs.RebaseOptions.RebaseOptions'.
    -> m ()
rebaseOptionsFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RebaseOptions -> m ()
rebaseOptionsFree RebaseOptions
rebaseOptions = 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 RebaseOptions
rebaseOptions' <- RebaseOptions -> IO (Ptr RebaseOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RebaseOptions
rebaseOptions
    Ptr RebaseOptions -> IO ()
ggit_rebase_options_free Ptr RebaseOptions
rebaseOptions'
    RebaseOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RebaseOptions
rebaseOptions
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RebaseOptionsFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod RebaseOptionsFreeMethodInfo RebaseOptions signature where
    overloadedMethod = rebaseOptionsFree

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


#endif

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

foreign import ccall "ggit_rebase_options_get_checkout_options" ggit_rebase_options_get_checkout_options :: 
    Ptr RebaseOptions ->                    -- rebase_options : TInterface (Name {namespace = "Ggit", name = "RebaseOptions"})
    IO (Ptr Ggit.CheckoutOptions.CheckoutOptions)

-- | Get the checkout options object or 'P.Nothing' if not set.
rebaseOptionsGetCheckoutOptions ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RebaseOptions
    -- ^ /@rebaseOptions@/: a t'GI.Ggit.Structs.RebaseOptions.RebaseOptions'.
    -> m (Maybe Ggit.CheckoutOptions.CheckoutOptions)
    -- ^ __Returns:__ the checkout options or 'P.Nothing'.
rebaseOptionsGetCheckoutOptions :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RebaseOptions -> m (Maybe CheckoutOptions)
rebaseOptionsGetCheckoutOptions RebaseOptions
rebaseOptions = IO (Maybe CheckoutOptions) -> m (Maybe CheckoutOptions)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe CheckoutOptions) -> m (Maybe CheckoutOptions))
-> IO (Maybe CheckoutOptions) -> m (Maybe CheckoutOptions)
forall a b. (a -> b) -> a -> b
$ do
    Ptr RebaseOptions
rebaseOptions' <- RebaseOptions -> IO (Ptr RebaseOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RebaseOptions
rebaseOptions
    Ptr CheckoutOptions
result <- Ptr RebaseOptions -> IO (Ptr CheckoutOptions)
ggit_rebase_options_get_checkout_options Ptr RebaseOptions
rebaseOptions'
    Maybe CheckoutOptions
maybeResult <- Ptr CheckoutOptions
-> (Ptr CheckoutOptions -> IO CheckoutOptions)
-> IO (Maybe CheckoutOptions)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CheckoutOptions
result ((Ptr CheckoutOptions -> IO CheckoutOptions)
 -> IO (Maybe CheckoutOptions))
-> (Ptr CheckoutOptions -> IO CheckoutOptions)
-> IO (Maybe CheckoutOptions)
forall a b. (a -> b) -> a -> b
$ \Ptr CheckoutOptions
result' -> do
        CheckoutOptions
result'' <- ((ManagedPtr CheckoutOptions -> CheckoutOptions)
-> Ptr CheckoutOptions -> IO CheckoutOptions
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr CheckoutOptions -> CheckoutOptions
Ggit.CheckoutOptions.CheckoutOptions) Ptr CheckoutOptions
result'
        CheckoutOptions -> IO CheckoutOptions
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CheckoutOptions
result''
    RebaseOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RebaseOptions
rebaseOptions
    Maybe CheckoutOptions -> IO (Maybe CheckoutOptions)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CheckoutOptions
maybeResult

#if defined(ENABLE_OVERLOADING)
data RebaseOptionsGetCheckoutOptionsMethodInfo
instance (signature ~ (m (Maybe Ggit.CheckoutOptions.CheckoutOptions)), MonadIO m) => O.OverloadedMethod RebaseOptionsGetCheckoutOptionsMethodInfo RebaseOptions signature where
    overloadedMethod = rebaseOptionsGetCheckoutOptions

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


#endif

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

foreign import ccall "ggit_rebase_options_get_quiet" ggit_rebase_options_get_quiet :: 
    Ptr RebaseOptions ->                    -- rebase_options : TInterface (Name {namespace = "Ggit", name = "RebaseOptions"})
    IO CInt

-- | Gets whether you want a quiet rebase experience.
rebaseOptionsGetQuiet ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RebaseOptions
    -- ^ /@rebaseOptions@/: a t'GI.Ggit.Structs.RebaseOptions.RebaseOptions'.
    -> m Bool
    -- ^ __Returns:__ returns whether you want a quiet rebase experience.
rebaseOptionsGetQuiet :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RebaseOptions -> m Bool
rebaseOptionsGetQuiet RebaseOptions
rebaseOptions = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr RebaseOptions
rebaseOptions' <- RebaseOptions -> IO (Ptr RebaseOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RebaseOptions
rebaseOptions
    CInt
result <- Ptr RebaseOptions -> IO CInt
ggit_rebase_options_get_quiet Ptr RebaseOptions
rebaseOptions'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    RebaseOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RebaseOptions
rebaseOptions
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RebaseOptionsGetQuietMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod RebaseOptionsGetQuietMethodInfo RebaseOptions signature where
    overloadedMethod = rebaseOptionsGetQuiet

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


#endif

-- method RebaseOptions::get_rewrite_notes_ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rebase_options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "RebaseOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitRebaseOptions."
--                 , 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_rebase_options_get_rewrite_notes_ref" ggit_rebase_options_get_rewrite_notes_ref :: 
    Ptr RebaseOptions ->                    -- rebase_options : TInterface (Name {namespace = "Ggit", name = "RebaseOptions"})
    IO CString

-- | Gets the the name of the notes reference used to rewrite notes for rebased
-- commits when finishing the rebase or 'P.Nothing' if not set.
rebaseOptionsGetRewriteNotesRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RebaseOptions
    -- ^ /@rebaseOptions@/: a t'GI.Ggit.Structs.RebaseOptions.RebaseOptions'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the name of the notes reference or 'P.Nothing'.
rebaseOptionsGetRewriteNotesRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RebaseOptions -> m (Maybe Text)
rebaseOptionsGetRewriteNotesRef RebaseOptions
rebaseOptions = 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 RebaseOptions
rebaseOptions' <- RebaseOptions -> IO (Ptr RebaseOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RebaseOptions
rebaseOptions
    CString
result <- Ptr RebaseOptions -> IO CString
ggit_rebase_options_get_rewrite_notes_ref Ptr RebaseOptions
rebaseOptions'
    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''
    RebaseOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RebaseOptions
rebaseOptions
    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 RebaseOptionsGetRewriteNotesRefMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod RebaseOptionsGetRewriteNotesRefMethodInfo RebaseOptions signature where
    overloadedMethod = rebaseOptionsGetRewriteNotesRef

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


#endif

-- method RebaseOptions::set_checkout_options
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rebase_options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "RebaseOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "checkout_options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "CheckoutOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ggit_rebase_options_set_checkout_options" ggit_rebase_options_set_checkout_options :: 
    Ptr RebaseOptions ->                    -- rebase_options : TInterface (Name {namespace = "Ggit", name = "RebaseOptions"})
    Ptr Ggit.CheckoutOptions.CheckoutOptions -> -- checkout_options : TInterface (Name {namespace = "Ggit", name = "CheckoutOptions"})
    IO ()

-- | /No description available in the introspection data./
rebaseOptionsSetCheckoutOptions ::
    (B.CallStack.HasCallStack, MonadIO m, Ggit.CheckoutOptions.IsCheckoutOptions a) =>
    RebaseOptions
    -> a
    -> m ()
rebaseOptionsSetCheckoutOptions :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCheckoutOptions a) =>
RebaseOptions -> a -> m ()
rebaseOptionsSetCheckoutOptions RebaseOptions
rebaseOptions a
checkoutOptions = 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 RebaseOptions
rebaseOptions' <- RebaseOptions -> IO (Ptr RebaseOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RebaseOptions
rebaseOptions
    Ptr CheckoutOptions
checkoutOptions' <- a -> IO (Ptr CheckoutOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
checkoutOptions
    Ptr RebaseOptions -> Ptr CheckoutOptions -> IO ()
ggit_rebase_options_set_checkout_options Ptr RebaseOptions
rebaseOptions' Ptr CheckoutOptions
checkoutOptions'
    RebaseOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RebaseOptions
rebaseOptions
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
checkoutOptions
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RebaseOptionsSetCheckoutOptionsMethodInfo
instance (signature ~ (a -> m ()), MonadIO m, Ggit.CheckoutOptions.IsCheckoutOptions a) => O.OverloadedMethod RebaseOptionsSetCheckoutOptionsMethodInfo RebaseOptions signature where
    overloadedMethod = rebaseOptionsSetCheckoutOptions

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


#endif

-- method RebaseOptions::set_quiet
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rebase_options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "RebaseOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitRebaseOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "quiet"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether you want a quiet rebase experience."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ggit_rebase_options_set_quiet" ggit_rebase_options_set_quiet :: 
    Ptr RebaseOptions ->                    -- rebase_options : TInterface (Name {namespace = "Ggit", name = "RebaseOptions"})
    CInt ->                                 -- quiet : TBasicType TBoolean
    IO ()

-- | Used by @/ggit_rebase_init()/@, this will instruct other clients working
-- on this rebase that you want a quiet rebase experience, which they
-- may choose to provide in an application-specific manner.  This has no
-- effect upon libgit2-glib directly, but is provided for interoperability
-- between Git tools.
rebaseOptionsSetQuiet ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RebaseOptions
    -- ^ /@rebaseOptions@/: a t'GI.Ggit.Structs.RebaseOptions.RebaseOptions'.
    -> Bool
    -- ^ /@quiet@/: whether you want a quiet rebase experience.
    -> m ()
rebaseOptionsSetQuiet :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RebaseOptions -> Bool -> m ()
rebaseOptionsSetQuiet RebaseOptions
rebaseOptions Bool
quiet = 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 RebaseOptions
rebaseOptions' <- RebaseOptions -> IO (Ptr RebaseOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RebaseOptions
rebaseOptions
    let quiet' :: CInt
quiet' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
quiet
    Ptr RebaseOptions -> CInt -> IO ()
ggit_rebase_options_set_quiet Ptr RebaseOptions
rebaseOptions' CInt
quiet'
    RebaseOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RebaseOptions
rebaseOptions
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RebaseOptionsSetQuietMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m) => O.OverloadedMethod RebaseOptionsSetQuietMethodInfo RebaseOptions signature where
    overloadedMethod = rebaseOptionsSetQuiet

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


#endif

-- method RebaseOptions::set_rewrite_notes_ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "rebase_options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "RebaseOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitRebaseOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rewrite_notes_ref"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the notes reference."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ggit_rebase_options_set_rewrite_notes_ref" ggit_rebase_options_set_rewrite_notes_ref :: 
    Ptr RebaseOptions ->                    -- rebase_options : TInterface (Name {namespace = "Ggit", name = "RebaseOptions"})
    CString ->                              -- rewrite_notes_ref : TBasicType TUTF8
    IO ()

-- | Used by 'GI.Ggit.Objects.Rebase.rebaseFinish', this is the name of the notes reference
-- used to rewrite notes for rebased commits when finishing the rebase;
-- if 'P.Nothing', the contents of the configuration option @notes.rewriteRef@
-- is examined, unless the configuration option @notes.rewrite.rebase@
-- is set to false.  If @notes.rewriteRef@ is also 'P.Nothing', notes will
-- not be rewritten.
rebaseOptionsSetRewriteNotesRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RebaseOptions
    -- ^ /@rebaseOptions@/: a t'GI.Ggit.Structs.RebaseOptions.RebaseOptions'.
    -> T.Text
    -- ^ /@rewriteNotesRef@/: the name of the notes reference.
    -> m ()
rebaseOptionsSetRewriteNotesRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RebaseOptions -> Text -> m ()
rebaseOptionsSetRewriteNotesRef RebaseOptions
rebaseOptions Text
rewriteNotesRef = 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 RebaseOptions
rebaseOptions' <- RebaseOptions -> IO (Ptr RebaseOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RebaseOptions
rebaseOptions
    CString
rewriteNotesRef' <- Text -> IO CString
textToCString Text
rewriteNotesRef
    Ptr RebaseOptions -> CString -> IO ()
ggit_rebase_options_set_rewrite_notes_ref Ptr RebaseOptions
rebaseOptions' CString
rewriteNotesRef'
    RebaseOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RebaseOptions
rebaseOptions
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
rewriteNotesRef'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RebaseOptionsSetRewriteNotesRefMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.OverloadedMethod RebaseOptionsSetRewriteNotesRefMethodInfo RebaseOptions signature where
    overloadedMethod = rebaseOptionsSetRewriteNotesRef

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


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveRebaseOptionsMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveRebaseOptionsMethod "copy" o = RebaseOptionsCopyMethodInfo
    ResolveRebaseOptionsMethod "free" o = RebaseOptionsFreeMethodInfo
    ResolveRebaseOptionsMethod "getCheckoutOptions" o = RebaseOptionsGetCheckoutOptionsMethodInfo
    ResolveRebaseOptionsMethod "getQuiet" o = RebaseOptionsGetQuietMethodInfo
    ResolveRebaseOptionsMethod "getRewriteNotesRef" o = RebaseOptionsGetRewriteNotesRefMethodInfo
    ResolveRebaseOptionsMethod "setCheckoutOptions" o = RebaseOptionsSetCheckoutOptionsMethodInfo
    ResolveRebaseOptionsMethod "setQuiet" o = RebaseOptionsSetQuietMethodInfo
    ResolveRebaseOptionsMethod "setRewriteNotesRef" o = RebaseOptionsSetRewriteNotesRefMethodInfo
    ResolveRebaseOptionsMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif