{-# LANGUAGE TypeApplications #-}


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

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

module GI.Ggit.Objects.Branch
    ( 

-- * Exported types
    Branch(..)                              ,
    IsBranch                                ,
    toBranch                                ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [delete]("GI.Ggit.Objects.Branch#g:method:delete"), [deleteLog]("GI.Ggit.Objects.Ref#g:method:deleteLog"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasLog]("GI.Ggit.Objects.Ref#g:method:hasLog"), [isBranch]("GI.Ggit.Objects.Ref#g:method:isBranch"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isHead]("GI.Ggit.Objects.Branch#g:method:isHead"), [isNote]("GI.Ggit.Objects.Ref#g:method:isNote"), [isRemote]("GI.Ggit.Objects.Ref#g:method:isRemote"), [isTag]("GI.Ggit.Objects.Ref#g:method:isTag"), [lookup]("GI.Ggit.Objects.Ref#g:method:lookup"), [move]("GI.Ggit.Objects.Branch#g:method:move"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [rename]("GI.Ggit.Objects.Ref#g:method:rename"), [resolve]("GI.Ggit.Objects.Ref#g:method:resolve"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [toString]("GI.Ggit.Objects.Ref#g:method:toString"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getLog]("GI.Ggit.Objects.Ref#g:method:getLog"), [getName]("GI.Ggit.Objects.Branch#g:method:getName"), [getOwner]("GI.Ggit.Objects.Ref#g:method:getOwner"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getReferenceType]("GI.Ggit.Objects.Ref#g:method:getReferenceType"), [getShorthand]("GI.Ggit.Objects.Ref#g:method:getShorthand"), [getSymbolicTarget]("GI.Ggit.Objects.Ref#g:method:getSymbolicTarget"), [getTarget]("GI.Ggit.Objects.Ref#g:method:getTarget"), [getUpstream]("GI.Ggit.Objects.Branch#g:method:getUpstream").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSymbolicTarget]("GI.Ggit.Objects.Ref#g:method:setSymbolicTarget"), [setTarget]("GI.Ggit.Objects.Ref#g:method:setTarget"), [setUpstream]("GI.Ggit.Objects.Branch#g:method:setUpstream").

#if defined(ENABLE_OVERLOADING)
    ResolveBranchMethod                     ,
#endif

-- ** delete #method:delete#

#if defined(ENABLE_OVERLOADING)
    BranchDeleteMethodInfo                  ,
#endif
    branchDelete                            ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    BranchGetNameMethodInfo                 ,
#endif
    branchGetName                           ,


-- ** getUpstream #method:getUpstream#

#if defined(ENABLE_OVERLOADING)
    BranchGetUpstreamMethodInfo             ,
#endif
    branchGetUpstream                       ,


-- ** isHead #method:isHead#

#if defined(ENABLE_OVERLOADING)
    BranchIsHeadMethodInfo                  ,
#endif
    branchIsHead                            ,


-- ** move #method:move#

#if defined(ENABLE_OVERLOADING)
    BranchMoveMethodInfo                    ,
#endif
    branchMove                              ,


-- ** setUpstream #method:setUpstream#

#if defined(ENABLE_OVERLOADING)
    BranchSetUpstreamMethodInfo             ,
#endif
    branchSetUpstream                       ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Ggit.Flags as Ggit.Flags
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.Ref as Ggit.Ref

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

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

foreign import ccall "ggit_branch_get_type"
    c_ggit_branch_get_type :: IO B.Types.GType

instance B.Types.TypedObject Branch where
    glibType :: IO GType
glibType = IO GType
c_ggit_branch_get_type

instance B.Types.GObject Branch

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveBranchMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveBranchMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveBranchMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveBranchMethod "delete" o = BranchDeleteMethodInfo
    ResolveBranchMethod "deleteLog" o = Ggit.Ref.RefDeleteLogMethodInfo
    ResolveBranchMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveBranchMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveBranchMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveBranchMethod "hasLog" o = Ggit.Ref.RefHasLogMethodInfo
    ResolveBranchMethod "isBranch" o = Ggit.Ref.RefIsBranchMethodInfo
    ResolveBranchMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveBranchMethod "isHead" o = BranchIsHeadMethodInfo
    ResolveBranchMethod "isNote" o = Ggit.Ref.RefIsNoteMethodInfo
    ResolveBranchMethod "isRemote" o = Ggit.Ref.RefIsRemoteMethodInfo
    ResolveBranchMethod "isTag" o = Ggit.Ref.RefIsTagMethodInfo
    ResolveBranchMethod "lookup" o = Ggit.Ref.RefLookupMethodInfo
    ResolveBranchMethod "move" o = BranchMoveMethodInfo
    ResolveBranchMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveBranchMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveBranchMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveBranchMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveBranchMethod "rename" o = Ggit.Ref.RefRenameMethodInfo
    ResolveBranchMethod "resolve" o = Ggit.Ref.RefResolveMethodInfo
    ResolveBranchMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveBranchMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveBranchMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveBranchMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveBranchMethod "toString" o = Ggit.Ref.RefToStringMethodInfo
    ResolveBranchMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveBranchMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveBranchMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveBranchMethod "getLog" o = Ggit.Ref.RefGetLogMethodInfo
    ResolveBranchMethod "getName" o = BranchGetNameMethodInfo
    ResolveBranchMethod "getOwner" o = Ggit.Ref.RefGetOwnerMethodInfo
    ResolveBranchMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveBranchMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveBranchMethod "getReferenceType" o = Ggit.Ref.RefGetReferenceTypeMethodInfo
    ResolveBranchMethod "getShorthand" o = Ggit.Ref.RefGetShorthandMethodInfo
    ResolveBranchMethod "getSymbolicTarget" o = Ggit.Ref.RefGetSymbolicTargetMethodInfo
    ResolveBranchMethod "getTarget" o = Ggit.Ref.RefGetTargetMethodInfo
    ResolveBranchMethod "getUpstream" o = BranchGetUpstreamMethodInfo
    ResolveBranchMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveBranchMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveBranchMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveBranchMethod "setSymbolicTarget" o = Ggit.Ref.RefSetSymbolicTargetMethodInfo
    ResolveBranchMethod "setTarget" o = Ggit.Ref.RefSetTargetMethodInfo
    ResolveBranchMethod "setUpstream" o = BranchSetUpstreamMethodInfo
    ResolveBranchMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Branch
type instance O.AttributeList Branch = BranchAttributeList
type BranchAttributeList = ('[ '("native", Ggit.Native.NativeNativePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Branch = BranchSignalList
type BranchSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

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

foreign import ccall "ggit_branch_delete" ggit_branch_delete :: 
    Ptr Branch ->                           -- branch : TInterface (Name {namespace = "Ggit", name = "Branch"})
    Ptr (Ptr GError) ->                     -- error
    IO ()

-- | Deletes an existing branch reference.
-- 
-- If the branch is successfully deleted, this object is
-- not useful anymore and if should be freed with 'GI.GObject.Objects.Object.objectUnref'.
branchDelete ::
    (B.CallStack.HasCallStack, MonadIO m, IsBranch a) =>
    a
    -- ^ /@branch@/: a t'GI.Ggit.Objects.Branch.Branch'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
branchDelete :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBranch a) =>
a -> m ()
branchDelete a
branch = 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 Branch
branch' <- a -> IO (Ptr Branch)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
branch
    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 Branch -> Ptr (Ptr GError) -> IO ()
ggit_branch_delete Ptr Branch
branch'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
branch
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BranchDeleteMethodInfo
instance (signature ~ (m ()), MonadIO m, IsBranch a) => O.OverloadedMethod BranchDeleteMethodInfo a signature where
    overloadedMethod = branchDelete

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


#endif

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

foreign import ccall "ggit_branch_get_name" ggit_branch_get_name :: 
    Ptr Branch ->                           -- branch : TInterface (Name {namespace = "Ggit", name = "Branch"})
    Ptr (Ptr GError) ->                     -- error
    IO CString

-- | Gets the name of the given local or remote branch.
branchGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsBranch a) =>
    a
    -- ^ /@branch@/: a t'GI.Ggit.Objects.Branch.Branch'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the name of the given local or remote branch or 'P.Nothing'. /(Can throw 'Data.GI.Base.GError.GError')/
branchGetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBranch a) =>
a -> m (Maybe Text)
branchGetName a
branch = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Branch
branch' <- a -> IO (Ptr Branch)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
branch
    IO (Maybe Text) -> IO () -> IO (Maybe Text)
forall a b. IO a -> IO b -> IO a
onException (do
        CString
result <- (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CString) -> IO CString)
-> (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ Ptr Branch -> Ptr (Ptr GError) -> IO CString
ggit_branch_get_name Ptr Branch
branch'
        Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
            Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
            Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
branch
        Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BranchGetNameMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsBranch a) => O.OverloadedMethod BranchGetNameMethodInfo a signature where
    overloadedMethod = branchGetName

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


#endif

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

foreign import ccall "ggit_branch_get_upstream" ggit_branch_get_upstream :: 
    Ptr Branch ->                           -- branch : TInterface (Name {namespace = "Ggit", name = "Branch"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Ggit.Ref.Ref)

-- | Gets the reference supporting the remote tracking branch,
-- given a local branch reference.
branchGetUpstream ::
    (B.CallStack.HasCallStack, MonadIO m, IsBranch a) =>
    a
    -- ^ /@branch@/: a t'GI.Ggit.Objects.Branch.Branch'.
    -> m (Maybe Ggit.Ref.Ref)
    -- ^ __Returns:__ the reference supporting the remote tracking branch or 'P.Nothing'. /(Can throw 'Data.GI.Base.GError.GError')/
branchGetUpstream :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBranch a) =>
a -> m (Maybe Ref)
branchGetUpstream a
branch = IO (Maybe Ref) -> m (Maybe Ref)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Ref) -> m (Maybe Ref))
-> IO (Maybe Ref) -> m (Maybe Ref)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Branch
branch' <- a -> IO (Ptr Branch)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
branch
    IO (Maybe Ref) -> IO () -> IO (Maybe Ref)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Ref
