{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Represents a git fetch options.

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

module GI.Ggit.Structs.FetchOptions
    ( 

-- * Exported types
    FetchOptions(..)                        ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copy]("GI.Ggit.Structs.FetchOptions#g:method:copy"), [free]("GI.Ggit.Structs.FetchOptions#g:method:free").
-- 
-- ==== Getters
-- [getDownloadTags]("GI.Ggit.Structs.FetchOptions#g:method:getDownloadTags"), [getRemoteCallbacks]("GI.Ggit.Structs.FetchOptions#g:method:getRemoteCallbacks").
-- 
-- ==== Setters
-- [setDownloadTags]("GI.Ggit.Structs.FetchOptions#g:method:setDownloadTags"), [setRemoteCallbacks]("GI.Ggit.Structs.FetchOptions#g:method:setRemoteCallbacks").

#if defined(ENABLE_OVERLOADING)
    ResolveFetchOptionsMethod               ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    FetchOptionsCopyMethodInfo              ,
#endif
    fetchOptionsCopy                        ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    FetchOptionsFreeMethodInfo              ,
#endif
    fetchOptionsFree                        ,


-- ** getDownloadTags #method:getDownloadTags#

#if defined(ENABLE_OVERLOADING)
    FetchOptionsGetDownloadTagsMethodInfo   ,
#endif
    fetchOptionsGetDownloadTags             ,


-- ** getRemoteCallbacks #method:getRemoteCallbacks#

#if defined(ENABLE_OVERLOADING)
    FetchOptionsGetRemoteCallbacksMethodInfo,
#endif
    fetchOptionsGetRemoteCallbacks          ,


-- ** new #method:new#

    fetchOptionsNew                         ,


-- ** setDownloadTags #method:setDownloadTags#

#if defined(ENABLE_OVERLOADING)
    FetchOptionsSetDownloadTagsMethodInfo   ,
#endif
    fetchOptionsSetDownloadTags             ,


-- ** setRemoteCallbacks #method:setRemoteCallbacks#

#if defined(ENABLE_OVERLOADING)
    FetchOptionsSetRemoteCallbacksMethodInfo,
#endif
    fetchOptionsSetRemoteCallbacks          ,




    ) 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 {-# SOURCE #-} qualified GI.Ggit.Enums as Ggit.Enums
import {-# SOURCE #-} qualified GI.Ggit.Objects.RemoteCallbacks as Ggit.RemoteCallbacks

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

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

foreign import ccall "ggit_fetch_options_get_type" c_ggit_fetch_options_get_type :: 
    IO GType

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

instance B.Types.TypedObject FetchOptions where
    glibType :: IO GType
glibType = IO GType
c_ggit_fetch_options_get_type

instance B.Types.GBoxed FetchOptions

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


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

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

foreign import ccall "ggit_fetch_options_new" ggit_fetch_options_new :: 
    IO (Ptr FetchOptions)

-- | Creates a new t'GI.Ggit.Structs.FetchOptions.FetchOptions'.
fetchOptionsNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m FetchOptions
    -- ^ __Returns:__ a newly allocated t'GI.Ggit.Structs.FetchOptions.FetchOptions'.
fetchOptionsNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m FetchOptions
fetchOptionsNew  = 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 FetchOptions
result <- IO (Ptr FetchOptions)
ggit_fetch_options_new
    Text -> Ptr FetchOptions -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fetchOptionsNew" Ptr FetchOptions
result
    FetchOptions
result' <- ((ManagedPtr FetchOptions -> FetchOptions)
-> Ptr FetchOptions -> IO FetchOptions
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FetchOptions -> FetchOptions
FetchOptions) Ptr FetchOptions
result
    FetchOptions -> IO FetchOptions
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FetchOptions
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method FetchOptions::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "fetch_options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "FetchOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitFetchOptions."
--                 , 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_fetch_options_copy" ggit_fetch_options_copy :: 
    Ptr FetchOptions ->                     -- fetch_options : TInterface (Name {namespace = "Ggit", name = "FetchOptions"})
    IO (Ptr FetchOptions)

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

#if defined(ENABLE_OVERLOADING)
data FetchOptionsCopyMethodInfo
instance (signature ~ (m (Maybe FetchOptions)), MonadIO m) => O.OverloadedMethod FetchOptionsCopyMethodInfo FetchOptions signature where
    overloadedMethod = fetchOptionsCopy

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


#endif

-- method FetchOptions::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "fetch_options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "FetchOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , 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_fetch_options_free" ggit_fetch_options_free :: 
    Ptr FetchOptions ->                     -- fetch_options : TInterface (Name {namespace = "Ggit", name = "FetchOptions"})
    IO ()

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

#if defined(ENABLE_OVERLOADING)
data FetchOptionsFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod FetchOptionsFreeMethodInfo FetchOptions signature where
    overloadedMethod = fetchOptionsFree

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


#endif

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

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

-- | Get how tags are being handled when fetching\/downloading.
fetchOptionsGetDownloadTags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FetchOptions
    -- ^ /@options@/: a t'GI.Ggit.Structs.FetchOptions.FetchOptions'.
    -> m Ggit.Enums.RemoteDownloadTagsType
    -- ^ __Returns:__ a t'GI.Ggit.Enums.RemoteDownloadTagsType'.
fetchOptionsGetDownloadTags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FetchOptions -> m RemoteDownloadTagsType
fetchOptionsGetDownloadTags FetchOptions
options = IO RemoteDownloadTagsType -> m RemoteDownloadTagsType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RemoteDownloadTagsType -> m RemoteDownloadTagsType)
-> IO RemoteDownloadTagsType -> m RemoteDownloadTagsType
forall a b. (a -> b) -> a -> b
$ do
    Ptr FetchOptions
