{-# LANGUAGE TypeApplications #-}


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

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

module GI.Ggit.Structs.RemoteHead
    ( 

-- * Exported types
    RemoteHead(..)                          ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [isLocal]("GI.Ggit.Structs.RemoteHead#g:method:isLocal"), [ref]("GI.Ggit.Structs.RemoteHead#g:method:ref"), [unref]("GI.Ggit.Structs.RemoteHead#g:method:unref").
-- 
-- ==== Getters
-- [getLocalOid]("GI.Ggit.Structs.RemoteHead#g:method:getLocalOid"), [getName]("GI.Ggit.Structs.RemoteHead#g:method:getName"), [getOid]("GI.Ggit.Structs.RemoteHead#g:method:getOid").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveRemoteHeadMethod                 ,
#endif

-- ** getLocalOid #method:getLocalOid#

#if defined(ENABLE_OVERLOADING)
    RemoteHeadGetLocalOidMethodInfo         ,
#endif
    remoteHeadGetLocalOid                   ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    RemoteHeadGetNameMethodInfo             ,
#endif
    remoteHeadGetName                       ,


-- ** getOid #method:getOid#

#if defined(ENABLE_OVERLOADING)
    RemoteHeadGetOidMethodInfo              ,
#endif
    remoteHeadGetOid                        ,


-- ** isLocal #method:isLocal#

#if defined(ENABLE_OVERLOADING)
    RemoteHeadIsLocalMethodInfo             ,
#endif
    remoteHeadIsLocal                       ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    RemoteHeadRefMethodInfo                 ,
#endif
    remoteHeadRef                           ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    RemoteHeadUnrefMethodInfo               ,
#endif
    remoteHeadUnref                         ,




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

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

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

foreign import ccall "ggit_remote_head_get_type" c_ggit_remote_head_get_type :: 
    IO GType

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

instance B.Types.TypedObject RemoteHead where
    glibType :: IO GType
glibType = IO GType
c_ggit_remote_head_get_type

instance B.Types.GBoxed RemoteHead

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


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList RemoteHead
type instance O.AttributeList RemoteHead = RemoteHeadAttributeList
type RemoteHeadAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

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

foreign import ccall "ggit_remote_head_get_local_oid" ggit_remote_head_get_local_oid :: 
    Ptr RemoteHead ->                       -- remote_head : TInterface (Name {namespace = "Ggit", name = "RemoteHead"})
    IO (Ptr Ggit.OId.OId)

-- | Get the local oid of the remote head.
remoteHeadGetLocalOid ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RemoteHead
    -- ^ /@remoteHead@/: a t'GI.Ggit.Structs.RemoteHead.RemoteHead'.
    -> m (Maybe Ggit.OId.OId)
    -- ^ __Returns:__ the local oid or 'P.Nothing'.
remoteHeadGetLocalOid :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RemoteHead -> m (Maybe OId)
remoteHeadGetLocalOid RemoteHead
remoteHead = IO (Maybe OId) -> m (Maybe OId)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe OId) -> m (Maybe OId))
-> IO (Maybe OId) -> m (Maybe OId)
forall a b. (a -> b) -> a -> b
$ do
    Ptr RemoteHead
remoteHead' <- RemoteHead -> IO (Ptr RemoteHead)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RemoteHead
remoteHead
    Ptr OId
result <- Ptr RemoteHead -> IO (Ptr OId)
ggit_remote_head_get_local_oid Ptr RemoteHead
remoteHead'
    Maybe OId
maybeResult <- Ptr OId -> (Ptr OId -> IO OId) -> IO (Maybe OId)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr OId
result ((Ptr OId -> IO OId) -> IO (Maybe OId))
-> (Ptr OId -> IO OId) -> IO (Maybe OId)
forall a b. (a -> b) -> a -> b
$ \Ptr OId
result' -> do
        OId
result'' <- ((ManagedPtr OId -> OId) -> Ptr OId -> IO OId
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr OId -> OId
Ggit.OId.OId) Ptr OId
result'
        OId -> IO OId
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return OId
result''
    RemoteHead -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RemoteHead
