{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Represents the parents of a commit object.

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

module GI.Ggit.Objects.CommitParents
    ( 

-- * Exported types
    CommitParents(..)                       ,
    IsCommitParents                         ,
    toCommitParents                         ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveCommitParentsMethod              ,
#endif


-- ** get #method:get#

#if defined(ENABLE_OVERLOADING)
    CommitParentsGetMethodInfo              ,
#endif
    commitParentsGet                        ,


-- ** getId #method:getId#

#if defined(ENABLE_OVERLOADING)
    CommitParentsGetIdMethodInfo            ,
#endif
    commitParentsGetId                      ,


-- ** getSize #method:getSize#

#if defined(ENABLE_OVERLOADING)
    CommitParentsGetSizeMethodInfo          ,
#endif
    commitParentsGetSize                    ,


-- ** new #method:new#

    commitParentsNew                        ,




 -- * Properties
-- ** commit #attr:commit#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    CommitParentsCommitPropertyInfo         ,
#endif
#if defined(ENABLE_OVERLOADING)
    commitParentsCommit                     ,
#endif
    constructCommitParentsCommit            ,
    getCommitParentsCommit                  ,


-- ** size #attr:size#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    CommitParentsSizePropertyInfo           ,
#endif
#if defined(ENABLE_OVERLOADING)
    commitParentsSize                       ,
#endif
    getCommitParentsSize                    ,




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

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

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

foreign import ccall "ggit_commit_parents_get_type"
    c_ggit_commit_parents_get_type :: IO B.Types.GType

instance B.Types.TypedObject CommitParents where
    glibType :: IO GType
glibType = IO GType
c_ggit_commit_parents_get_type

instance B.Types.GObject CommitParents

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

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

instance O.HasParentTypes CommitParents
type instance O.ParentTypes CommitParents = '[GObject.Object.Object]

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

#if defined(ENABLE_OVERLOADING)
type family ResolveCommitParentsMethod (t :: Symbol) (o :: *) :: * where
    ResolveCommitParentsMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveCommitParentsMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveCommitParentsMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveCommitParentsMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveCommitParentsMethod "get" o = CommitParentsGetMethodInfo
    ResolveCommitParentsMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveCommitParentsMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveCommitParentsMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveCommitParentsMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveCommitParentsMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveCommitParentsMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveCommitParentsMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveCommitParentsMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveCommitParentsMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveCommitParentsMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveCommitParentsMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveCommitParentsMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveCommitParentsMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveCommitParentsMethod "getId" o = CommitParentsGetIdMethodInfo
    ResolveCommitParentsMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveCommitParentsMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveCommitParentsMethod "getSize" o = CommitParentsGetSizeMethodInfo
    ResolveCommitParentsMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveCommitParentsMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveCommitParentsMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveCommitParentsMethod l o = O.MethodResolutionFailed l o

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

#endif

-- VVV Prop "commit"
   -- Type: TInterface (Name {namespace = "Ggit", name = "Commit"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@commit@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' commitParents #commit
-- @
getCommitParentsCommit :: (MonadIO m, IsCommitParents o) => o -> m (Maybe Ggit.Commit.Commit)
getCommitParentsCommit :: o -> m (Maybe Commit)
getCommitParentsCommit o
obj = IO (Maybe Commit) -> m (Maybe Commit)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Commit) -> m (Maybe Commit))
-> IO (Maybe Commit) -> m (Maybe Commit)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Commit -> Commit) -> IO (Maybe Commit)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"commit" ManagedPtr Commit -> Commit
Ggit.Commit.Commit

-- | Construct a `GValueConstruct` with valid value for the “@commit@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCommitParentsCommit :: (IsCommitParents o, MIO.MonadIO m, Ggit.Commit.IsCommit a) => a -> m (GValueConstruct o)
constructCommitParentsCommit :: a -> m (GValueConstruct o)
constructCommitParentsCommit a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"commit" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data CommitParentsCommitPropertyInfo
instance AttrInfo CommitParentsCommitPropertyInfo where
    type AttrAllowedOps CommitParentsCommitPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint CommitParentsCommitPropertyInfo = IsCommitParents
    type AttrSetTypeConstraint CommitParentsCommitPropertyInfo = Ggit.Commit.IsCommit
    type AttrTransferTypeConstraint CommitParentsCommitPropertyInfo = Ggit.Commit.IsCommit
    type AttrTransferType CommitParentsCommitPropertyInfo = Ggit.Commit.Commit
    type AttrGetType CommitParentsCommitPropertyInfo = (Maybe Ggit.Commit.Commit)
    type AttrLabel CommitParentsCommitPropertyInfo = "commit"
    type AttrOrigin CommitParentsCommitPropertyInfo = CommitParents
    attrGet = getCommitParentsCommit
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Ggit.Commit.Commit v
    attrConstruct = constructCommitParentsCommit
    attrClear = undefined
#endif

-- VVV Prop "size"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' commitParents #size
-- @
getCommitParentsSize :: (MonadIO m, IsCommitParents o) => o -> m Word32
getCommitParentsSize :: o -> m Word32
getCommitParentsSize o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"size"

#if defined(ENABLE_OVERLOADING)
data CommitParentsSizePropertyInfo
instance AttrInfo CommitParentsSizePropertyInfo where
    type AttrAllowedOps CommitParentsSizePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint CommitParentsSizePropertyInfo = IsCommitParents
    type AttrSetTypeConstraint CommitParentsSizePropertyInfo = (~) ()
    type AttrTransferTypeConstraint CommitParentsSizePropertyInfo = (~) ()
    type AttrTransferType CommitParentsSizePropertyInfo = ()
    type AttrGetType CommitParentsSizePropertyInfo = Word32
    type AttrLabel CommitParentsSizePropertyInfo = "size"
    type AttrOrigin CommitParentsSizePropertyInfo = CommitParents
    attrGet = getCommitParentsSize
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList CommitParents
type instance O.AttributeList CommitParents = CommitParentsAttributeList
type CommitParentsAttributeList = ('[ '("commit", CommitParentsCommitPropertyInfo), '("size", CommitParentsSizePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
commitParentsCommit :: AttrLabelProxy "commit"
commitParentsCommit = AttrLabelProxy

commitParentsSize :: AttrLabelProxy "size"
commitParentsSize = AttrLabelProxy

#endif

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

#endif

-- method CommitParents::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "commit"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Commit" }
--           , 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 = "CommitParents" })
-- throws : False
-- Skip return : False

foreign import ccall "ggit_commit_parents_new" ggit_commit_parents_new :: 
    Ptr Ggit.Commit.Commit ->               -- commit : TInterface (Name {namespace = "Ggit", name = "Commit"})
    IO (Ptr CommitParents)

-- | /No description available in the introspection data./
commitParentsNew ::
    (B.CallStack.HasCallStack, MonadIO m, Ggit.Commit.IsCommit a) =>
    a
    -> m CommitParents
commitParentsNew :: a -> m CommitParents
commitParentsNew a
commit = IO CommitParents -> m CommitParents
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CommitParents -> m CommitParents)
-> IO CommitParents -> m CommitParents
forall a b. (a -> b) -> a -> b
$ do
    Ptr Commit
commit' <- a -> IO (Ptr Commit)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
commit
    Ptr CommitParents
result <- Ptr Commit -> IO (Ptr CommitParents)
ggit_commit_parents_new Ptr Commit
commit'
    Text -> Ptr CommitParents -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"commitParentsNew" Ptr CommitParents
result
    CommitParents
result' <- ((ManagedPtr CommitParents -> CommitParents)
-> Ptr CommitParents -> IO CommitParents
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr CommitParents -> CommitParents
CommitParents) Ptr CommitParents
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
commit
    CommitParents -> IO CommitParents
forall (m :: * -> *) a. Monad m => a -> m a
return CommitParents
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method CommitParents::get
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parents"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "CommitParents" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitCommitParents."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "idx"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent index." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Ggit" , name = "Commit" })
-- throws : False
-- Skip return : False

foreign import ccall "ggit_commit_parents_get" ggit_commit_parents_get :: 
    Ptr CommitParents ->                    -- parents : TInterface (Name {namespace = "Ggit", name = "CommitParents"})
    Word32 ->                               -- idx : TBasicType TUInt
    IO (Ptr Ggit.Commit.Commit)

-- | Get the t'GI.Ggit.Objects.Commit.Commit' of a parent.
commitParentsGet ::
    (B.CallStack.HasCallStack, MonadIO m, IsCommitParents a) =>
    a
    -- ^ /@parents@/: a t'GI.Ggit.Objects.CommitParents.CommitParents'.
    -> Word32
    -- ^ /@idx@/: the parent index.
    -> m (Maybe Ggit.Commit.Commit)
    -- ^ __Returns:__ a t'GI.Ggit.Objects.Commit.Commit'.
commitParentsGet :: a -> Word32 -> m (Maybe Commit)
commitParentsGet a
parents Word32
idx = IO (Maybe Commit) -> m (Maybe Commit)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Commit) -> m (Maybe Commit))
-> IO (Maybe Commit) -> m (Maybe Commit)
forall a b. (a -> b) -> a -> b
$ do
    Ptr CommitParents
parents' <- a -> IO (Ptr CommitParents)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
parents
    Ptr Commit
result <- Ptr CommitParents -> Word32 -> IO (Ptr Commit)
ggit_commit_parents_get Ptr CommitParents
parents' Word32
idx
    Maybe Commit
maybeResult <- Ptr Commit -> (Ptr Commit -> IO Commit) -> IO (Maybe Commit)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Commit
result ((Ptr Commit -> IO Commit) -> IO (Maybe Commit))
-> (Ptr Commit -> IO Commit) -> IO (Maybe Commit)
forall a b. (a -> b) -> a -> b
$ \Ptr Commit
result' -> do
        Commit
result'' <- ((ManagedPtr Commit -> Commit) -> Ptr Commit -> IO Commit
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Commit -> Commit
Ggit.Commit.Commit) Ptr Commit
result'
        Commit -> IO Commit
forall (m :: * -> *) a. Monad m => a -> m a
return Commit
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
parents
    Maybe Commit -> IO (Maybe Commit)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Commit
maybeResult

#if defined(ENABLE_OVERLOADING)
data CommitParentsGetMethodInfo
instance (signature ~ (Word32 -> m (Maybe Ggit.Commit.Commit)), MonadIO m, IsCommitParents a) => O.MethodInfo CommitParentsGetMethodInfo a signature where
    overloadedMethod = commitParentsGet

#endif

-- method CommitParents::get_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parents"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "CommitParents" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitCommitParents."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "idx"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent index." , 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_commit_parents_get_id" ggit_commit_parents_get_id :: 
    Ptr CommitParents ->                    -- parents : TInterface (Name {namespace = "Ggit", name = "CommitParents"})
    Word32 ->                               -- idx : TBasicType TUInt
    IO (Ptr Ggit.OId.OId)

-- | Get the t'GI.Ggit.Structs.OId.OId' of a parent.
commitParentsGetId ::
    (B.CallStack.HasCallStack, MonadIO m, IsCommitParents a) =>
    a
    -- ^ /@parents@/: a t'GI.Ggit.Objects.CommitParents.CommitParents'.
    -> Word32
    -- ^ /@idx@/: the parent index.
    -> m (Maybe Ggit.OId.OId)
    -- ^ __Returns:__ a t'GI.Ggit.Structs.OId.OId'.
commitParentsGetId :: a -> Word32 -> m (Maybe OId)
commitParentsGetId a
parents Word32
idx = 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 CommitParents
parents' <- a -> IO (Ptr CommitParents)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
parents
    Ptr OId
result <- Ptr CommitParents -> Word32 -> IO (Ptr OId)
ggit_commit_parents_get_id Ptr CommitParents
parents' Word32
idx
    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
wrapBoxed ManagedPtr OId -> OId
Ggit.OId.OId) Ptr OId
result'
        OId -> IO OId
forall (m :: * -> *) a. Monad m => a -> m a
return OId
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
parents
    Maybe OId -> IO (Maybe OId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe OId
maybeResult

#if defined(ENABLE_OVERLOADING)
data CommitParentsGetIdMethodInfo
instance (signature ~ (Word32 -> m (Maybe Ggit.OId.OId)), MonadIO m, IsCommitParents a) => O.MethodInfo CommitParentsGetIdMethodInfo a signature where
    overloadedMethod = commitParentsGetId

#endif

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

foreign import ccall "ggit_commit_parents_get_size" ggit_commit_parents_get_size :: 
    Ptr CommitParents ->                    -- parents : TInterface (Name {namespace = "Ggit", name = "CommitParents"})
    IO Word32

-- | Get the number of parents in the parents collection.
commitParentsGetSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsCommitParents a) =>
    a
    -- ^ /@parents@/: a t'GI.Ggit.Objects.CommitParents.CommitParents'.
    -> m Word32
    -- ^ __Returns:__ the number of parents.
commitParentsGetSize :: a -> m Word32
commitParentsGetSize a
parents = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr CommitParents
parents' <- a -> IO (Ptr CommitParents)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
parents
    Word32
result <- Ptr CommitParents -> IO Word32
ggit_commit_parents_get_size Ptr CommitParents
parents'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
parents
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data CommitParentsGetSizeMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsCommitParents a) => O.MethodInfo CommitParentsGetSizeMethodInfo a signature where
    overloadedMethod = commitParentsGetSize

#endif