result <- (Ptr (Ptr GError) -> IO (Ptr Ref)) -> IO (Ptr Ref)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Ref)) -> IO (Ptr Ref))
-> (Ptr (Ptr GError) -> IO (Ptr Ref)) -> IO (Ptr Ref)
forall a b. (a -> b) -> a -> b
$ Ptr Branch -> Ptr (Ptr GError) -> IO (Ptr Ref)
ggit_branch_get_upstream Ptr Branch
branch'
        Maybe Ref
maybeResult <- Ptr Ref -> (Ptr Ref -> IO Ref) -> IO (Maybe Ref)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Ref
result ((Ptr Ref -> IO Ref) -> IO (Maybe Ref))
-> (Ptr Ref -> IO Ref) -> IO (Maybe Ref)
forall a b. (a -> b) -> a -> b
$ \Ptr Ref
result' -> do
            Ref
result'' <- ((ManagedPtr Ref -> Ref) -> Ptr Ref -> IO Ref
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Ref -> Ref
Ggit.Ref.Ref) Ptr Ref
result'
            Ref -> IO Ref
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ref
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
branch
        Maybe Ref -> IO (Maybe Ref)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Ref
maybeResult
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BranchGetUpstreamMethodInfo
instance (signature ~ (m (Maybe Ggit.Ref.Ref)), MonadIO m, IsBranch a) => O.OverloadedMethod BranchGetUpstreamMethodInfo a signature where
    overloadedMethod = branchGetUpstream

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


#endif

-- method Branch::is_head
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "branch"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Branch" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitBranch." , 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_branch_is_head" ggit_branch_is_head :: 
    Ptr Branch ->                           -- branch : TInterface (Name {namespace = "Ggit", name = "Branch"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Determines if the current local branch is pointed at by HEAD.
branchIsHead ::
    (B.CallStack.HasCallStack, MonadIO m, IsBranch a) =>
    a
    -- ^ /@branch@/: a t'GI.Ggit.Objects.Branch.Branch'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
branchIsHead :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBranch a) =>
a -> m ()
branchIsHead a
branch = 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 Branch
branch' <- a -> IO (Ptr Branch)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
branch
    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 Branch -> Ptr (Ptr GError) -> IO CInt
ggit_branch_is_head Ptr Branch
branch'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
branch
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BranchIsHeadMethodInfo
instance (signature ~ (m ()), MonadIO m, IsBranch a) => O.OverloadedMethod BranchIsHeadMethodInfo a signature where
    overloadedMethod = branchIsHead

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


#endif

-- method Branch::move
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "branch"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Branch" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitBranch." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "new_branch_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "target name of the branch once the move is performed; this name is validated for consistency."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "CreateFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitCreateFlags."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Ggit" , name = "Branch" })
-- throws : True
-- Skip return : False

foreign import ccall "ggit_branch_move" ggit_branch_move :: 
    Ptr Branch ->                           -- branch : TInterface (Name {namespace = "Ggit", name = "Branch"})
    CString ->                              -- new_branch_name : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "Ggit", name = "CreateFlags"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Branch)

-- | Moves\/renames an existing branch reference.
branchMove ::
    (B.CallStack.HasCallStack, MonadIO m, IsBranch a) =>
    a
    -- ^ /@branch@/: a t'GI.Ggit.Objects.Branch.Branch'.
    -> T.Text
    -- ^ /@newBranchName@/: target name of the branch once the move is performed; this name is validated for consistency.
    -> [Ggit.Flags.CreateFlags]
    -- ^ /@flags@/: a t'GI.Ggit.Flags.CreateFlags'.
    -> m (Maybe Branch)
    -- ^ __Returns:__ the new branch or 'P.Nothing'. /(Can throw 'Data.GI.Base.GError.GError')/
branchMove :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBranch a) =>
a -> Text -> [CreateFlags] -> m (Maybe Branch)
branchMove a
branch Text
newBranchName [CreateFlags]
flags = IO (Maybe Branch) -> m (Maybe Branch)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Branch) -> m (Maybe Branch))
-> IO (Maybe Branch) -> m (Maybe Branch)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Branch
branch' <- a -> IO (Ptr Branch)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
branch
    CString
newBranchName' <- Text -> IO CString
textToCString Text
newBranchName
    let flags' :: CUInt
flags' = [CreateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [CreateFlags]
flags
    IO (Maybe Branch) -> IO () -> IO (Maybe Branch)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Branch
result <- (Ptr (Ptr GError) -> IO (Ptr Branch)) -> IO (Ptr Branch)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Branch)) -> IO (Ptr Branch))
-> (Ptr (Ptr GError) -> IO (Ptr Branch)) -> IO (Ptr Branch)
forall a b. (a -> b) -> a -> b
$ Ptr Branch
-> CString -> CUInt -> Ptr (Ptr GError) -> IO (Ptr Branch)
ggit_branch_move Ptr Branch
branch' CString
newBranchName' CUInt
flags'
        Maybe Branch
maybeResult <- Ptr Branch -> (Ptr Branch -> IO Branch) -> IO (Maybe Branch)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Branch
result ((Ptr Branch -> IO Branch) -> IO (Maybe Branch))
-> (Ptr Branch -> IO Branch) -> IO (Maybe Branch)
forall a b. (a -> b) -> a -> b
$ \Ptr Branch
result' -> do
            Branch
result'' <- ((ManagedPtr Branch -> Branch) -> Ptr Branch -> IO Branch
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Branch -> Branch
Branch) Ptr Branch
result'
            Branch -> IO Branch
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Branch
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
branch
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
newBranchName'
        Maybe Branch -> IO (Maybe Branch)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Branch
maybeResult
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
newBranchName'
     )

#if defined(ENABLE_OVERLOADING)
data BranchMoveMethodInfo
instance (signature ~ (T.Text -> [Ggit.Flags.CreateFlags] -> m (Maybe Branch)), MonadIO m, IsBranch a) => O.OverloadedMethod BranchMoveMethodInfo a signature where
    overloadedMethod = branchMove

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


#endif

-- method Branch::set_upstream
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "branch"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Branch" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitBranch." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "upstream_branch_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "name of the upstream branch; if %NULL unsets it."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : True
-- Skip return : False

foreign import ccall "ggit_branch_set_upstream" ggit_branch_set_upstream :: 
    Ptr Branch ->                           -- branch : TInterface (Name {namespace = "Ggit", name = "Branch"})
    CString ->                              -- upstream_branch_name : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO ()

-- | Sets the upstream branch, for a given local branch reference
branchSetUpstream ::
    (B.CallStack.HasCallStack, MonadIO m, IsBranch a) =>
    a
    -- ^ /@branch@/: a t'GI.Ggit.Objects.Branch.Branch'.
    -> T.Text
    -- ^ /@upstreamBranchName@/: name of the upstream branch; if 'P.Nothing' unsets it.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
branchSetUpstream :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBranch a) =>
a -> Text -> m ()
branchSetUpstream a
branch Text
upstreamBranchName = 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 Branch
branch' <- a -> IO (Ptr Branch)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
branch
    CString
upstreamBranchName' <- Text -> IO CString
textToCString Text
upstreamBranchName
    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 Branch -> CString -> Ptr (Ptr GError) -> IO ()
ggit_branch_set_upstream Ptr Branch
branch' CString
upstreamBranchName'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
branch
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
upstreamBranchName'
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
upstreamBranchName'
     )

#if defined(ENABLE_OVERLOADING)
data BranchSetUpstreamMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsBranch a) => O.OverloadedMethod BranchSetUpstreamMethodInfo a signature where
    overloadedMethod = branchSetUpstream

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


#endif