remoteHead
    Maybe OId -> IO (Maybe OId)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe OId
maybeResult

#if defined(ENABLE_OVERLOADING)
data RemoteHeadGetLocalOidMethodInfo
instance (signature ~ (m (Maybe Ggit.OId.OId)), MonadIO m) => O.OverloadedMethod RemoteHeadGetLocalOidMethodInfo RemoteHead signature where
    overloadedMethod = remoteHeadGetLocalOid

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


#endif

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

-- | Get the remote head name.
remoteHeadGetName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RemoteHead
    -- ^ /@remoteHead@/: a t'GI.Ggit.Structs.RemoteHead.RemoteHead'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the remote head name or 'P.Nothing'.
remoteHeadGetName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RemoteHead -> m (Maybe Text)
remoteHeadGetName RemoteHead
remoteHead = 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 RemoteHead
remoteHead' <- RemoteHead -> IO (Ptr RemoteHead)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RemoteHead
remoteHead
    CString
result <- Ptr RemoteHead -> IO CString
ggit_remote_head_get_name Ptr RemoteHead
remoteHead'
    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''
    RemoteHead -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RemoteHead
remoteHead
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data RemoteHeadGetNameMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod RemoteHeadGetNameMethodInfo RemoteHead signature where
    overloadedMethod = remoteHeadGetName

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


#endif

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

foreign import ccall "ggit_remote_head_get_oid" ggit_remote_head_get_oid :: 
    Ptr RemoteHead ->                       -- remote_head : TInterface (Name {namespace = "Ggit", name = "RemoteHead"})
    IO (Ptr Ggit.OId.OId)

-- | Get the remote oid of the remote head.
remoteHeadGetOid ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RemoteHead
    -- ^ /@remoteHead@/: a t'GI.Ggit.Structs.RemoteHead.RemoteHead'.
    -> m (Maybe Ggit.OId.OId)
    -- ^ __Returns:__ the remote oid or 'P.Nothing'.
remoteHeadGetOid :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RemoteHead -> m (Maybe OId)
remoteHeadGetOid RemoteHead
remoteHead = IO (Maybe OId) -> m (Maybe OId)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe OId) -> m (Maybe OId))
-> IO (Maybe OId) -> m (Maybe OId)
forall a b. (a -> b) -> a -> b
$ do
    Ptr RemoteHead
remoteHead' <- RemoteHead -> IO (Ptr RemoteHead)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RemoteHead
remoteHead
    Ptr OId
result <- Ptr RemoteHead -> IO (Ptr OId)
ggit_remote_head_get_oid Ptr RemoteHead
remoteHead'
    Maybe OId
maybeResult <- Ptr OId -> (Ptr OId -> IO OId) -> IO (Maybe OId)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr OId
result ((Ptr OId -> IO OId) -> IO (Maybe OId))
-> (Ptr OId -> IO OId) -> IO (Maybe OId)
forall a b. (a -> b) -> a -> b
$ \Ptr OId
result' -> do
        OId
result'' <- ((ManagedPtr OId -> OId) -> Ptr OId -> IO OId
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr OId -> OId
Ggit.OId.OId) Ptr OId
result'
        OId -> IO OId
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return OId
result''
    RemoteHead -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RemoteHead
remoteHead
    Maybe OId -> IO (Maybe OId)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe OId
maybeResult

#if defined(ENABLE_OVERLOADING)
data RemoteHeadGetOidMethodInfo
instance (signature ~ (m (Maybe Ggit.OId.OId)), MonadIO m) => O.OverloadedMethod RemoteHeadGetOidMethodInfo RemoteHead signature where
    overloadedMethod = remoteHeadGetOid

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


#endif

-- method RemoteHead::is_local
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "remote_head"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "RemoteHead" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitRemoteHead." , 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_head_is_local" ggit_remote_head_is_local :: 
    Ptr RemoteHead ->                       -- remote_head : TInterface (Name {namespace = "Ggit", name = "RemoteHead"})
    IO CInt

-- | Get whether the remote head is local.
remoteHeadIsLocal ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RemoteHead
    -- ^ /@remoteHead@/: a t'GI.Ggit.Structs.RemoteHead.RemoteHead'.
    -> m Bool
    -- ^ __Returns:__ whether the remote head is local.
