{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Represents a git remote.

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

module GI.Ggit.Objects.Remote
    ( 

-- * Exported types
    Remote(..)                              ,
    IsRemote                                ,
    toRemote                                ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveRemoteMethod                     ,
#endif


-- ** connect #method:connect#

#if defined(ENABLE_OVERLOADING)
    RemoteConnectMethodInfo                 ,
#endif
    remoteConnect                           ,


-- ** disconnect #method:disconnect#

#if defined(ENABLE_OVERLOADING)
    RemoteDisconnectMethodInfo              ,
#endif
    remoteDisconnect                        ,


-- ** download #method:download#

#if defined(ENABLE_OVERLOADING)
    RemoteDownloadMethodInfo                ,
#endif
    remoteDownload                          ,


-- ** getConnected #method:getConnected#

#if defined(ENABLE_OVERLOADING)
    RemoteGetConnectedMethodInfo            ,
#endif
    remoteGetConnected                      ,


-- ** getFetchSpecs #method:getFetchSpecs#

#if defined(ENABLE_OVERLOADING)
    RemoteGetFetchSpecsMethodInfo           ,
#endif
    remoteGetFetchSpecs                     ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    RemoteGetNameMethodInfo                 ,
#endif
    remoteGetName                           ,


-- ** getOwner #method:getOwner#

#if defined(ENABLE_OVERLOADING)
    RemoteGetOwnerMethodInfo                ,
#endif
    remoteGetOwner                          ,


-- ** getPushSpecs #method:getPushSpecs#

#if defined(ENABLE_OVERLOADING)
    RemoteGetPushSpecsMethodInfo            ,
#endif
    remoteGetPushSpecs                      ,


-- ** getUrl #method:getUrl#

#if defined(ENABLE_OVERLOADING)
    RemoteGetUrlMethodInfo                  ,
#endif
    remoteGetUrl                            ,


-- ** list #method:list#

#if defined(ENABLE_OVERLOADING)
    RemoteListMethodInfo                    ,
#endif
    remoteList                              ,


-- ** new #method:new#

    remoteNew                               ,


-- ** newAnonymous #method:newAnonymous#

    remoteNewAnonymous                      ,


-- ** push #method:push#

#if defined(ENABLE_OVERLOADING)
    RemotePushMethodInfo                    ,
#endif
    remotePush                              ,


-- ** updateTips #method:updateTips#

#if defined(ENABLE_OVERLOADING)
    RemoteUpdateTipsMethodInfo              ,
#endif
    remoteUpdateTips                        ,


-- ** upload #method:upload#

#if defined(ENABLE_OVERLOADING)
    RemoteUploadMethodInfo                  ,
#endif
    remoteUpload                            ,




    ) 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.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 Control.Monad.IO.Class as MIO
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.Enums as Ggit.Enums
import {-# SOURCE #-} qualified GI.Ggit.Objects.Native as Ggit.Native
import {-# SOURCE #-} qualified GI.Ggit.Objects.ObjectFactoryBase as Ggit.ObjectFactoryBase
import {-# SOURCE #-} qualified GI.Ggit.Objects.ProxyOptions as Ggit.ProxyOptions
import {-# SOURCE #-} qualified GI.Ggit.Objects.PushOptions as Ggit.PushOptions
import {-# SOURCE #-} qualified GI.Ggit.Objects.RemoteCallbacks as Ggit.RemoteCallbacks
import {-# SOURCE #-} qualified GI.Ggit.Objects.Repository as Ggit.Repository
import {-# SOURCE #-} qualified GI.Ggit.Structs.FetchOptions as Ggit.FetchOptions
import {-# SOURCE #-} qualified GI.Ggit.Structs.RemoteHead as Ggit.RemoteHead

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

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

foreign import ccall "ggit_remote_get_type"
    c_ggit_remote_get_type :: IO B.Types.GType

instance B.Types.TypedObject Remote where
    glibType :: IO GType
glibType = IO GType
c_ggit_remote_get_type

instance B.Types.GObject Remote

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveRemoteMethod (t :: Symbol) (o :: *) :: * where
    ResolveRemoteMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveRemoteMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveRemoteMethod "connect" o = RemoteConnectMethodInfo
    ResolveRemoteMethod "disconnect" o = RemoteDisconnectMethodInfo
    ResolveRemoteMethod "download" o = RemoteDownloadMethodInfo
    ResolveRemoteMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveRemoteMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveRemoteMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveRemoteMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveRemoteMethod "list" o = RemoteListMethodInfo
    ResolveRemoteMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveRemoteMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveRemoteMethod "push" o = RemotePushMethodInfo
    ResolveRemoteMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveRemoteMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveRemoteMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveRemoteMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveRemoteMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveRemoteMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveRemoteMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveRemoteMethod "updateTips" o = RemoteUpdateTipsMethodInfo
    ResolveRemoteMethod "upload" o = RemoteUploadMethodInfo
    ResolveRemoteMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveRemoteMethod "getConnected" o = RemoteGetConnectedMethodInfo
    ResolveRemoteMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveRemoteMethod "getFetchSpecs" o = RemoteGetFetchSpecsMethodInfo
    ResolveRemoteMethod "getName" o = RemoteGetNameMethodInfo
    ResolveRemoteMethod "getOwner" o = RemoteGetOwnerMethodInfo
    ResolveRemoteMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveRemoteMethod "getPushSpecs" o = RemoteGetPushSpecsMethodInfo
    ResolveRemoteMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveRemoteMethod "getUrl" o = RemoteGetUrlMethodInfo
    ResolveRemoteMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveRemoteMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveRemoteMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveRemoteMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method Remote::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "repository"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Repository" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitRepository." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the remote's name." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "url"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the remote repository's URL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Ggit" , name = "Remote" })
-- throws : True
-- Skip return : False

foreign import ccall "ggit_remote_new" ggit_remote_new :: 
    Ptr Ggit.Repository.Repository ->       -- repository : TInterface (Name {namespace = "Ggit", name = "Repository"})
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- url : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Remote)

-- | Creates a remote with the default refspecs in memory. You can use
-- this when you have a URL instead of a remote\'s name.
remoteNew ::
    (B.CallStack.HasCallStack, MonadIO m, Ggit.Repository.IsRepository a) =>
    a
    -- ^ /@repository@/: a t'GI.Ggit.Objects.Repository.Repository'.
    -> T.Text
    -- ^ /@name@/: the remote\'s name.
    -> T.Text
    -- ^ /@url@/: the remote repository\'s URL.
    -> m (Maybe Remote)
    -- ^ __Returns:__ a newly allocated t'GI.Ggit.Objects.Remote.Remote' or 'P.Nothing'. /(Can throw 'Data.GI.Base.GError.GError')/
remoteNew :: a -> Text -> Text -> m (Maybe Remote)
remoteNew a
repository Text
name Text
url = IO (Maybe Remote) -> m (Maybe Remote)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Remote) -> m (Maybe Remote))
-> IO (Maybe Remote) -> m (Maybe Remote)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repository
repository' <- a -> IO (Ptr Repository)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
repository
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
url' <- Text -> IO CString
textToCString Text
url
    IO (Maybe Remote) -> IO () -> IO (Maybe Remote)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Remote
result <- (Ptr (Ptr GError) -> IO (Ptr Remote)) -> IO (Ptr Remote)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Remote)) -> IO (Ptr Remote))
-> (Ptr (Ptr GError) -> IO (Ptr Remote)) -> IO (Ptr Remote)
forall a b. (a -> b) -> a -> b
$ Ptr Repository
-> CString -> CString -> Ptr (Ptr GError) -> IO (Ptr Remote)
ggit_remote_new Ptr Repository
repository' CString
name' CString
url'
        Maybe Remote
maybeResult <- Ptr Remote -> (Ptr Remote -> IO Remote) -> IO (Maybe Remote)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Remote
result ((Ptr Remote -> IO Remote) -> IO (Maybe Remote))
-> (Ptr Remote -> IO Remote) -> IO (Maybe Remote)
forall a b. (a -> b) -> a -> b
$ \Ptr Remote
result' -> do
            Remote
result'' <- ((ManagedPtr Remote -> Remote) -> Ptr Remote -> IO Remote
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Remote -> Remote
Remote) Ptr Remote
result'
            Remote -> IO Remote
forall (m :: * -> *) a. Monad m => a -> m a
return Remote
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
repository
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
url'
        Maybe Remote -> IO (Maybe Remote)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Remote
maybeResult
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
url'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Remote::new_anonymous
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "repository"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Repository" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitRepository." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "url"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the remote repository's URL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Ggit" , name = "Remote" })
-- throws : True
-- Skip return : False

foreign import ccall "ggit_remote_new_anonymous" ggit_remote_new_anonymous :: 
    Ptr Ggit.Repository.Repository ->       -- repository : TInterface (Name {namespace = "Ggit", name = "Repository"})
    CString ->                              -- url : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Remote)

-- | Creates a remote with the specified refspec in memory. You can use
-- this when you have a URL instead of a remote\'s name.
remoteNewAnonymous ::
    (B.CallStack.HasCallStack, MonadIO m, Ggit.Repository.IsRepository a) =>
    a
    -- ^ /@repository@/: a t'GI.Ggit.Objects.Repository.Repository'.
    -> T.Text
    -- ^ /@url@/: the remote repository\'s URL.
    -> m (Maybe Remote)
    -- ^ __Returns:__ a newly allocated t'GI.Ggit.Objects.Remote.Remote' or 'P.Nothing'. /(Can throw 'Data.GI.Base.GError.GError')/
remoteNewAnonymous :: a -> Text -> m (Maybe Remote)
remoteNewAnonymous a
repository Text
url = IO (Maybe Remote) -> m (Maybe Remote)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Remote) -> m (Maybe Remote))
-> IO (Maybe Remote) -> m (Maybe Remote)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repository
repository' <- a -> IO (Ptr Repository)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
repository
    CString
url' <- Text -> IO CString
textToCString Text
url
    IO (Maybe Remote) -> IO () -> IO (Maybe Remote)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Remote
result <- (Ptr (Ptr GError) -> IO (Ptr Remote)) -> IO (Ptr Remote)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Remote)) -> IO (Ptr Remote))
-> (Ptr (Ptr GError) -> IO (Ptr Remote)) -> IO (Ptr Remote)
forall a b. (a -> b) -> a -> b
$ Ptr Repository -> CString -> Ptr (Ptr GError) -> IO (Ptr Remote)
ggit_remote_new_anonymous Ptr Repository
repository' CString
url'
        Maybe Remote
maybeResult <- Ptr Remote -> (Ptr Remote -> IO Remote) -> IO (Maybe Remote)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Remote
result ((Ptr Remote -> IO Remote) -> IO (Maybe Remote))
-> (Ptr Remote -> IO Remote) -> IO (Maybe Remote)
forall a b. (a -> b) -> a -> b
$ \Ptr Remote
result' -> do
            Remote
result'' <- ((ManagedPtr Remote -> Remote) -> Ptr Remote -> IO Remote
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Remote -> Remote
Remote) Ptr Remote
result'
            Remote -> IO Remote
forall (m :: * -> *) a. Monad m => a -> m a
return Remote
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
repository
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
url'
        Maybe Remote -> IO (Maybe Remote)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Remote
maybeResult
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
url'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Remote::connect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "remote"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Remote" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitRemote." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "direction"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Direction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether you want to receive or send data."
--                 , 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 = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the callbacks to use for this connection."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "proxy_options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "ProxyOptions" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the proxy options." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "custom_headers"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "extra HTTP headers to use in this connection."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : True
-- Skip return : False

foreign import ccall "ggit_remote_connect" ggit_remote_connect :: 
    Ptr Remote ->                           -- remote : TInterface (Name {namespace = "Ggit", name = "Remote"})
    CUInt ->                                -- direction : TInterface (Name {namespace = "Ggit", name = "Direction"})
    Ptr Ggit.RemoteCallbacks.RemoteCallbacks -> -- callbacks : TInterface (Name {namespace = "Ggit", name = "RemoteCallbacks"})
    Ptr Ggit.ProxyOptions.ProxyOptions ->   -- proxy_options : TInterface (Name {namespace = "Ggit", name = "ProxyOptions"})
    CString ->                              -- custom_headers : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO ()

-- | Opens a connection to a remote.
-- The transport is selected based on the URL. The direction argument
-- is due to a limitation of the git protocol (over TCP or SSH) which
-- starts up a specific binary which can only do the one or the other.
remoteConnect ::
    (B.CallStack.HasCallStack, MonadIO m, IsRemote a, Ggit.RemoteCallbacks.IsRemoteCallbacks b, Ggit.ProxyOptions.IsProxyOptions c) =>
    a
    -- ^ /@remote@/: a t'GI.Ggit.Objects.Remote.Remote'.
    -> Ggit.Enums.Direction
    -- ^ /@direction@/: whether you want to receive or send data.
    -> b
    -- ^ /@callbacks@/: the callbacks to use for this connection.
    -> Maybe (c)
    -- ^ /@proxyOptions@/: the proxy options.
    -> Maybe (T.Text)
    -- ^ /@customHeaders@/: extra HTTP headers to use in this connection.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
remoteConnect :: a -> Direction -> b -> Maybe c -> Maybe Text -> m ()
remoteConnect a
remote Direction
direction b
callbacks Maybe c
proxyOptions Maybe Text
customHeaders = 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 Remote
remote' <- a -> IO (Ptr Remote)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
remote
    let direction' :: CUInt
direction' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Direction -> Int) -> Direction -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction -> Int
forall a. Enum a => a -> Int
fromEnum) Direction
direction
    Ptr RemoteCallbacks
callbacks' <- b -> IO (Ptr RemoteCallbacks)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
callbacks
    Ptr ProxyOptions
maybeProxyOptions <- case Maybe c
proxyOptions of
        Maybe c
Nothing -> Ptr ProxyOptions -> IO (Ptr ProxyOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ProxyOptions
forall a. Ptr a
nullPtr
        Just c
jProxyOptions -> do
            Ptr ProxyOptions
jProxyOptions' <- c -> IO (Ptr ProxyOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jProxyOptions
            Ptr ProxyOptions -> IO (Ptr ProxyOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ProxyOptions
jProxyOptions'
    CString
maybeCustomHeaders <- case Maybe Text
customHeaders of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jCustomHeaders -> do
            CString
jCustomHeaders' <- Text -> IO CString
textToCString Text
jCustomHeaders
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jCustomHeaders'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        (Ptr (Ptr GError) -> IO ()) -> IO ()
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO ()) -> IO ())
-> (Ptr (Ptr GError) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Remote
-> CUInt
-> Ptr RemoteCallbacks
-> Ptr ProxyOptions
-> CString
-> Ptr (Ptr GError)
-> IO ()
ggit_remote_connect Ptr Remote
remote' CUInt
direction' Ptr RemoteCallbacks
callbacks' Ptr ProxyOptions
maybeProxyOptions CString
maybeCustomHeaders
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
remote
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
callbacks
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
proxyOptions c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeCustomHeaders
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeCustomHeaders
     )

#if defined(ENABLE_OVERLOADING)
data RemoteConnectMethodInfo
instance (signature ~ (Ggit.Enums.Direction -> b -> Maybe (c) -> Maybe (T.Text) -> m ()), MonadIO m, IsRemote a, Ggit.RemoteCallbacks.IsRemoteCallbacks b, Ggit.ProxyOptions.IsProxyOptions c) => O.MethodInfo RemoteConnectMethodInfo a signature where
    overloadedMethod = remoteConnect

#endif

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

foreign import ccall "ggit_remote_disconnect" ggit_remote_disconnect :: 
    Ptr Remote ->                           -- remote : TInterface (Name {namespace = "Ggit", name = "Remote"})
    IO ()

-- | Closes the connection to the remote and frees the underlying
-- transport.
remoteDisconnect ::
    (B.CallStack.HasCallStack, MonadIO m, IsRemote a) =>
    a
    -- ^ /@remote@/: a t'GI.Ggit.Objects.Remote.Remote'.
    -> m ()
remoteDisconnect :: a -> m ()
remoteDisconnect a
remote = 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 Remote
remote' <- a -> IO (Ptr Remote)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
remote
    Ptr Remote -> IO ()
ggit_remote_disconnect Ptr Remote
remote'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
remote
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RemoteDisconnectMethodInfo
instance (signature ~ (m ()), MonadIO m, IsRemote a) => O.MethodInfo RemoteDisconnectMethodInfo a signature where
    overloadedMethod = remoteDisconnect

#endif

-- method Remote::download
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "remote"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Remote" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitRemote." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "specs"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the ref specs." , 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 = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitFetchOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ggit_remote_download" ggit_remote_download :: 
    Ptr Remote ->                           -- remote : TInterface (Name {namespace = "Ggit", name = "Remote"})
    Ptr CString ->                          -- specs : TCArray True (-1) (-1) (TBasicType TUTF8)
    Ptr Ggit.FetchOptions.FetchOptions ->   -- fetch_options : TInterface (Name {namespace = "Ggit", name = "FetchOptions"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Connect to the remote if not yet connected, negotiate with the remote
-- about which objects are missing and download the resulting packfile and
-- its index.
remoteDownload ::
    (B.CallStack.HasCallStack, MonadIO m, IsRemote a) =>
    a
    -- ^ /@remote@/: a t'GI.Ggit.Objects.Remote.Remote'.
    -> Maybe ([T.Text])
    -- ^ /@specs@/: the ref specs.
    -> Ggit.FetchOptions.FetchOptions
    -- ^ /@fetchOptions@/: a t'GI.Ggit.Structs.FetchOptions.FetchOptions'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
remoteDownload :: a -> Maybe [Text] -> FetchOptions -> m ()
remoteDownload a
remote Maybe [Text]
specs 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 Remote
remote' <- a -> IO (Ptr Remote)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
remote
    Ptr CString
maybeSpecs <- case Maybe [Text]
specs of
        Maybe [Text]
Nothing -> Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just [Text]
jSpecs -> do
            Ptr CString
jSpecs' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
jSpecs
            Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jSpecs'
    Ptr FetchOptions
fetchOptions' <- FetchOptions -> IO (Ptr FetchOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FetchOptions
fetchOptions
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Remote
-> Ptr CString -> Ptr FetchOptions -> Ptr (Ptr GError) -> IO CInt
ggit_remote_download Ptr Remote
remote' Ptr CString
maybeSpecs Ptr FetchOptions
fetchOptions'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
remote
        FetchOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FetchOptions
fetchOptions
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeSpecs
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeSpecs
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeSpecs
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeSpecs
     )

#if defined(ENABLE_OVERLOADING)
data RemoteDownloadMethodInfo
instance (signature ~ (Maybe ([T.Text]) -> Ggit.FetchOptions.FetchOptions -> m ()), MonadIO m, IsRemote a) => O.MethodInfo RemoteDownloadMethodInfo a signature where
    overloadedMethod = remoteDownload

#endif

-- method Remote::get_connected
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "remote"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Remote" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitRemote." , 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_remote_get_connected" ggit_remote_get_connected :: 
    Ptr Remote ->                           -- remote : TInterface (Name {namespace = "Ggit", name = "Remote"})
    IO CInt

-- | Check whether /@remote@/ is connected.
remoteGetConnected ::
    (B.CallStack.HasCallStack, MonadIO m, IsRemote a) =>
    a
    -- ^ /@remote@/: a t'GI.Ggit.Objects.Remote.Remote'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if it is connected.
remoteGetConnected :: a -> m Bool
remoteGetConnected a
remote = IO Bool -> m Bool
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 Remote
remote' <- a -> IO (Ptr Remote)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
remote
    CInt
result <- Ptr Remote -> IO CInt
ggit_remote_get_connected Ptr Remote
remote'
    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
remote
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RemoteGetConnectedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsRemote a) => O.MethodInfo RemoteGetConnectedMethodInfo a signature where
    overloadedMethod = remoteGetConnected

#endif

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

foreign import ccall "ggit_remote_get_fetch_specs" ggit_remote_get_fetch_specs :: 
    Ptr Remote ->                           -- remote : TInterface (Name {namespace = "Ggit", name = "Remote"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr CString)

-- | Get the list of fetch refspecs for the given remote.
remoteGetFetchSpecs ::
    (B.CallStack.HasCallStack, MonadIO m, IsRemote a) =>
    a
    -- ^ /@remote@/: a t'GI.Ggit.Objects.Remote.Remote'.
    -> m (Maybe [T.Text])
    -- ^ __Returns:__ a list of fetch refspecs or 'P.Nothing'. /(Can throw 'Data.GI.Base.GError.GError')/
remoteGetFetchSpecs :: a -> m (Maybe [Text])
remoteGetFetchSpecs a
remote = IO (Maybe [Text]) -> m (Maybe [Text])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Text]) -> m (Maybe [Text]))
-> IO (Maybe [Text]) -> m (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ do
    Ptr Remote
remote' <- a -> IO (Ptr Remote)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
remote
    IO (Maybe [Text]) -> IO () -> IO (Maybe [Text])
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr CString
result <- (Ptr (Ptr GError) -> IO (Ptr CString)) -> IO (Ptr CString)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr CString)) -> IO (Ptr CString))
-> (Ptr (Ptr GError) -> IO (Ptr CString)) -> IO (Ptr CString)
forall a b. (a -> b) -> a -> b
$ Ptr Remote -> Ptr (Ptr GError) -> IO (Ptr CString)
ggit_remote_get_fetch_specs Ptr Remote
remote'
        Maybe [Text]
maybeResult <- Ptr CString -> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CString
result ((Ptr CString -> IO [Text]) -> IO (Maybe [Text]))
-> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ \Ptr CString
result' -> do
            [Text]
result'' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result'
            (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result'
            Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result'
            [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
remote
        Maybe [Text] -> IO (Maybe [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Text]
maybeResult
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data RemoteGetFetchSpecsMethodInfo
instance (signature ~ (m (Maybe [T.Text])), MonadIO m, IsRemote a) => O.MethodInfo RemoteGetFetchSpecsMethodInfo a signature where
    overloadedMethod = remoteGetFetchSpecs

#endif

-- method Remote::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "remote"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Remote" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitRemote." , 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_remote_get_name" ggit_remote_get_name :: 
    Ptr Remote ->                           -- remote : TInterface (Name {namespace = "Ggit", name = "Remote"})
    IO CString

-- | Gets the remote\'s name.
remoteGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsRemote a) =>
    a
    -- ^ /@remote@/: a t'GI.Ggit.Objects.Remote.Remote'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the name of /@remote@/ or 'P.Nothing'.
remoteGetName :: a -> m (Maybe Text)
remoteGetName a
remote = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Remote
remote' <- a -> IO (Ptr Remote)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
remote
    CString
result <- Ptr Remote -> IO CString
ggit_remote_get_name Ptr Remote
remote'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
remote
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data RemoteGetNameMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsRemote a) => O.MethodInfo RemoteGetNameMethodInfo a signature where
    overloadedMethod = remoteGetName

#endif

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

foreign import ccall "ggit_remote_get_owner" ggit_remote_get_owner :: 
    Ptr Remote ->                           -- remote : TInterface (Name {namespace = "Ggit", name = "Remote"})
    IO (Ptr Ggit.Repository.Repository)

-- | Gets the repository where /@remote@/ resides.
remoteGetOwner ::
    (B.CallStack.HasCallStack, MonadIO m, IsRemote a) =>
    a
    -- ^ /@remote@/: a t'GI.Ggit.Objects.Remote.Remote'.
    -> m (Maybe Ggit.Repository.Repository)
    -- ^ __Returns:__ the repository where the remote resides or 'P.Nothing'.
remoteGetOwner :: a -> m (Maybe Repository)
remoteGetOwner a
remote = IO (Maybe Repository) -> m (Maybe Repository)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Repository) -> m (Maybe Repository))
-> IO (Maybe Repository) -> m (Maybe Repository)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Remote
remote' <- a -> IO (Ptr Remote)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
remote
    Ptr Repository
result <- Ptr Remote -> IO (Ptr Repository)
ggit_remote_get_owner Ptr Remote
remote'
    Maybe Repository
maybeResult <- Ptr Repository
-> (Ptr Repository -> IO Repository) -> IO (Maybe Repository)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Repository
result ((Ptr Repository -> IO Repository) -> IO (Maybe Repository))
-> (Ptr Repository -> IO Repository) -> IO (Maybe Repository)
forall a b. (a -> b) -> a -> b
$ \Ptr Repository
result' -> do
        Repository
result'' <- ((ManagedPtr Repository -> Repository)
-> Ptr Repository -> IO Repository
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Repository -> Repository
Ggit.Repository.Repository) Ptr Repository
result'
        Repository -> IO Repository
forall (m :: * -> *) a. Monad m => a -> m a
return Repository
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
remote
    Maybe Repository -> IO (Maybe Repository)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Repository
maybeResult

#if defined(ENABLE_OVERLOADING)
data RemoteGetOwnerMethodInfo
instance (signature ~ (m (Maybe Ggit.Repository.Repository)), MonadIO m, IsRemote a) => O.MethodInfo RemoteGetOwnerMethodInfo a signature where
    overloadedMethod = remoteGetOwner

#endif

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

foreign import ccall "ggit_remote_get_push_specs" ggit_remote_get_push_specs :: 
    Ptr Remote ->                           -- remote : TInterface (Name {namespace = "Ggit", name = "Remote"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr CString)

-- | Get the list of push refspecs for the given remote.
remoteGetPushSpecs ::
    (B.CallStack.HasCallStack, MonadIO m, IsRemote a) =>
    a
    -- ^ /@remote@/: a t'GI.Ggit.Objects.Remote.Remote'.
    -> m (Maybe [T.Text])
    -- ^ __Returns:__ a list of push refspecs or 'P.Nothing'. /(Can throw 'Data.GI.Base.GError.GError')/
remoteGetPushSpecs :: a -> m (Maybe [Text])
remoteGetPushSpecs a
remote = IO (Maybe [Text]) -> m (Maybe [Text])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Text]) -> m (Maybe [Text]))
-> IO (Maybe [Text]) -> m (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ do
    Ptr Remote
remote' <- a -> IO (Ptr Remote)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
remote
    IO (Maybe [Text]) -> IO () -> IO (Maybe [Text])
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr CString
result <- (Ptr (Ptr GError) -> IO (Ptr CString)) -> IO (Ptr CString)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr CString)) -> IO (Ptr CString))
-> (Ptr (Ptr GError) -> IO (Ptr CString)) -> IO (Ptr CString)
forall a b. (a -> b) -> a -> b
$ Ptr Remote -> Ptr (Ptr GError) -> IO (Ptr CString)
ggit_remote_get_push_specs Ptr Remote
remote'
        Maybe [Text]
maybeResult <- Ptr CString -> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CString
result ((Ptr CString -> IO [Text]) -> IO (Maybe [Text]))
-> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ \Ptr CString
result' -> do
            [Text]
result'' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result'
            (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result'
            Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result'
            [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
remote
        Maybe [Text] -> IO (Maybe [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Text]
maybeResult
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data RemoteGetPushSpecsMethodInfo
instance (signature ~ (m (Maybe [T.Text])), MonadIO m, IsRemote a) => O.MethodInfo RemoteGetPushSpecsMethodInfo a signature where
    overloadedMethod = remoteGetPushSpecs

#endif

-- method Remote::get_url
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "remote"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Remote" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GgitRemote." , 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_remote_get_url" ggit_remote_get_url :: 
    Ptr Remote ->                           -- remote : TInterface (Name {namespace = "Ggit", name = "Remote"})
    IO CString

-- | Gets the remote\'s url.
remoteGetUrl ::
    (B.CallStack.HasCallStack, MonadIO m, IsRemote a) =>
    a
    -- ^ /@remote@/: GgitRemote.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the url of /@remote@/ or 'P.Nothing'.
remoteGetUrl :: a -> m (Maybe Text)
remoteGetUrl a
remote = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Remote
remote' <- a -> IO (Ptr Remote)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
remote
    CString
result <- Ptr Remote -> IO CString
ggit_remote_get_url Ptr Remote
remote'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
remote
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data RemoteGetUrlMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsRemote a) => O.MethodInfo RemoteGetUrlMethodInfo a signature where
    overloadedMethod = remoteGetUrl

#endif

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

foreign import ccall "ggit_remote_list" ggit_remote_list :: 
    Ptr Remote ->                           -- remote : TInterface (Name {namespace = "Ggit", name = "Remote"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr (Ptr Ggit.RemoteHead.RemoteHead))

-- | Get a list of refs at the remote.
remoteList ::
    (B.CallStack.HasCallStack, MonadIO m, IsRemote a) =>
    a
    -- ^ /@remote@/: a t'GI.Ggit.Objects.Remote.Remote'.
    -> m (Maybe [Ggit.RemoteHead.RemoteHead])
    -- ^ __Returns:__ the remote heads or 'P.Nothing'. /(Can throw 'Data.GI.Base.GError.GError')/
remoteList :: a -> m (Maybe [RemoteHead])
remoteList a
remote = IO (Maybe [RemoteHead]) -> m (Maybe [RemoteHead])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [RemoteHead]) -> m (Maybe [RemoteHead]))
-> IO (Maybe [RemoteHead]) -> m (Maybe [RemoteHead])
forall a b. (a -> b) -> a -> b
$ do
    Ptr Remote
remote' <- a -> IO (Ptr Remote)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
remote
    IO (Maybe [RemoteHead]) -> IO () -> IO (Maybe [RemoteHead])
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr (Ptr RemoteHead)
result <- (Ptr (Ptr GError) -> IO (Ptr (Ptr RemoteHead)))
-> IO (Ptr (Ptr RemoteHead))
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr (Ptr RemoteHead)))
 -> IO (Ptr (Ptr RemoteHead)))
-> (Ptr (Ptr GError) -> IO (Ptr (Ptr RemoteHead)))
-> IO (Ptr (Ptr RemoteHead))
forall a b. (a -> b) -> a -> b
$ Ptr Remote -> Ptr (Ptr GError) -> IO (Ptr (Ptr RemoteHead))
ggit_remote_list Ptr Remote
remote'
        Maybe [RemoteHead]
maybeResult <- Ptr (Ptr RemoteHead)
-> (Ptr (Ptr RemoteHead) -> IO [RemoteHead])
-> IO (Maybe [RemoteHead])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr (Ptr RemoteHead)
result ((Ptr (Ptr RemoteHead) -> IO [RemoteHead])
 -> IO (Maybe [RemoteHead]))
-> (Ptr (Ptr RemoteHead) -> IO [RemoteHead])
-> IO (Maybe [RemoteHead])
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr RemoteHead)
result' -> do
            [Ptr RemoteHead]
result'' <- Ptr (Ptr RemoteHead) -> IO [Ptr RemoteHead]
forall a. Ptr (Ptr a) -> IO [Ptr a]
unpackZeroTerminatedPtrArray Ptr (Ptr RemoteHead)
result'
            [RemoteHead]
result''' <- (Ptr RemoteHead -> IO RemoteHead)
-> [Ptr RemoteHead] -> IO [RemoteHead]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr RemoteHead -> RemoteHead)
-> Ptr RemoteHead -> IO RemoteHead
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr RemoteHead -> RemoteHead
Ggit.RemoteHead.RemoteHead) [Ptr RemoteHead]
result''
            Ptr (Ptr RemoteHead) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr RemoteHead)
result'
            [RemoteHead] -> IO [RemoteHead]
forall (m :: * -> *) a. Monad m => a -> m a
return [RemoteHead]
result'''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
remote
        Maybe [RemoteHead] -> IO (Maybe [RemoteHead])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [RemoteHead]
maybeResult
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data RemoteListMethodInfo
instance (signature ~ (m (Maybe [Ggit.RemoteHead.RemoteHead])), MonadIO m, IsRemote a) => O.MethodInfo RemoteListMethodInfo a signature where
    overloadedMethod = remoteList

#endif

-- method Remote::push
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "remote"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Remote" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitRemote." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "specs"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the ref specs." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "push_options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "PushOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitPushOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ggit_remote_push" ggit_remote_push :: 
    Ptr Remote ->                           -- remote : TInterface (Name {namespace = "Ggit", name = "Remote"})
    Ptr CString ->                          -- specs : TCArray True (-1) (-1) (TBasicType TUTF8)
    Ptr Ggit.PushOptions.PushOptions ->     -- push_options : TInterface (Name {namespace = "Ggit", name = "PushOptions"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Connect to the remote if not yet connected, negotiate with the remote
-- about which objects are missing, create a packfile with the missing
-- objects and send it.
remotePush ::
    (B.CallStack.HasCallStack, MonadIO m, IsRemote a, Ggit.PushOptions.IsPushOptions b) =>
    a
    -- ^ /@remote@/: a t'GI.Ggit.Objects.Remote.Remote'.
    -> Maybe ([T.Text])
    -- ^ /@specs@/: the ref specs.
    -> b
    -- ^ /@pushOptions@/: a t'GI.Ggit.Objects.PushOptions.PushOptions'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
remotePush :: a -> Maybe [Text] -> b -> m ()
remotePush a
remote Maybe [Text]
specs b
pushOptions = 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 Remote
remote' <- a -> IO (Ptr Remote)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
remote
    Ptr CString
maybeSpecs <- case Maybe [Text]
specs of
        Maybe [Text]
Nothing -> Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just [Text]
jSpecs -> do
            Ptr CString
jSpecs' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
jSpecs
            Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jSpecs'
    Ptr PushOptions
pushOptions' <- b -> IO (Ptr PushOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
pushOptions
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Remote
-> Ptr CString -> Ptr PushOptions -> Ptr (Ptr GError) -> IO CInt
ggit_remote_push Ptr Remote
remote' Ptr CString
maybeSpecs Ptr PushOptions
pushOptions'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
remote
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
pushOptions
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeSpecs
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeSpecs
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeSpecs
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeSpecs
     )

#if defined(ENABLE_OVERLOADING)
data RemotePushMethodInfo
instance (signature ~ (Maybe ([T.Text]) -> b -> m ()), MonadIO m, IsRemote a, Ggit.PushOptions.IsPushOptions b) => O.MethodInfo RemotePushMethodInfo a signature where
    overloadedMethod = remotePush

#endif

-- method Remote::update_tips
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "remote"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Remote" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitRemote." , 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 = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitRemoteCallbacks."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "update_fetch_head"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "whether to write to FETCH_HEAD. %TRUE to behave like git."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tags_type"
--           , argType =
--               TInterface
--                 Name { namespace = "Ggit" , name = "RemoteDownloadTagsType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "what the behaviour for downloading tags is for this fetch. This is\n            ignored for push. This must be the same value passed to\n            ggit_remote_download()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "message"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "reflog_message The message to insert into the reflogs. If\n                        %NULL and fetching, the default is \"fetch <name>\",\n                        where <name> is the name of the remote (or its url,\n                        for in-memory remotes). This parameter is ignored when pushing."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ggit_remote_update_tips" ggit_remote_update_tips :: 
    Ptr Remote ->                           -- remote : TInterface (Name {namespace = "Ggit", name = "Remote"})
    Ptr Ggit.RemoteCallbacks.RemoteCallbacks -> -- callbacks : TInterface (Name {namespace = "Ggit", name = "RemoteCallbacks"})
    CInt ->                                 -- update_fetch_head : TBasicType TBoolean
    CUInt ->                                -- tags_type : TInterface (Name {namespace = "Ggit", name = "RemoteDownloadTagsType"})
    CString ->                              -- message : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Update tips to the new state.
remoteUpdateTips ::
    (B.CallStack.HasCallStack, MonadIO m, IsRemote a, Ggit.RemoteCallbacks.IsRemoteCallbacks b) =>
    a
    -- ^ /@remote@/: a t'GI.Ggit.Objects.Remote.Remote'.
    -> b
    -- ^ /@callbacks@/: a t'GI.Ggit.Objects.RemoteCallbacks.RemoteCallbacks'.
    -> Bool
    -- ^ /@updateFetchHead@/: whether to write to FETCH_HEAD. 'P.True' to behave like git.
    -> Ggit.Enums.RemoteDownloadTagsType
    -- ^ /@tagsType@/: what the behaviour for downloading tags is for this fetch. This is
    --             ignored for push. This must be the same value passed to
    --             'GI.Ggit.Objects.Remote.remoteDownload'.
    -> Maybe (T.Text)
    -- ^ /@message@/: reflog_message The message to insert into the reflogs. If
    --                         'P.Nothing' and fetching, the default is \"fetch \<name>\",
    --                         where \<name> is the name of the remote (or its url,
    --                         for in-memory remotes). This parameter is ignored when pushing.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
remoteUpdateTips :: a -> b -> Bool -> RemoteDownloadTagsType -> Maybe Text -> m ()
remoteUpdateTips a
remote b
callbacks Bool
updateFetchHead RemoteDownloadTagsType
tagsType Maybe Text
message = 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 Remote
remote' <- a -> IO (Ptr Remote)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
remote
    Ptr RemoteCallbacks
callbacks' <- b -> IO (Ptr RemoteCallbacks)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
callbacks
    let updateFetchHead' :: CInt
updateFetchHead' = (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
updateFetchHead
    let tagsType' :: CUInt
tagsType' = (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
tagsType
    CString
maybeMessage <- case Maybe Text
message of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jMessage -> do
            CString
jMessage' <- Text -> IO CString
textToCString Text
jMessage
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jMessage'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Remote
-> Ptr RemoteCallbacks
-> CInt
-> CUInt
-> CString
-> Ptr (Ptr GError)
-> IO CInt
ggit_remote_update_tips Ptr Remote
remote' Ptr RemoteCallbacks
callbacks' CInt
updateFetchHead' CUInt
tagsType' CString
maybeMessage
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
remote
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
callbacks
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeMessage
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeMessage
     )

#if defined(ENABLE_OVERLOADING)
data RemoteUpdateTipsMethodInfo
instance (signature ~ (b -> Bool -> Ggit.Enums.RemoteDownloadTagsType -> Maybe (T.Text) -> m ()), MonadIO m, IsRemote a, Ggit.RemoteCallbacks.IsRemoteCallbacks b) => O.MethodInfo RemoteUpdateTipsMethodInfo a signature where
    overloadedMethod = remoteUpdateTips

#endif

-- method Remote::upload
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "remote"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Remote" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitRemote." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "specs"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the ref specs." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "push_options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "PushOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitPushOptions" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ggit_remote_upload" ggit_remote_upload :: 
    Ptr Remote ->                           -- remote : TInterface (Name {namespace = "Ggit", name = "Remote"})
    Ptr CString ->                          -- specs : TCArray True (-1) (-1) (TBasicType TUTF8)
    Ptr Ggit.PushOptions.PushOptions ->     -- push_options : TInterface (Name {namespace = "Ggit", name = "PushOptions"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Create a packfile and send it to the server
remoteUpload ::
    (B.CallStack.HasCallStack, MonadIO m, IsRemote a, Ggit.PushOptions.IsPushOptions b) =>
    a
    -- ^ /@remote@/: a t'GI.Ggit.Objects.Remote.Remote'.
    -> Maybe ([T.Text])
    -- ^ /@specs@/: the ref specs.
    -> b
    -- ^ /@pushOptions@/: a t'GI.Ggit.Objects.PushOptions.PushOptions'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
remoteUpload :: a -> Maybe [Text] -> b -> m ()
remoteUpload a
remote Maybe [Text]
specs b
pushOptions = 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 Remote
remote' <- a -> IO (Ptr Remote)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
remote
    Ptr CString
maybeSpecs <- case Maybe [Text]
specs of
        Maybe [Text]
Nothing -> Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just [Text]
jSpecs -> do
            Ptr CString
jSpecs' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
jSpecs
            Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jSpecs'
    Ptr PushOptions
pushOptions' <- b -> IO (Ptr PushOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
pushOptions
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Remote
-> Ptr CString -> Ptr PushOptions -> Ptr (Ptr GError) -> IO CInt
ggit_remote_upload Ptr Remote
remote' Ptr CString
maybeSpecs Ptr PushOptions
pushOptions'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
remote
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
pushOptions
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeSpecs
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeSpecs
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeSpecs
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeSpecs
     )

#if defined(ENABLE_OVERLOADING)
data RemoteUploadMethodInfo
instance (signature ~ (Maybe ([T.Text]) -> b -> m ()), MonadIO m, IsRemote a, Ggit.PushOptions.IsPushOptions b) => O.MethodInfo RemoteUploadMethodInfo a signature where
    overloadedMethod = remoteUpload

#endif