{-# 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 cloning.

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

module GI.Ggit.Objects.CloneOptions
    ( 

-- * Exported types
    CloneOptions(..)                        ,
    IsCloneOptions                          ,
    toCloneOptions                          ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getCheckoutBranch]("GI.Ggit.Objects.CloneOptions#g:method:getCheckoutBranch"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFetchOptions]("GI.Ggit.Objects.CloneOptions#g:method:getFetchOptions"), [getIsBare]("GI.Ggit.Objects.CloneOptions#g:method:getIsBare"), [getLocal]("GI.Ggit.Objects.CloneOptions#g:method:getLocal"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setCheckoutBranch]("GI.Ggit.Objects.CloneOptions#g:method:setCheckoutBranch"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setFetchOptions]("GI.Ggit.Objects.CloneOptions#g:method:setFetchOptions"), [setIsBare]("GI.Ggit.Objects.CloneOptions#g:method:setIsBare"), [setLocal]("GI.Ggit.Objects.CloneOptions#g:method:setLocal"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveCloneOptionsMethod               ,
#endif

-- ** getCheckoutBranch #method:getCheckoutBranch#

#if defined(ENABLE_OVERLOADING)
    CloneOptionsGetCheckoutBranchMethodInfo ,
#endif
    cloneOptionsGetCheckoutBranch           ,


-- ** getFetchOptions #method:getFetchOptions#

#if defined(ENABLE_OVERLOADING)
    CloneOptionsGetFetchOptionsMethodInfo   ,
#endif
    cloneOptionsGetFetchOptions             ,


-- ** getIsBare #method:getIsBare#

#if defined(ENABLE_OVERLOADING)
    CloneOptionsGetIsBareMethodInfo         ,
#endif
    cloneOptionsGetIsBare                   ,


-- ** getLocal #method:getLocal#

#if defined(ENABLE_OVERLOADING)
    CloneOptionsGetLocalMethodInfo          ,
#endif
    cloneOptionsGetLocal                    ,


-- ** new #method:new#

    cloneOptionsNew                         ,


-- ** setCheckoutBranch #method:setCheckoutBranch#

#if defined(ENABLE_OVERLOADING)
    CloneOptionsSetCheckoutBranchMethodInfo ,
#endif
    cloneOptionsSetCheckoutBranch           ,


-- ** setFetchOptions #method:setFetchOptions#

#if defined(ENABLE_OVERLOADING)
    CloneOptionsSetFetchOptionsMethodInfo   ,
#endif
    cloneOptionsSetFetchOptions             ,


-- ** setIsBare #method:setIsBare#

#if defined(ENABLE_OVERLOADING)
    CloneOptionsSetIsBareMethodInfo         ,
#endif
    cloneOptionsSetIsBare                   ,


-- ** setLocal #method:setLocal#

#if defined(ENABLE_OVERLOADING)
    CloneOptionsSetLocalMethodInfo          ,
#endif
    cloneOptionsSetLocal                    ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Ggit.Enums as Ggit.Enums
import {-# SOURCE #-} qualified GI.Ggit.Structs.FetchOptions as Ggit.FetchOptions

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

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

foreign import ccall "ggit_clone_options_get_type"
    c_ggit_clone_options_get_type :: IO B.Types.GType

instance B.Types.TypedObject CloneOptions where
    glibType :: IO GType
glibType = IO GType
c_ggit_clone_options_get_type

instance B.Types.GObject CloneOptions

-- | Type class for types which can be safely cast to `CloneOptions`, for instance with `toCloneOptions`.
class (SP.GObject o, O.IsDescendantOf CloneOptions o) => IsCloneOptions o
instance (SP.GObject o, O.IsDescendantOf CloneOptions o) => IsCloneOptions o

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

-- | Cast to `CloneOptions`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toCloneOptions :: (MIO.MonadIO m, IsCloneOptions o) => o -> m CloneOptions
toCloneOptions :: forall (m :: * -> *) o.
(MonadIO m, IsCloneOptions o) =>
o -> m CloneOptions
toCloneOptions = IO CloneOptions -> m CloneOptions
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO CloneOptions -> m CloneOptions)
-> (o -> IO CloneOptions) -> o -> m CloneOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr CloneOptions -> CloneOptions) -> o -> IO CloneOptions
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr CloneOptions -> CloneOptions
CloneOptions

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

#if defined(ENABLE_OVERLOADING)
type family ResolveCloneOptionsMethod (t :: Symbol) (o :: *) :: * where
    ResolveCloneOptionsMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveCloneOptionsMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveCloneOptionsMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveCloneOptionsMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveCloneOptionsMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveCloneOptionsMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveCloneOptionsMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveCloneOptionsMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveCloneOptionsMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveCloneOptionsMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveCloneOptionsMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveCloneOptionsMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveCloneOptionsMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveCloneOptionsMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveCloneOptionsMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveCloneOptionsMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveCloneOptionsMethod "getCheckoutBranch" o = CloneOptionsGetCheckoutBranchMethodInfo
    ResolveCloneOptionsMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveCloneOptionsMethod "getFetchOptions" o = CloneOptionsGetFetchOptionsMethodInfo
    ResolveCloneOptionsMethod "getIsBare" o = CloneOptionsGetIsBareMethodInfo
    ResolveCloneOptionsMethod "getLocal" o = CloneOptionsGetLocalMethodInfo
    ResolveCloneOptionsMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveCloneOptionsMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveCloneOptionsMethod "setCheckoutBranch" o = CloneOptionsSetCheckoutBranchMethodInfo
    ResolveCloneOptionsMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveCloneOptionsMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveCloneOptionsMethod "setFetchOptions" o = CloneOptionsSetFetchOptionsMethodInfo
    ResolveCloneOptionsMethod "setIsBare" o = CloneOptionsSetIsBareMethodInfo
    ResolveCloneOptionsMethod "setLocal" o = CloneOptionsSetLocalMethodInfo
    ResolveCloneOptionsMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveCloneOptionsMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

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

foreign import ccall "ggit_clone_options_new" ggit_clone_options_new :: 
    IO (Ptr CloneOptions)

-- | Creates a new t'GI.Ggit.Objects.CloneOptions.CloneOptions'.
cloneOptionsNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m CloneOptions
    -- ^ __Returns:__ a newly allocated t'GI.Ggit.Objects.CloneOptions.CloneOptions'.
cloneOptionsNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m CloneOptions
cloneOptionsNew  = IO CloneOptions -> m CloneOptions
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CloneOptions -> m CloneOptions)
-> IO CloneOptions -> m CloneOptions
forall a b. (a -> b) -> a -> b
$ do
    Ptr CloneOptions
result <- IO (Ptr CloneOptions)
ggit_clone_options_new
    Text -> Ptr CloneOptions -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"cloneOptionsNew" Ptr CloneOptions
result
    CloneOptions
result' <- ((ManagedPtr CloneOptions -> CloneOptions)
-> Ptr CloneOptions -> IO CloneOptions
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr CloneOptions -> CloneOptions
CloneOptions) Ptr CloneOptions
result
    CloneOptions -> IO CloneOptions
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CloneOptions
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method CloneOptions::get_checkout_branch
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "CloneOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitCloneOptions."
--                 , 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_clone_options_get_checkout_branch" ggit_clone_options_get_checkout_branch :: 
    Ptr CloneOptions ->                     -- options : TInterface (Name {namespace = "Ggit", name = "CloneOptions"})
    IO CString

-- | Gets the name of the branch to checkout or 'P.Nothing'.
cloneOptionsGetCheckoutBranch ::
    (B.CallStack.HasCallStack, MonadIO m, IsCloneOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.CloneOptions.CloneOptions'.
    -> m T.Text
    -- ^ __Returns:__ the name of the branch to checkout or 'P.Nothing'.
cloneOptionsGetCheckoutBranch :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCloneOptions a) =>
a -> m Text
cloneOptionsGetCheckoutBranch a
options = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr CloneOptions
options' <- a -> IO (Ptr CloneOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    CString
result <- Ptr CloneOptions -> IO CString
ggit_clone_options_get_checkout_branch Ptr CloneOptions
options'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"cloneOptionsGetCheckoutBranch" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data CloneOptionsGetCheckoutBranchMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsCloneOptions a) => O.OverloadedMethod CloneOptionsGetCheckoutBranchMethodInfo a signature where
    overloadedMethod = cloneOptionsGetCheckoutBranch

instance O.OverloadedMethodInfo CloneOptionsGetCheckoutBranchMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Objects.CloneOptions.cloneOptionsGetCheckoutBranch",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.12/docs/GI-Ggit-Objects-CloneOptions.html#v:cloneOptionsGetCheckoutBranch"
        })


#endif

-- method CloneOptions::get_fetch_options
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "CloneOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitCloneOptions."
--                 , 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_clone_options_get_fetch_options" ggit_clone_options_get_fetch_options :: 
    Ptr CloneOptions ->                     -- options : TInterface (Name {namespace = "Ggit", name = "CloneOptions"})
    IO (Ptr Ggit.FetchOptions.FetchOptions)

-- | Get the fetch options object or 'P.Nothing' if not set.
cloneOptionsGetFetchOptions ::
    (B.CallStack.HasCallStack, MonadIO m, IsCloneOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.CloneOptions.CloneOptions'.
    -> m Ggit.FetchOptions.FetchOptions
    -- ^ __Returns:__ the fetch options or 'P.Nothing'.
cloneOptionsGetFetchOptions :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCloneOptions a) =>
a -> m FetchOptions
cloneOptionsGetFetchOptions a
options = IO FetchOptions -> m FetchOptions
forall a. IO a -> m a
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 CloneOptions
options' <- a -> IO (Ptr CloneOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Ptr FetchOptions
result <- Ptr CloneOptions -> IO (Ptr FetchOptions)
ggit_clone_options_get_fetch_options Ptr CloneOptions
options'
    Text -> Ptr FetchOptions -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"cloneOptionsGetFetchOptions" Ptr FetchOptions
result
    FetchOptions
result' <- ((ManagedPtr FetchOptions -> FetchOptions)
-> Ptr FetchOptions -> IO FetchOptions
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr FetchOptions -> FetchOptions
Ggit.FetchOptions.FetchOptions) Ptr FetchOptions
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    FetchOptions -> IO FetchOptions
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FetchOptions
result'

#if defined(ENABLE_OVERLOADING)
data CloneOptionsGetFetchOptionsMethodInfo
instance (signature ~ (m Ggit.FetchOptions.FetchOptions), MonadIO m, IsCloneOptions a) => O.OverloadedMethod CloneOptionsGetFetchOptionsMethodInfo a signature where
    overloadedMethod = cloneOptionsGetFetchOptions

instance O.OverloadedMethodInfo CloneOptionsGetFetchOptionsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Objects.CloneOptions.cloneOptionsGetFetchOptions",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.12/docs/GI-Ggit-Objects-CloneOptions.html#v:cloneOptionsGetFetchOptions"
        })


#endif

-- method CloneOptions::get_is_bare
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "CloneOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitCloneOptions."
--                 , 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_clone_options_get_is_bare" ggit_clone_options_get_is_bare :: 
    Ptr CloneOptions ->                     -- options : TInterface (Name {namespace = "Ggit", name = "CloneOptions"})
    IO CInt

-- | Gets if the repository will be bare.
cloneOptionsGetIsBare ::
    (B.CallStack.HasCallStack, MonadIO m, IsCloneOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.CloneOptions.CloneOptions'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' to clone a bare repository.
cloneOptionsGetIsBare :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCloneOptions a) =>
a -> m Bool
cloneOptionsGetIsBare a
options = 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 CloneOptions
options' <- a -> IO (Ptr CloneOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    CInt
result <- Ptr CloneOptions -> IO CInt
ggit_clone_options_get_is_bare Ptr CloneOptions
options'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CloneOptionsGetIsBareMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsCloneOptions a) => O.OverloadedMethod CloneOptionsGetIsBareMethodInfo a signature where
    overloadedMethod = cloneOptionsGetIsBare

instance O.OverloadedMethodInfo CloneOptionsGetIsBareMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Objects.CloneOptions.cloneOptionsGetIsBare",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.12/docs/GI-Ggit-Objects-CloneOptions.html#v:cloneOptionsGetIsBare"
        })


#endif

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

foreign import ccall "ggit_clone_options_get_local" ggit_clone_options_get_local :: 
    Ptr CloneOptions ->                     -- options : TInterface (Name {namespace = "Ggit", name = "CloneOptions"})
    IO CUInt

-- | Get setting for bypassing the git-aware transport when cloning. The
-- default auto setting bypasses the git-aware transport for local paths,
-- but use a normal fetch for file:\/\/ URIs.
cloneOptionsGetLocal ::
    (B.CallStack.HasCallStack, MonadIO m, IsCloneOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.CloneOptions.CloneOptions'.
    -> m Ggit.Enums.CloneLocal
    -- ^ __Returns:__ the local clone setting.
cloneOptionsGetLocal :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCloneOptions a) =>
a -> m CloneLocal
cloneOptionsGetLocal a
options = IO CloneLocal -> m CloneLocal
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CloneLocal -> m CloneLocal) -> IO CloneLocal -> m CloneLocal
forall a b. (a -> b) -> a -> b
$ do
    Ptr CloneOptions
options' <- a -> IO (Ptr CloneOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    CUInt
result <- Ptr CloneOptions -> IO CUInt
ggit_clone_options_get_local Ptr CloneOptions
options'
    let result' :: CloneLocal
result' = (Int -> CloneLocal
forall a. Enum a => Int -> a
toEnum (Int -> CloneLocal) -> (CUInt -> Int) -> CUInt -> CloneLocal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    CloneLocal -> IO CloneLocal
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CloneLocal
result'

#if defined(ENABLE_OVERLOADING)
data CloneOptionsGetLocalMethodInfo
instance (signature ~ (m Ggit.Enums.CloneLocal), MonadIO m, IsCloneOptions a) => O.OverloadedMethod CloneOptionsGetLocalMethodInfo a signature where
    overloadedMethod = cloneOptionsGetLocal

instance O.OverloadedMethodInfo CloneOptionsGetLocalMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Objects.CloneOptions.cloneOptionsGetLocal",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.12/docs/GI-Ggit-Objects-CloneOptions.html#v:cloneOptionsGetLocal"
        })


#endif

-- method CloneOptions::set_checkout_branch
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "CloneOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitCloneOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "checkout_branch"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the branch to checkout or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ggit_clone_options_set_checkout_branch" ggit_clone_options_set_checkout_branch :: 
    Ptr CloneOptions ->                     -- options : TInterface (Name {namespace = "Ggit", name = "CloneOptions"})
    CString ->                              -- checkout_branch : TBasicType TUTF8
    IO ()

-- | Gives the name of the branch to checkout. 'P.Nothing' means
-- use the remote\'s HEAD.
cloneOptionsSetCheckoutBranch ::
    (B.CallStack.HasCallStack, MonadIO m, IsCloneOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.CloneOptions.CloneOptions'.
    -> Maybe (T.Text)
    -- ^ /@checkoutBranch@/: the name of the branch to checkout or 'P.Nothing'.
    -> m ()
cloneOptionsSetCheckoutBranch :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCloneOptions a) =>
a -> Maybe Text -> m ()
cloneOptionsSetCheckoutBranch a
options Maybe Text
checkoutBranch = 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 CloneOptions
options' <- a -> IO (Ptr CloneOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    CString
maybeCheckoutBranch <- case Maybe Text
checkoutBranch of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jCheckoutBranch -> do
            CString
jCheckoutBranch' <- Text -> IO CString
textToCString Text
jCheckoutBranch
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jCheckoutBranch'
    Ptr CloneOptions -> CString -> IO ()
ggit_clone_options_set_checkout_branch Ptr CloneOptions
options' CString
maybeCheckoutBranch
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeCheckoutBranch
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CloneOptionsSetCheckoutBranchMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsCloneOptions a) => O.OverloadedMethod CloneOptionsSetCheckoutBranchMethodInfo a signature where
    overloadedMethod = cloneOptionsSetCheckoutBranch

instance O.OverloadedMethodInfo CloneOptionsSetCheckoutBranchMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Objects.CloneOptions.cloneOptionsSetCheckoutBranch",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.12/docs/GI-Ggit-Objects-CloneOptions.html#v:cloneOptionsSetCheckoutBranch"
        })


#endif

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

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

-- | Set the fetch options object.
cloneOptionsSetFetchOptions ::
    (B.CallStack.HasCallStack, MonadIO m, IsCloneOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.CloneOptions.CloneOptions'.
    -> Maybe (Ggit.FetchOptions.FetchOptions)
    -- ^ /@fetchOptions@/: a t'GI.Ggit.Structs.FetchOptions.FetchOptions' or 'P.Nothing'.
    -> m ()
cloneOptionsSetFetchOptions :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCloneOptions a) =>
a -> Maybe FetchOptions -> m ()
cloneOptionsSetFetchOptions a
options Maybe FetchOptions
fetchOptions = 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 CloneOptions
options' <- a -> IO (Ptr CloneOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Ptr FetchOptions
maybeFetchOptions <- case Maybe FetchOptions
fetchOptions of
        Maybe FetchOptions
Nothing -> Ptr FetchOptions -> IO (Ptr FetchOptions)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FetchOptions
forall a. Ptr a
nullPtr
        Just 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FetchOptions