remoteHeadIsLocal :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RemoteHead -> m Bool
remoteHeadIsLocal RemoteHead
remoteHead = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr RemoteHead
remoteHead' <- RemoteHead -> IO (Ptr RemoteHead)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RemoteHead
remoteHead
    CInt
result <- Ptr RemoteHead -> IO CInt
ggit_remote_head_is_local Ptr RemoteHead
remoteHead'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    RemoteHead -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RemoteHead
remoteHead
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RemoteHeadIsLocalMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod RemoteHeadIsLocalMethodInfo RemoteHead signature where
    overloadedMethod = remoteHeadIsLocal

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


#endif

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

foreign import ccall "ggit_remote_head_ref" ggit_remote_head_ref :: 
    Ptr RemoteHead ->                       -- remote_head : TInterface (Name {namespace = "Ggit", name = "RemoteHead"})
    IO (Ptr RemoteHead)

-- | /No description available in the introspection data./
remoteHeadRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RemoteHead
    -> m RemoteHead
remoteHeadRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RemoteHead -> m RemoteHead
remoteHeadRef RemoteHead
remoteHead = IO RemoteHead -> m RemoteHead
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RemoteHead -> m RemoteHead) -> IO RemoteHead -> m RemoteHead
forall a b. (a -> b) -> a -> b
$ do
    Ptr RemoteHead
remoteHead' <- RemoteHead -> IO (Ptr RemoteHead)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RemoteHead
remoteHead
    Ptr RemoteHead
result <- Ptr RemoteHead -> IO (Ptr RemoteHead)
ggit_remote_head_ref Ptr RemoteHead
remoteHead'
    Text -> Ptr RemoteHead -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"remoteHeadRef" Ptr RemoteHead
result
    RemoteHead
result' <- ((ManagedPtr RemoteHead -> RemoteHead)
-> Ptr RemoteHead -> IO RemoteHead
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr RemoteHead -> RemoteHead
RemoteHead) Ptr RemoteHead
result
    RemoteHead -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RemoteHead
remoteHead
    RemoteHead -> IO RemoteHead
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RemoteHead
result'

#if defined(ENABLE_OVERLOADING)
data RemoteHeadRefMethodInfo
instance (signature ~ (m RemoteHead), MonadIO m) => O.OverloadedMethod RemoteHeadRefMethodInfo RemoteHead signature where
    overloadedMethod = remoteHeadRef

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


#endif

-- method RemoteHead::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "remote_head"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "RemoteHead" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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_head_unref" ggit_remote_head_unref :: 
    Ptr RemoteHead ->                       -- remote_head : TInterface (Name {namespace = "Ggit", name = "RemoteHead"})
    IO ()

-- | /No description available in the introspection data./
remoteHeadUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RemoteHead
    -> m ()
remoteHeadUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
RemoteHead -> m ()
remoteHeadUnref RemoteHead
remoteHead = 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 RemoteHead
remoteHead' <- RemoteHead -> IO (Ptr RemoteHead)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RemoteHead
remoteHead
    Ptr RemoteHead -> IO ()
ggit_remote_head_unref Ptr RemoteHead
remoteHead'
    RemoteHead -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RemoteHead
remoteHead
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RemoteHeadUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod RemoteHeadUnrefMethodInfo RemoteHead signature where
    overloadedMethod = remoteHeadUnref

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


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveRemoteHeadMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveRemoteHeadMethod "isLocal" o = RemoteHeadIsLocalMethodInfo
    ResolveRemoteHeadMethod "ref" o = RemoteHeadRefMethodInfo
    ResolveRemoteHeadMethod "unref" o = RemoteHeadUnrefMethodInfo
    ResolveRemoteHeadMethod "getLocalOid" o = RemoteHeadGetLocalOidMethodInfo
    ResolveRemoteHeadMethod "getName" o = RemoteHeadGetNameMethodInfo
    ResolveRemoteHeadMethod "getOid" o = RemoteHeadGetOidMethodInfo
    ResolveRemoteHeadMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif