{-# 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 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(..)                          ,
    noRemoteHead                            ,


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

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

-- | Memory-managed wrapper type.
newtype RemoteHead = RemoteHead (ManagedPtr RemoteHead)
    deriving (RemoteHead -> RemoteHead -> Bool
(RemoteHead -> RemoteHead -> Bool)
-> (RemoteHead -> RemoteHead -> Bool) -> Eq RemoteHead
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoteHead -> RemoteHead -> Bool
$c/= :: RemoteHead -> RemoteHead -> Bool
== :: RemoteHead -> RemoteHead -> Bool
$c== :: RemoteHead -> RemoteHead -> Bool
Eq)
foreign import ccall "ggit_remote_head_get_type" c_ggit_remote_head_get_type :: 
    IO GType

instance BoxedObject RemoteHead where
    boxedType :: RemoteHead -> IO GType
boxedType _ = IO GType
c_ggit_remote_head_get_type

-- | Convert 'RemoteHead' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue RemoteHead where
    toGValue :: RemoteHead -> IO GValue
toGValue o :: RemoteHead
o = do
        GType
gtype <- IO GType
c_ggit_remote_head_get_type
        RemoteHead -> (Ptr RemoteHead -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr RemoteHead
o (GType
-> (GValue -> Ptr RemoteHead -> IO ())
-> Ptr RemoteHead
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr RemoteHead -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO RemoteHead
fromGValue gv :: GValue
gv = do
        Ptr RemoteHead
ptr <- GValue -> IO (Ptr RemoteHead)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr RemoteHead)
        (ManagedPtr RemoteHead -> RemoteHead)
-> Ptr RemoteHead -> IO RemoteHead
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr RemoteHead -> RemoteHead
RemoteHead Ptr RemoteHead
ptr
        
    

-- | A convenience alias for `Nothing` :: `Maybe` `RemoteHead`.
noRemoteHead :: Maybe RemoteHead
noRemoteHead :: Maybe RemoteHead
noRemoteHead = Maybe RemoteHead
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList RemoteHead
type instance O.AttributeList RemoteHead = RemoteHeadAttributeList
type RemoteHeadAttributeList = ('[ ] :: [(Symbol, *)])
#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 :: RemoteHead -> m (Maybe OId)
remoteHeadGetLocalOid remoteHead :: RemoteHead
remoteHead = IO (Maybe OId) -> m (Maybe OId)
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
$ \result' :: Ptr OId
result' -> do
        OId
result'' <- ((ManagedPtr OId -> OId) -> Ptr OId -> IO OId
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr OId -> OId
Ggit.OId.OId) Ptr OId
result'
        OId -> IO OId
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 (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.MethodInfo RemoteHeadGetLocalOidMethodInfo RemoteHead signature where
    overloadedMethod = 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 :: RemoteHead -> m (Maybe Text)
remoteHeadGetName remoteHead :: RemoteHead
remoteHead = 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 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
$ \result' :: 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''
    RemoteHead -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RemoteHead
remoteHead
    Maybe Text -> IO (Maybe Text)
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.MethodInfo RemoteHeadGetNameMethodInfo RemoteHead signature where
    overloadedMethod = 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 :: RemoteHead -> m (Maybe OId)
remoteHeadGetOid remoteHead :: RemoteHead
remoteHead = IO (Maybe OId) -> m (Maybe OId)
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
$ \result' :: Ptr OId
result' -> do
        OId
result'' <- ((ManagedPtr OId -> OId) -> Ptr OId -> IO OId
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr OId -> OId
Ggit.OId.OId) Ptr OId
result'
        OId -> IO OId
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 (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.MethodInfo RemoteHeadGetOidMethodInfo RemoteHead signature where
    overloadedMethod = 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 :: RemoteHead -> m Bool
remoteHeadIsLocal remoteHead :: RemoteHead
remoteHead = 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 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
/= 0) CInt
result
    RemoteHead -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RemoteHead
remoteHead
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RemoteHeadIsLocalMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo RemoteHeadIsLocalMethodInfo RemoteHead signature where
    overloadedMethod = 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 :: RemoteHead -> m RemoteHead
remoteHeadRef remoteHead :: RemoteHead
remoteHead = IO RemoteHead -> m RemoteHead
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 "remoteHeadRef" Ptr RemoteHead
result
    RemoteHead
result' <- ((ManagedPtr RemoteHead -> RemoteHead)
-> Ptr RemoteHead -> IO RemoteHead
forall a.
(HasCallStack, BoxedObject 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 (m :: * -> *) a. Monad m => a -> m a
return RemoteHead
result'

#if defined(ENABLE_OVERLOADING)
data RemoteHeadRefMethodInfo
instance (signature ~ (m RemoteHead), MonadIO m) => O.MethodInfo RemoteHeadRefMethodInfo RemoteHead signature where
    overloadedMethod = 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 :: RemoteHead -> m ()
remoteHeadUnref remoteHead :: RemoteHead
remoteHead = 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 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 (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveRemoteHeadMethod (t :: Symbol) (o :: *) :: * 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.MethodInfo 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

#endif