jFetchOptions'
    Ptr CloneOptions -> Ptr FetchOptions -> IO ()
ggit_clone_options_set_fetch_options Ptr CloneOptions
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CloneOptionsSetFetchOptionsMethodInfo
instance (signature ~ (Maybe (Ggit.FetchOptions.FetchOptions) -> m ()), MonadIO m, IsCloneOptions a) => O.OverloadedMethod CloneOptionsSetFetchOptionsMethodInfo a signature where
    overloadedMethod = cloneOptionsSetFetchOptions

instance O.OverloadedMethodInfo CloneOptionsSetFetchOptionsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Objects.CloneOptions.cloneOptionsSetFetchOptions",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.12/docs/GI-Ggit-Objects-CloneOptions.html#v:cloneOptionsSetFetchOptions"
        })


#endif

-- method CloneOptions::set_is_bare
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "CloneOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitCloneOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bare"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to clone a bare repository."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ggit_clone_options_set_is_bare" ggit_clone_options_set_is_bare :: 
    Ptr CloneOptions ->                     -- options : TInterface (Name {namespace = "Ggit", name = "CloneOptions"})
    CInt ->                                 -- bare : TBasicType TBoolean
    IO ()

-- | Sets whether to clone a bare repository.
cloneOptionsSetIsBare ::
    (B.CallStack.HasCallStack, MonadIO m, IsCloneOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.CloneOptions.CloneOptions'.
    -> Bool
    -- ^ /@bare@/: 'P.True' to clone a bare repository.
    -> m ()
cloneOptionsSetIsBare :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCloneOptions a) =>
a -> Bool -> m ()
cloneOptionsSetIsBare a
options Bool
bare = 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 CloneOptions
options' <- a -> IO (Ptr CloneOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    let bare' :: CInt
bare' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
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
fromEnum) Bool
bare
    Ptr CloneOptions -> CInt -> IO ()
ggit_clone_options_set_is_bare Ptr CloneOptions
options' CInt
bare'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CloneOptionsSetIsBareMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsCloneOptions a) => O.OverloadedMethod CloneOptionsSetIsBareMethodInfo a signature where
    overloadedMethod = cloneOptionsSetIsBare

instance O.OverloadedMethodInfo CloneOptionsSetIsBareMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Objects.CloneOptions.cloneOptionsSetIsBare",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.12/docs/GI-Ggit-Objects-CloneOptions.html#v:cloneOptionsSetIsBare"
        })


#endif

-- method CloneOptions::set_local
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "CloneOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitCloneOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "local"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "CloneLocal" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the local clone setting."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ggit_clone_options_set_local" ggit_clone_options_set_local :: 
    Ptr CloneOptions ->                     -- options : TInterface (Name {namespace = "Ggit", name = "CloneOptions"})
    CUInt ->                                -- local : TInterface (Name {namespace = "Ggit", name = "CloneLocal"})
    IO ()

-- | Set setting for bypassing the git-aware transport when cloning. The
-- default auto setting bypasses the git-aware transport for local paths,
-- but use a normal fetch for file:\/\/ URIs.
cloneOptionsSetLocal ::
    (B.CallStack.HasCallStack, MonadIO m, IsCloneOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.CloneOptions.CloneOptions'.
    -> Ggit.Enums.CloneLocal
    -- ^ /@local@/: the local clone setting.
    -> m ()
cloneOptionsSetLocal :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCloneOptions a) =>
a -> CloneLocal -> m ()
cloneOptionsSetLocal a
options CloneLocal
local = 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 CloneOptions
options' <- a -> IO (Ptr CloneOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    let local' :: CUInt
local' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (CloneLocal -> Int) -> CloneLocal -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CloneLocal -> Int
forall a. Enum a => a -> Int
fromEnum) CloneLocal
local
    Ptr CloneOptions -> CUInt -> IO ()
ggit_clone_options_set_local Ptr CloneOptions
options' CUInt
local'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CloneOptionsSetLocalMethodInfo
instance (signature ~ (Ggit.Enums.CloneLocal -> m ()), MonadIO m, IsCloneOptions a) => O.OverloadedMethod CloneOptionsSetLocalMethodInfo a signature where
    overloadedMethod = cloneOptionsSetLocal

instance O.OverloadedMethodInfo CloneOptionsSetLocalMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Objects.CloneOptions.cloneOptionsSetLocal",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.12/docs/GI-Ggit-Objects-CloneOptions.html#v:cloneOptionsSetLocal"
        })


#endif