{-# LANGUAGE TypeApplications #-}


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

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

module GI.Ggit.Objects.SubmoduleUpdateOptions
    ( 

-- * Exported types
    SubmoduleUpdateOptions(..)              ,
    IsSubmoduleUpdateOptions                ,
    toSubmoduleUpdateOptions                ,
    noSubmoduleUpdateOptions                ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveSubmoduleUpdateOptionsMethod     ,
#endif


-- ** getCheckoutOptions #method:getCheckoutOptions#

#if defined(ENABLE_OVERLOADING)
    SubmoduleUpdateOptionsGetCheckoutOptionsMethodInfo,
#endif
    submoduleUpdateOptionsGetCheckoutOptions,


-- ** getFetchOptions #method:getFetchOptions#

#if defined(ENABLE_OVERLOADING)
    SubmoduleUpdateOptionsGetFetchOptionsMethodInfo,
#endif
    submoduleUpdateOptionsGetFetchOptions   ,


-- ** new #method:new#

    submoduleUpdateOptionsNew               ,


-- ** setCheckoutOptions #method:setCheckoutOptions#

#if defined(ENABLE_OVERLOADING)
    SubmoduleUpdateOptionsSetCheckoutOptionsMethodInfo,
#endif
    submoduleUpdateOptionsSetCheckoutOptions,


-- ** setFetchOptions #method:setFetchOptions#

#if defined(ENABLE_OVERLOADING)
    SubmoduleUpdateOptionsSetFetchOptionsMethodInfo,
#endif
    submoduleUpdateOptionsSetFetchOptions   ,




 -- * Properties
-- ** checkoutOptions #attr:checkoutOptions#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    SubmoduleUpdateOptionsCheckoutOptionsPropertyInfo,
#endif
    clearSubmoduleUpdateOptionsCheckoutOptions,
    constructSubmoduleUpdateOptionsCheckoutOptions,
    getSubmoduleUpdateOptionsCheckoutOptions,
    setSubmoduleUpdateOptionsCheckoutOptions,
#if defined(ENABLE_OVERLOADING)
    submoduleUpdateOptionsCheckoutOptions   ,
#endif


-- ** fetchOptions #attr:fetchOptions#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    SubmoduleUpdateOptionsFetchOptionsPropertyInfo,
#endif
    clearSubmoduleUpdateOptionsFetchOptions ,
    constructSubmoduleUpdateOptionsFetchOptions,
    getSubmoduleUpdateOptionsFetchOptions   ,
    setSubmoduleUpdateOptionsFetchOptions   ,
#if defined(ENABLE_OVERLOADING)
    submoduleUpdateOptionsFetchOptions      ,
#endif




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

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

instance GObject SubmoduleUpdateOptions where
    gobjectType :: IO GType
gobjectType = IO GType
c_ggit_submodule_update_options_get_type
    

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

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

instance O.HasParentTypes SubmoduleUpdateOptions
type instance O.ParentTypes SubmoduleUpdateOptions = '[GObject.Object.Object]

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

-- | A convenience alias for `Nothing` :: `Maybe` `SubmoduleUpdateOptions`.
noSubmoduleUpdateOptions :: Maybe SubmoduleUpdateOptions
noSubmoduleUpdateOptions :: Maybe SubmoduleUpdateOptions
noSubmoduleUpdateOptions = Maybe SubmoduleUpdateOptions
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveSubmoduleUpdateOptionsMethod (t :: Symbol) (o :: *) :: * where
    ResolveSubmoduleUpdateOptionsMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "getCheckoutOptions" o = SubmoduleUpdateOptionsGetCheckoutOptionsMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "getFetchOptions" o = SubmoduleUpdateOptionsGetFetchOptionsMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "setCheckoutOptions" o = SubmoduleUpdateOptionsSetCheckoutOptionsMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "setFetchOptions" o = SubmoduleUpdateOptionsSetFetchOptionsMethodInfo
    ResolveSubmoduleUpdateOptionsMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSubmoduleUpdateOptionsMethod l o = O.MethodResolutionFailed l o

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

#endif

-- VVV Prop "checkout-options"
   -- Type: TInterface (Name {namespace = "Ggit", name = "CheckoutOptions"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

-- | Get the value of the “@checkout-options@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' submoduleUpdateOptions #checkoutOptions
-- @
getSubmoduleUpdateOptionsCheckoutOptions :: (MonadIO m, IsSubmoduleUpdateOptions o) => o -> m (Maybe Ggit.CheckoutOptions.CheckoutOptions)
getSubmoduleUpdateOptionsCheckoutOptions :: o -> m (Maybe CheckoutOptions)
getSubmoduleUpdateOptionsCheckoutOptions obj :: o
obj = IO (Maybe CheckoutOptions) -> m (Maybe CheckoutOptions)
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
$ o
-> String
-> (ManagedPtr CheckoutOptions -> CheckoutOptions)
-> IO (Maybe CheckoutOptions)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj "checkout-options" ManagedPtr CheckoutOptions -> CheckoutOptions
Ggit.CheckoutOptions.CheckoutOptions

-- | Set the value of the “@checkout-options@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' submoduleUpdateOptions [ #checkoutOptions 'Data.GI.Base.Attributes.:=' value ]
-- @
setSubmoduleUpdateOptionsCheckoutOptions :: (MonadIO m, IsSubmoduleUpdateOptions o, Ggit.CheckoutOptions.IsCheckoutOptions a) => o -> a -> m ()
setSubmoduleUpdateOptionsCheckoutOptions :: o -> a -> m ()
setSubmoduleUpdateOptionsCheckoutOptions obj :: o
obj val :: a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "checkout-options" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@checkout-options@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSubmoduleUpdateOptionsCheckoutOptions :: (IsSubmoduleUpdateOptions o, Ggit.CheckoutOptions.IsCheckoutOptions a) => a -> IO (GValueConstruct o)
constructSubmoduleUpdateOptionsCheckoutOptions :: a -> IO (GValueConstruct o)
constructSubmoduleUpdateOptionsCheckoutOptions val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "checkout-options" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Set the value of the “@checkout-options@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #checkoutOptions
-- @
clearSubmoduleUpdateOptionsCheckoutOptions :: (MonadIO m, IsSubmoduleUpdateOptions o) => o -> m ()
clearSubmoduleUpdateOptionsCheckoutOptions :: o -> m ()
clearSubmoduleUpdateOptionsCheckoutOptions obj :: o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe CheckoutOptions -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "checkout-options" (Maybe CheckoutOptions
forall a. Maybe a
Nothing :: Maybe Ggit.CheckoutOptions.CheckoutOptions)

#if defined(ENABLE_OVERLOADING)
data SubmoduleUpdateOptionsCheckoutOptionsPropertyInfo
instance AttrInfo SubmoduleUpdateOptionsCheckoutOptionsPropertyInfo where
    type AttrAllowedOps SubmoduleUpdateOptionsCheckoutOptionsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SubmoduleUpdateOptionsCheckoutOptionsPropertyInfo = IsSubmoduleUpdateOptions
    type AttrSetTypeConstraint SubmoduleUpdateOptionsCheckoutOptionsPropertyInfo = Ggit.CheckoutOptions.IsCheckoutOptions
    type AttrTransferTypeConstraint SubmoduleUpdateOptionsCheckoutOptionsPropertyInfo = Ggit.CheckoutOptions.IsCheckoutOptions
    type AttrTransferType SubmoduleUpdateOptionsCheckoutOptionsPropertyInfo = Ggit.CheckoutOptions.CheckoutOptions
    type AttrGetType SubmoduleUpdateOptionsCheckoutOptionsPropertyInfo = (Maybe Ggit.CheckoutOptions.CheckoutOptions)
    type AttrLabel SubmoduleUpdateOptionsCheckoutOptionsPropertyInfo = "checkout-options"
    type AttrOrigin SubmoduleUpdateOptionsCheckoutOptionsPropertyInfo = SubmoduleUpdateOptions
    attrGet = getSubmoduleUpdateOptionsCheckoutOptions
    attrSet = setSubmoduleUpdateOptionsCheckoutOptions
    attrTransfer _ v = do
        unsafeCastTo Ggit.CheckoutOptions.CheckoutOptions v
    attrConstruct = constructSubmoduleUpdateOptionsCheckoutOptions
    attrClear = clearSubmoduleUpdateOptionsCheckoutOptions
#endif

-- VVV Prop "fetch-options"
   -- Type: TInterface (Name {namespace = "Ggit", name = "FetchOptions"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Just True)

-- | Get the value of the “@fetch-options@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' submoduleUpdateOptions #fetchOptions
-- @
getSubmoduleUpdateOptionsFetchOptions :: (MonadIO m, IsSubmoduleUpdateOptions o) => o -> m (Maybe Ggit.FetchOptions.FetchOptions)
getSubmoduleUpdateOptionsFetchOptions :: o -> m (Maybe FetchOptions)
getSubmoduleUpdateOptionsFetchOptions obj :: o
obj = IO (Maybe FetchOptions) -> m (Maybe FetchOptions)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FetchOptions) -> m (Maybe FetchOptions))
-> IO (Maybe FetchOptions) -> m (Maybe FetchOptions)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr FetchOptions -> FetchOptions)
-> IO (Maybe FetchOptions)
forall a b.
(GObject a, BoxedObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj "fetch-options" ManagedPtr FetchOptions -> FetchOptions
Ggit.FetchOptions.FetchOptions

-- | Set the value of the “@fetch-options@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' submoduleUpdateOptions [ #fetchOptions 'Data.GI.Base.Attributes.:=' value ]
-- @
setSubmoduleUpdateOptionsFetchOptions :: (MonadIO m, IsSubmoduleUpdateOptions o) => o -> Ggit.FetchOptions.FetchOptions -> m ()
setSubmoduleUpdateOptionsFetchOptions :: o -> FetchOptions -> m ()
setSubmoduleUpdateOptionsFetchOptions obj :: o
obj val :: FetchOptions
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe FetchOptions -> IO ()
forall a b.
(GObject a, BoxedObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj "fetch-options" (FetchOptions -> Maybe FetchOptions
forall a. a -> Maybe a
Just FetchOptions
val)

-- | Construct a `GValueConstruct` with valid value for the “@fetch-options@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSubmoduleUpdateOptionsFetchOptions :: (IsSubmoduleUpdateOptions o) => Ggit.FetchOptions.FetchOptions -> IO (GValueConstruct o)
constructSubmoduleUpdateOptionsFetchOptions :: FetchOptions -> IO (GValueConstruct o)
constructSubmoduleUpdateOptionsFetchOptions val :: FetchOptions
val = String -> Maybe FetchOptions -> IO (GValueConstruct o)
forall a o.
BoxedObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed "fetch-options" (FetchOptions -> Maybe FetchOptions
forall a. a -> Maybe a
Just FetchOptions
val)

-- | Set the value of the “@fetch-options@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #fetchOptions
-- @
clearSubmoduleUpdateOptionsFetchOptions :: (MonadIO m, IsSubmoduleUpdateOptions o) => o -> m ()
clearSubmoduleUpdateOptionsFetchOptions :: o -> m ()
clearSubmoduleUpdateOptionsFetchOptions obj :: o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe FetchOptions -> IO ()
forall a b.
(GObject a, BoxedObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj "fetch-options" (Maybe FetchOptions
forall a. Maybe a
Nothing :: Maybe Ggit.FetchOptions.FetchOptions)

#if defined(ENABLE_OVERLOADING)
data SubmoduleUpdateOptionsFetchOptionsPropertyInfo
instance AttrInfo SubmoduleUpdateOptionsFetchOptionsPropertyInfo where
    type AttrAllowedOps SubmoduleUpdateOptionsFetchOptionsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SubmoduleUpdateOptionsFetchOptionsPropertyInfo = IsSubmoduleUpdateOptions
    type AttrSetTypeConstraint SubmoduleUpdateOptionsFetchOptionsPropertyInfo = (~) Ggit.FetchOptions.FetchOptions
    type AttrTransferTypeConstraint SubmoduleUpdateOptionsFetchOptionsPropertyInfo = (~) Ggit.FetchOptions.FetchOptions
    type AttrTransferType SubmoduleUpdateOptionsFetchOptionsPropertyInfo = Ggit.FetchOptions.FetchOptions
    type AttrGetType SubmoduleUpdateOptionsFetchOptionsPropertyInfo = (Maybe Ggit.FetchOptions.FetchOptions)
    type AttrLabel SubmoduleUpdateOptionsFetchOptionsPropertyInfo = "fetch-options"
    type AttrOrigin SubmoduleUpdateOptionsFetchOptionsPropertyInfo = SubmoduleUpdateOptions
    attrGet = getSubmoduleUpdateOptionsFetchOptions
    attrSet = setSubmoduleUpdateOptionsFetchOptions
    attrTransfer _ v = do
        return v
    attrConstruct = constructSubmoduleUpdateOptionsFetchOptions
    attrClear = clearSubmoduleUpdateOptionsFetchOptions
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SubmoduleUpdateOptions
type instance O.AttributeList SubmoduleUpdateOptions = SubmoduleUpdateOptionsAttributeList
type SubmoduleUpdateOptionsAttributeList = ('[ '("checkoutOptions", SubmoduleUpdateOptionsCheckoutOptionsPropertyInfo), '("fetchOptions", SubmoduleUpdateOptionsFetchOptionsPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
submoduleUpdateOptionsCheckoutOptions :: AttrLabelProxy "checkoutOptions"
submoduleUpdateOptionsCheckoutOptions = AttrLabelProxy

submoduleUpdateOptionsFetchOptions :: AttrLabelProxy "fetchOptions"
submoduleUpdateOptionsFetchOptions = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "ggit_submodule_update_options_new" ggit_submodule_update_options_new :: 
    IO (Ptr SubmoduleUpdateOptions)

-- | Creates a new submodule options object.
submoduleUpdateOptionsNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m (Maybe SubmoduleUpdateOptions)
    -- ^ __Returns:__ a t'GI.Ggit.Objects.SubmoduleUpdateOptions.SubmoduleUpdateOptions' or 'P.Nothing'.
submoduleUpdateOptionsNew :: m (Maybe SubmoduleUpdateOptions)
submoduleUpdateOptionsNew  = IO (Maybe SubmoduleUpdateOptions)
-> m (Maybe SubmoduleUpdateOptions)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe SubmoduleUpdateOptions)
 -> m (Maybe SubmoduleUpdateOptions))
-> IO (Maybe SubmoduleUpdateOptions)
-> m (Maybe SubmoduleUpdateOptions)
forall a b. (a -> b) -> a -> b
$ do
    Ptr SubmoduleUpdateOptions
result <- IO (Ptr SubmoduleUpdateOptions)
ggit_submodule_update_options_new
    Maybe SubmoduleUpdateOptions
maybeResult <- Ptr SubmoduleUpdateOptions
-> (Ptr SubmoduleUpdateOptions -> IO SubmoduleUpdateOptions)
-> IO (Maybe SubmoduleUpdateOptions)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr SubmoduleUpdateOptions
result ((Ptr SubmoduleUpdateOptions -> IO SubmoduleUpdateOptions)
 -> IO (Maybe SubmoduleUpdateOptions))
-> (Ptr SubmoduleUpdateOptions -> IO SubmoduleUpdateOptions)
-> IO (Maybe SubmoduleUpdateOptions)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr SubmoduleUpdateOptions
result' -> do
        SubmoduleUpdateOptions
result'' <- ((ManagedPtr SubmoduleUpdateOptions -> SubmoduleUpdateOptions)
-> Ptr SubmoduleUpdateOptions -> IO SubmoduleUpdateOptions
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SubmoduleUpdateOptions -> SubmoduleUpdateOptions
SubmoduleUpdateOptions) Ptr SubmoduleUpdateOptions
result'
        SubmoduleUpdateOptions -> IO SubmoduleUpdateOptions
forall (m :: * -> *) a. Monad m => a -> m a
return SubmoduleUpdateOptions
result''
    Maybe SubmoduleUpdateOptions -> IO (Maybe SubmoduleUpdateOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SubmoduleUpdateOptions
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method SubmoduleUpdateOptions::get_checkout_options
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface
--                 Name { namespace = "Ggit" , name = "SubmoduleUpdateOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitSubmoduleUpdateOptions."
--                 , 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_submodule_update_options_get_checkout_options" ggit_submodule_update_options_get_checkout_options :: 
    Ptr SubmoduleUpdateOptions ->           -- options : TInterface (Name {namespace = "Ggit", name = "SubmoduleUpdateOptions"})
    IO (Ptr Ggit.CheckoutOptions.CheckoutOptions)

-- | Get the checkout options.
submoduleUpdateOptionsGetCheckoutOptions ::
    (B.CallStack.HasCallStack, MonadIO m, IsSubmoduleUpdateOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.SubmoduleUpdateOptions.SubmoduleUpdateOptions'.
    -> m (Maybe Ggit.CheckoutOptions.CheckoutOptions)
    -- ^ __Returns:__ a t'GI.Ggit.Objects.CheckoutOptions.CheckoutOptions' or 'P.Nothing'.
submoduleUpdateOptionsGetCheckoutOptions :: a -> m (Maybe CheckoutOptions)
submoduleUpdateOptionsGetCheckoutOptions options :: a
options = IO (Maybe CheckoutOptions) -> m (Maybe CheckoutOptions)
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 SubmoduleUpdateOptions
options' <- a -> IO (Ptr SubmoduleUpdateOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Ptr CheckoutOptions
result <- Ptr SubmoduleUpdateOptions -> IO (Ptr CheckoutOptions)
ggit_submodule_update_options_get_checkout_options Ptr SubmoduleUpdateOptions
options'
    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
$ \result' :: 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 (m :: * -> *) a. Monad m => a -> m a
return CheckoutOptions
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    Maybe CheckoutOptions -> IO (Maybe CheckoutOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CheckoutOptions
maybeResult

#if defined(ENABLE_OVERLOADING)
data SubmoduleUpdateOptionsGetCheckoutOptionsMethodInfo
instance (signature ~ (m (Maybe Ggit.CheckoutOptions.CheckoutOptions)), MonadIO m, IsSubmoduleUpdateOptions a) => O.MethodInfo SubmoduleUpdateOptionsGetCheckoutOptionsMethodInfo a signature where
    overloadedMethod = submoduleUpdateOptionsGetCheckoutOptions

#endif

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

foreign import ccall "ggit_submodule_update_options_get_fetch_options" ggit_submodule_update_options_get_fetch_options :: 
    Ptr SubmoduleUpdateOptions ->           -- options : TInterface (Name {namespace = "Ggit", name = "SubmoduleUpdateOptions"})
    IO (Ptr Ggit.FetchOptions.FetchOptions)

-- | /No description available in the introspection data./
submoduleUpdateOptionsGetFetchOptions ::
    (B.CallStack.HasCallStack, MonadIO m, IsSubmoduleUpdateOptions a) =>
    a
    -> m Ggit.FetchOptions.FetchOptions
submoduleUpdateOptionsGetFetchOptions :: a -> m FetchOptions
submoduleUpdateOptionsGetFetchOptions options :: a
options = IO FetchOptions -> m FetchOptions
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FetchOptions -> m FetchOptions)
-> IO FetchOptions -> m FetchOptions
forall a b. (a -> b) -> a -> b
$ do
    Ptr SubmoduleUpdateOptions
options' <- a -> IO (Ptr SubmoduleUpdateOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Ptr FetchOptions
result <- Ptr SubmoduleUpdateOptions -> IO (Ptr FetchOptions)
ggit_submodule_update_options_get_fetch_options Ptr SubmoduleUpdateOptions
options'
    Text -> Ptr FetchOptions -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "submoduleUpdateOptionsGetFetchOptions" Ptr FetchOptions
result
    FetchOptions
result' <- ((ManagedPtr FetchOptions -> FetchOptions)
-> Ptr FetchOptions -> IO FetchOptions
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FetchOptions -> FetchOptions
Ggit.FetchOptions.FetchOptions) Ptr FetchOptions
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    FetchOptions -> IO FetchOptions
forall (m :: * -> *) a. Monad m => a -> m a
return FetchOptions
result'

#if defined(ENABLE_OVERLOADING)
data SubmoduleUpdateOptionsGetFetchOptionsMethodInfo
instance (signature ~ (m Ggit.FetchOptions.FetchOptions), MonadIO m, IsSubmoduleUpdateOptions a) => O.MethodInfo SubmoduleUpdateOptionsGetFetchOptionsMethodInfo a signature where
    overloadedMethod = submoduleUpdateOptionsGetFetchOptions

#endif

-- method SubmoduleUpdateOptions::set_checkout_options
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface
--                 Name { namespace = "Ggit" , name = "SubmoduleUpdateOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitSubmoduleUpdateOptions."
--                 , 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 = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitCheckoutOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ggit_submodule_update_options_set_checkout_options" ggit_submodule_update_options_set_checkout_options :: 
    Ptr SubmoduleUpdateOptions ->           -- options : TInterface (Name {namespace = "Ggit", name = "SubmoduleUpdateOptions"})
    Ptr Ggit.CheckoutOptions.CheckoutOptions -> -- checkout_options : TInterface (Name {namespace = "Ggit", name = "CheckoutOptions"})
    IO ()

-- | Set the checkout options.
submoduleUpdateOptionsSetCheckoutOptions ::
    (B.CallStack.HasCallStack, MonadIO m, IsSubmoduleUpdateOptions a, Ggit.CheckoutOptions.IsCheckoutOptions b) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.SubmoduleUpdateOptions.SubmoduleUpdateOptions'.
    -> Maybe (b)
    -- ^ /@checkoutOptions@/: a t'GI.Ggit.Objects.CheckoutOptions.CheckoutOptions'.
    -> m ()
submoduleUpdateOptionsSetCheckoutOptions :: a -> Maybe b -> m ()
submoduleUpdateOptionsSetCheckoutOptions options :: a
options checkoutOptions :: Maybe b
checkoutOptions = 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 SubmoduleUpdateOptions
options' <- a -> IO (Ptr SubmoduleUpdateOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Ptr CheckoutOptions
maybeCheckoutOptions <- case Maybe b
checkoutOptions of
        Nothing -> Ptr CheckoutOptions -> IO (Ptr CheckoutOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CheckoutOptions
forall a. Ptr a
nullPtr
        Just jCheckoutOptions :: b
jCheckoutOptions -> do
            Ptr CheckoutOptions
jCheckoutOptions' <- b -> IO (Ptr CheckoutOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCheckoutOptions
            Ptr CheckoutOptions -> IO (Ptr CheckoutOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CheckoutOptions
jCheckoutOptions'
    Ptr SubmoduleUpdateOptions -> Ptr CheckoutOptions -> IO ()
ggit_submodule_update_options_set_checkout_options Ptr SubmoduleUpdateOptions
options' Ptr CheckoutOptions
maybeCheckoutOptions
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
checkoutOptions b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SubmoduleUpdateOptionsSetCheckoutOptionsMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsSubmoduleUpdateOptions a, Ggit.CheckoutOptions.IsCheckoutOptions b) => O.MethodInfo SubmoduleUpdateOptionsSetCheckoutOptionsMethodInfo a signature where
    overloadedMethod = submoduleUpdateOptionsSetCheckoutOptions

#endif

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

foreign import ccall "ggit_submodule_update_options_set_fetch_options" ggit_submodule_update_options_set_fetch_options :: 
    Ptr SubmoduleUpdateOptions ->           -- options : TInterface (Name {namespace = "Ggit", name = "SubmoduleUpdateOptions"})
    Ptr Ggit.FetchOptions.FetchOptions ->   -- fetch_options : TInterface (Name {namespace = "Ggit", name = "FetchOptions"})
    IO ()

-- | Sets the fetch options.
submoduleUpdateOptionsSetFetchOptions ::
    (B.CallStack.HasCallStack, MonadIO m, IsSubmoduleUpdateOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.SubmoduleUpdateOptions.SubmoduleUpdateOptions'.
    -> Maybe (Ggit.FetchOptions.FetchOptions)
    -- ^ /@fetchOptions@/: a t'GI.Ggit.Structs.FetchOptions.FetchOptions'.
    -> m ()
submoduleUpdateOptionsSetFetchOptions :: a -> Maybe FetchOptions -> m ()
submoduleUpdateOptionsSetFetchOptions options :: a
options fetchOptions :: Maybe FetchOptions
fetchOptions = 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 SubmoduleUpdateOptions
options' <- a -> IO (Ptr SubmoduleUpdateOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Ptr FetchOptions
maybeFetchOptions <- case Maybe FetchOptions
fetchOptions of
        Nothing -> Ptr FetchOptions -> IO (Ptr FetchOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FetchOptions
forall a. Ptr a
nullPtr
        Just jFetchOptions :: FetchOptions
jFetchOptions -> do
            Ptr FetchOptions
jFetchOptions' <- FetchOptions -> IO (Ptr FetchOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FetchOptions
jFetchOptions
            Ptr FetchOptions -> IO (Ptr FetchOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FetchOptions
jFetchOptions'
    Ptr SubmoduleUpdateOptions -> Ptr FetchOptions -> IO ()
ggit_submodule_update_options_set_fetch_options Ptr SubmoduleUpdateOptions
options' Ptr FetchOptions
maybeFetchOptions
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    Maybe FetchOptions -> (FetchOptions -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe FetchOptions
fetchOptions FetchOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SubmoduleUpdateOptionsSetFetchOptionsMethodInfo
instance (signature ~ (Maybe (Ggit.FetchOptions.FetchOptions) -> m ()), MonadIO m, IsSubmoduleUpdateOptions a) => O.MethodInfo SubmoduleUpdateOptionsSetFetchOptionsMethodInfo a signature where
    overloadedMethod = submoduleUpdateOptionsSetFetchOptions

#endif