options' <- FetchOptions -> IO (Ptr FetchOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FetchOptions
options
    CUInt
result <- Ptr FetchOptions -> IO CUInt
ggit_fetch_options_get_download_tags Ptr FetchOptions
options'
    let result' :: RemoteDownloadTagsType
result' = (Int -> RemoteDownloadTagsType
forall a. Enum a => Int -> a
toEnum (Int -> RemoteDownloadTagsType)
-> (CUInt -> Int) -> CUInt -> RemoteDownloadTagsType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    FetchOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FetchOptions
options
    RemoteDownloadTagsType -> IO RemoteDownloadTagsType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RemoteDownloadTagsType
result'

#if defined(ENABLE_OVERLOADING)
data FetchOptionsGetDownloadTagsMethodInfo
instance (signature ~ (m Ggit.Enums.RemoteDownloadTagsType), MonadIO m) => O.OverloadedMethod FetchOptionsGetDownloadTagsMethodInfo FetchOptions signature where
    overloadedMethod = fetchOptionsGetDownloadTags

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


#endif

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

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

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

#if defined(ENABLE_OVERLOADING)
data FetchOptionsGetRemoteCallbacksMethodInfo
instance (signature ~ (m (Maybe Ggit.RemoteCallbacks.RemoteCallbacks)), MonadIO m) => O.OverloadedMethod FetchOptionsGetRemoteCallbacksMethodInfo FetchOptions signature where
    overloadedMethod = fetchOptionsGetRemoteCallbacks

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


#endif

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

foreign import ccall "ggit_fetch_options_set_download_tags" ggit_fetch_options_set_download_tags :: 
    Ptr FetchOptions ->                     -- options : TInterface (Name {namespace = "Ggit", name = "FetchOptions"})
    CUInt ->                                -- download_tags : TInterface (Name {namespace = "Ggit", name = "RemoteDownloadTagsType"})
    IO ()

-- | Set how tags are being handled when fetching\/downloading.
fetchOptionsSetDownloadTags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FetchOptions
    -- ^ /@options@/: a t'GI.Ggit.Structs.FetchOptions.FetchOptions'.
    -> Ggit.Enums.RemoteDownloadTagsType
    -- ^ /@downloadTags@/: a t'GI.Ggit.Enums.RemoteDownloadTagsType'.
    -> m ()
fetchOptionsSetDownloadTags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FetchOptions -> RemoteDownloadTagsType -> m ()
fetchOptionsSetDownloadTags FetchOptions
options RemoteDownloadTagsType
downloadTags = 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 FetchOptions
options' <- FetchOptions -> IO (Ptr FetchOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FetchOptions
options
    let downloadTags' :: CUInt
downloadTags' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (RemoteDownloadTagsType -> Int)
-> RemoteDownloadTagsType
-> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteDownloadTagsType -> Int
forall a. Enum a => a -> Int
fromEnum) RemoteDownloadTagsType
downloadTags
    Ptr FetchOptions -> CUInt -> IO ()
ggit_fetch_options_set_download_tags Ptr FetchOptions
options' CUInt
downloadTags'
    FetchOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FetchOptions
options
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FetchOptionsSetDownloadTagsMethodInfo
instance (signature ~ (Ggit.Enums.RemoteDownloadTagsType -> m ()), MonadIO m) => O.OverloadedMethod FetchOptionsSetDownloadTagsMethodInfo FetchOptions signature where
    overloadedMethod = fetchOptionsSetDownloadTags

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


#endif

-- method FetchOptions::set_remote_callbacks
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "FetchOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitFetchOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callbacks"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "RemoteCallbacks" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitRemoteCallbacks 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_fetch_options_set_remote_callbacks" ggit_fetch_options_set_remote_callbacks :: 
    Ptr FetchOptions ->                     -- options : TInterface (Name {namespace = "Ggit", name = "FetchOptions"})
    Ptr Ggit.RemoteCallbacks.RemoteCallbacks -> -- callbacks : TInterface (Name {namespace = "Ggit", name = "RemoteCallbacks"})
    IO ()

-- | Set the fetch options object.
fetchOptionsSetRemoteCallbacks ::
    (B.CallStack.HasCallStack, MonadIO m, Ggit.RemoteCallbacks.IsRemoteCallbacks a) =>
    FetchOptions
    -- ^ /@options@/: a t'GI.Ggit.Structs.FetchOptions.FetchOptions'.
    -> Maybe (a)
    -- ^ /@callbacks@/: a t'GI.Ggit.Objects.RemoteCallbacks.RemoteCallbacks' or 'P.Nothing'.
    -> m ()
fetchOptionsSetRemoteCallbacks :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRemoteCallbacks a) =>
FetchOptions -> Maybe a -> m ()
fetchOptionsSetRemoteCallbacks FetchOptions
options Maybe a
callbacks = 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 FetchOptions
options' <- FetchOptions -> IO (Ptr FetchOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FetchOptions
options
    Ptr RemoteCallbacks
maybeCallbacks <- case Maybe a
callbacks of
        Maybe a
Nothing -> Ptr RemoteCallbacks -> IO (Ptr RemoteCallbacks)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RemoteCallbacks
forall a. Ptr a
nullPtr
        Just a
jCallbacks -> do
            Ptr RemoteCallbacks
jCallbacks' <- a -> IO (Ptr RemoteCallbacks)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jCallbacks
            Ptr RemoteCallbacks -> IO (Ptr RemoteCallbacks)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RemoteCallbacks
jCallbacks'
    Ptr FetchOptions -> Ptr RemoteCallbacks -> IO ()
ggit_fetch_options_set_remote_callbacks Ptr FetchOptions
options' Ptr RemoteCallbacks
maybeCallbacks
    FetchOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FetchOptions
options
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
callbacks a -> 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 FetchOptionsSetRemoteCallbacksMethodInfo
instance (signature ~ (Maybe (a) -> m ()), MonadIO m, Ggit.RemoteCallbacks.IsRemoteCallbacks a) => O.OverloadedMethod FetchOptionsSetRemoteCallbacksMethodInfo FetchOptions signature where
    overloadedMethod = fetchOptionsSetRemoteCallbacks

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


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveFetchOptionsMethod (t :: Symbol) (o :: *) :: * where
    ResolveFetchOptionsMethod "copy" o = FetchOptionsCopyMethodInfo
    ResolveFetchOptionsMethod "free" o = FetchOptionsFreeMethodInfo
    ResolveFetchOptionsMethod "getDownloadTags" o = FetchOptionsGetDownloadTagsMethodInfo
    ResolveFetchOptionsMethod "getRemoteCallbacks" o = FetchOptionsGetRemoteCallbacksMethodInfo
    ResolveFetchOptionsMethod "setDownloadTags" o = FetchOptionsSetDownloadTagsMethodInfo
    ResolveFetchOptionsMethod "setRemoteCallbacks" o = FetchOptionsSetRemoteCallbacksMethodInfo
    ResolveFetchOptionsMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif