{-# 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 commit object.

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

module GI.Ggit.Objects.Commit
    ( 

-- * Exported types
    Commit(..)                              ,
    IsCommit                                ,
    toCommit                                ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveCommitMethod                     ,
#endif


-- ** amend #method:amend#

#if defined(ENABLE_OVERLOADING)
    CommitAmendMethodInfo                   ,
#endif
    commitAmend                             ,


-- ** getAuthor #method:getAuthor#

#if defined(ENABLE_OVERLOADING)
    CommitGetAuthorMethodInfo               ,
#endif
    commitGetAuthor                         ,


-- ** getCommitter #method:getCommitter#

#if defined(ENABLE_OVERLOADING)
    CommitGetCommitterMethodInfo            ,
#endif
    commitGetCommitter                      ,


-- ** getMessage #method:getMessage#

#if defined(ENABLE_OVERLOADING)
    CommitGetMessageMethodInfo              ,
#endif
    commitGetMessage                        ,


-- ** getMessageEncoding #method:getMessageEncoding#

#if defined(ENABLE_OVERLOADING)
    CommitGetMessageEncodingMethodInfo      ,
#endif
    commitGetMessageEncoding                ,


-- ** getNthAncestor #method:getNthAncestor#

#if defined(ENABLE_OVERLOADING)
    CommitGetNthAncestorMethodInfo          ,
#endif
    commitGetNthAncestor                    ,


-- ** getParents #method:getParents#

#if defined(ENABLE_OVERLOADING)
    CommitGetParentsMethodInfo              ,
#endif
    commitGetParents                        ,


-- ** getSubject #method:getSubject#

#if defined(ENABLE_OVERLOADING)
    CommitGetSubjectMethodInfo              ,
#endif
    commitGetSubject                        ,


-- ** getTree #method:getTree#

#if defined(ENABLE_OVERLOADING)
    CommitGetTreeMethodInfo                 ,
#endif
    commitGetTree                           ,


-- ** getTreeId #method:getTreeId#

#if defined(ENABLE_OVERLOADING)
    CommitGetTreeIdMethodInfo               ,
#endif
    commitGetTreeId                         ,




    ) 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.CommitParents as Ggit.CommitParents
import {-# SOURCE #-} qualified GI.Ggit.Objects.Native as Ggit.Native
import {-# SOURCE #-} qualified GI.Ggit.Objects.Object as Ggit.Object
import {-# SOURCE #-} qualified GI.Ggit.Objects.ObjectFactoryBase as Ggit.ObjectFactoryBase
import {-# SOURCE #-} qualified GI.Ggit.Objects.Signature as Ggit.Signature
import {-# SOURCE #-} qualified GI.Ggit.Objects.Tree as Ggit.Tree
import {-# SOURCE #-} qualified GI.Ggit.Structs.OId as Ggit.OId

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

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

foreign import ccall "ggit_commit_get_type"
    c_ggit_commit_get_type :: IO B.Types.GType

instance B.Types.TypedObject Commit where
    glibType :: IO GType
glibType = IO GType
c_ggit_commit_get_type

instance B.Types.GObject Commit

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveCommitMethod (t :: Symbol) (o :: *) :: * where
    ResolveCommitMethod "amend" o = CommitAmendMethodInfo
    ResolveCommitMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveCommitMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveCommitMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveCommitMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveCommitMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveCommitMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveCommitMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveCommitMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveCommitMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveCommitMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveCommitMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveCommitMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveCommitMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveCommitMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveCommitMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveCommitMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveCommitMethod "getAuthor" o = CommitGetAuthorMethodInfo
    ResolveCommitMethod "getCommitter" o = CommitGetCommitterMethodInfo
    ResolveCommitMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveCommitMethod "getId" o = Ggit.Object.ObjectGetIdMethodInfo
    ResolveCommitMethod "getMessage" o = CommitGetMessageMethodInfo
    ResolveCommitMethod "getMessageEncoding" o = CommitGetMessageEncodingMethodInfo
    ResolveCommitMethod "getNthAncestor" o = CommitGetNthAncestorMethodInfo
    ResolveCommitMethod "getOwner" o = Ggit.Object.ObjectGetOwnerMethodInfo
    ResolveCommitMethod "getParents" o = CommitGetParentsMethodInfo
    ResolveCommitMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveCommitMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveCommitMethod "getSubject" o = CommitGetSubjectMethodInfo
    ResolveCommitMethod "getTree" o = CommitGetTreeMethodInfo
    ResolveCommitMethod "getTreeId" o = CommitGetTreeIdMethodInfo
    ResolveCommitMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveCommitMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveCommitMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveCommitMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method Commit::amend
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "commit"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Commit" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitCommit." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "update_ref"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of the reference to update."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "author"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Signature" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "author signature." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "committer"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Signature" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "committer signature (and time of commit)."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "message_encoding"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "message encoding." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "message"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "commit message." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tree"
--           , argType = TInterface Name { namespace = "Ggit" , name = "Tree" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the tree of objects to commit."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Ggit" , name = "OId" })
-- throws : True
-- Skip return : False

foreign import ccall "ggit_commit_amend" ggit_commit_amend :: 
    Ptr Commit ->                           -- commit : TInterface (Name {namespace = "Ggit", name = "Commit"})
    CString ->                              -- update_ref : TBasicType TUTF8
    Ptr Ggit.Signature.Signature ->         -- author : TInterface (Name {namespace = "Ggit", name = "Signature"})
    Ptr Ggit.Signature.Signature ->         -- committer : TInterface (Name {namespace = "Ggit", name = "Signature"})
    CString ->                              -- message_encoding : TBasicType TUTF8
    CString ->                              -- message : TBasicType TUTF8
    Ptr Ggit.Tree.Tree ->                   -- tree : TInterface (Name {namespace = "Ggit", name = "Tree"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Ggit.OId.OId)

-- | Amend an existing commit. If /@updateRef@/ is not 'P.Nothing', the given reference will
-- be updated to point to the newly created commit. Use \"HEAD\" to update the
-- HEAD of the current branch and make it point to this commit.
-- 
-- If /@messageEncoding@/ is set to 'P.Nothing', \"UTF-8\" encoding is assumed for the
-- provided /@message@/. Note that /@message@/ will not be cleaned up automatically.
-- You can use @/ggit_message_prettify/@ to do this yourself if needed.
commitAmend ::
    (B.CallStack.HasCallStack, MonadIO m, IsCommit a, Ggit.Signature.IsSignature b, Ggit.Signature.IsSignature c, Ggit.Tree.IsTree d) =>
    a
    -- ^ /@commit@/: a t'GI.Ggit.Objects.Commit.Commit'.
    -> Maybe (T.Text)
    -- ^ /@updateRef@/: name of the reference to update.
    -> b
    -- ^ /@author@/: author signature.
    -> c
    -- ^ /@committer@/: committer signature (and time of commit).
    -> Maybe (T.Text)
    -- ^ /@messageEncoding@/: message encoding.
    -> T.Text
    -- ^ /@message@/: commit message.
    -> d
    -- ^ /@tree@/: the tree of objects to commit.
    -> m (Maybe Ggit.OId.OId)
    -- ^ __Returns:__ the t'GI.Ggit.Structs.OId.OId' of the created commit object,
    -- or 'P.Nothing' in case of an error. /(Can throw 'Data.GI.Base.GError.GError')/
commitAmend :: a
-> Maybe Text -> b -> c -> Maybe Text -> Text -> d -> m (Maybe OId)
commitAmend a
commit Maybe Text
updateRef b
author c
committer Maybe Text
messageEncoding Text
message d
tree = 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 Commit
commit' <- a -> IO (Ptr Commit)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
commit
    Ptr CChar
maybeUpdateRef <- case Maybe Text
updateRef of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jUpdateRef -> do
            Ptr CChar
jUpdateRef' <- Text -> IO (Ptr CChar)
textToCString Text
jUpdateRef
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jUpdateRef'
    Ptr Signature
author' <- b -> IO (Ptr Signature)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
author
    Ptr Signature
committer' <- c -> IO (Ptr Signature)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
committer
    Ptr CChar
maybeMessageEncoding <- case Maybe Text
messageEncoding of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jMessageEncoding -> do
            Ptr CChar
jMessageEncoding' <- Text -> IO (Ptr CChar)
textToCString Text
jMessageEncoding
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jMessageEncoding'
    Ptr CChar
message' <- Text -> IO (Ptr CChar)
textToCString Text
message
    Ptr Tree
tree' <- d -> IO (Ptr Tree)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
tree
    IO (Maybe OId) -> IO () -> IO (Maybe OId)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr OId
result <- (Ptr (Ptr GError) -> IO (Ptr OId)) -> IO (Ptr OId)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr OId)) -> IO (Ptr OId))
-> (Ptr (Ptr GError) -> IO (Ptr OId)) -> IO (Ptr OId)
forall a b. (a -> b) -> a -> b
$ Ptr Commit
-> Ptr CChar
-> Ptr Signature
-> Ptr Signature
-> Ptr CChar
-> Ptr CChar
-> Ptr Tree
-> Ptr (Ptr GError)
-> IO (Ptr OId)
ggit_commit_amend Ptr Commit
commit' Ptr CChar
maybeUpdateRef Ptr Signature
author' Ptr Signature
committer' Ptr CChar
maybeMessageEncoding Ptr CChar
message' Ptr Tree
tree'
        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
commit
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
author
        c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
committer
        d -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr d
tree
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeUpdateRef
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeMessageEncoding
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
message'
        Maybe OId -> IO (Maybe OId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe OId
maybeResult
     ) (do
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeUpdateRef
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeMessageEncoding
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
message'
     )

#if defined(ENABLE_OVERLOADING)
data CommitAmendMethodInfo
instance (signature ~ (Maybe (T.Text) -> b -> c -> Maybe (T.Text) -> T.Text -> d -> m (Maybe Ggit.OId.OId)), MonadIO m, IsCommit a, Ggit.Signature.IsSignature b, Ggit.Signature.IsSignature c, Ggit.Tree.IsTree d) => O.MethodInfo CommitAmendMethodInfo a signature where
    overloadedMethod = commitAmend

#endif

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

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

-- | Gets the author of /@commit@/. The returned value must be free\'d with
-- 'GI.GObject.Objects.Object.objectUnref'.
commitGetAuthor ::
    (B.CallStack.HasCallStack, MonadIO m, IsCommit a) =>
    a
    -- ^ /@commit@/: a t'GI.Ggit.Objects.Commit.Commit'.
    -> m (Maybe Ggit.Signature.Signature)
    -- ^ __Returns:__ the author of the commit.
commitGetAuthor :: a -> m (Maybe Signature)
commitGetAuthor a
commit = IO (Maybe Signature) -> m (Maybe Signature)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Signature) -> m (Maybe Signature))
-> IO (Maybe Signature) -> m (Maybe Signature)
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 Signature
result <- Ptr Commit -> IO (Ptr Signature)
ggit_commit_get_author Ptr Commit
commit'
    Maybe Signature
maybeResult <- Ptr Signature
-> (Ptr Signature -> IO Signature) -> IO (Maybe Signature)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Signature
result ((Ptr Signature -> IO Signature) -> IO (Maybe Signature))
-> (Ptr Signature -> IO Signature) -> IO (Maybe Signature)
forall a b. (a -> b) -> a -> b
$ \Ptr Signature
result' -> do
        Signature
result'' <- ((ManagedPtr Signature -> Signature)
-> Ptr Signature -> IO Signature
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Signature -> Signature
Ggit.Signature.Signature) Ptr Signature
result'
        Signature -> IO Signature
forall (m :: * -> *) a. Monad m => a -> m a
return Signature
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
commit
    Maybe Signature -> IO (Maybe Signature)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Signature
maybeResult

#if defined(ENABLE_OVERLOADING)
data CommitGetAuthorMethodInfo
instance (signature ~ (m (Maybe Ggit.Signature.Signature)), MonadIO m, IsCommit a) => O.MethodInfo CommitGetAuthorMethodInfo a signature where
    overloadedMethod = commitGetAuthor

#endif

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

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

-- | Gets the committer of /@commit@/. The returned value must be free\'d with
-- 'GI.GObject.Objects.Object.objectUnref'.
commitGetCommitter ::
    (B.CallStack.HasCallStack, MonadIO m, IsCommit a) =>
    a
    -- ^ /@commit@/: a t'GI.Ggit.Objects.Commit.Commit'.
    -> m (Maybe Ggit.Signature.Signature)
    -- ^ __Returns:__ the committer of the commit.
commitGetCommitter :: a -> m (Maybe Signature)
commitGetCommitter a
commit = IO (Maybe Signature) -> m (Maybe Signature)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Signature) -> m (Maybe Signature))
-> IO (Maybe Signature) -> m (Maybe Signature)
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 Signature
result <- Ptr Commit -> IO (Ptr Signature)
ggit_commit_get_committer Ptr Commit
commit'
    Maybe Signature
maybeResult <- Ptr Signature
-> (Ptr Signature -> IO Signature) -> IO (Maybe Signature)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Signature
result ((Ptr Signature -> IO Signature) -> IO (Maybe Signature))
-> (Ptr Signature -> IO Signature) -> IO (Maybe Signature)
forall a b. (a -> b) -> a -> b
$ \Ptr Signature
result' -> do
        Signature
result'' <- ((ManagedPtr Signature -> Signature)
-> Ptr Signature -> IO Signature
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Signature -> Signature
Ggit.Signature.Signature) Ptr Signature
result'
        Signature -> IO Signature
forall (m :: * -> *) a. Monad m => a -> m a
return Signature
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
commit
    Maybe Signature -> IO (Maybe Signature)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Signature
maybeResult

#if defined(ENABLE_OVERLOADING)
data CommitGetCommitterMethodInfo
instance (signature ~ (m (Maybe Ggit.Signature.Signature)), MonadIO m, IsCommit a) => O.MethodInfo CommitGetCommitterMethodInfo a signature where
    overloadedMethod = commitGetCommitter

#endif

-- method Commit::get_message
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "commit"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Commit" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitCommit." , 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_commit_get_message" ggit_commit_get_message :: 
    Ptr Commit ->                           -- commit : TInterface (Name {namespace = "Ggit", name = "Commit"})
    IO CString

-- | Gets the full message of /@commit@/. The resulting message is always encoded
-- in UTF-8.
commitGetMessage ::
    (B.CallStack.HasCallStack, MonadIO m, IsCommit a) =>
    a
    -- ^ /@commit@/: a t'GI.Ggit.Objects.Commit.Commit'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the message of the commit.
commitGetMessage :: a -> m (Maybe Text)
commitGetMessage a
commit = 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 Commit
commit' <- a -> IO (Ptr Commit)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
commit
    Ptr CChar
result <- Ptr Commit -> IO (Ptr CChar)
ggit_commit_get_message Ptr Commit
commit'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
commit
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

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

#endif

-- method Commit::get_message_encoding
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "commit"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Commit" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitCommit." , 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_commit_get_message_encoding" ggit_commit_get_message_encoding :: 
    Ptr Commit ->                           -- commit : TInterface (Name {namespace = "Ggit", name = "Commit"})
    IO CString

-- | Get the encoding for the message of a commit,
-- as a string representing a standard encoding name.
-- 
-- The encoding may be 'P.Nothing' if the \'encoding\' header
-- in the commit is missing; in that case UTF-8 is assumed.
commitGetMessageEncoding ::
    (B.CallStack.HasCallStack, MonadIO m, IsCommit a) =>
    a
    -- ^ /@commit@/: a t'GI.Ggit.Objects.Commit.Commit'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the encoding of the commit message or 'P.Nothing'.
commitGetMessageEncoding :: a -> m (Maybe Text)
commitGetMessageEncoding a
commit = 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 Commit
commit' <- a -> IO (Ptr Commit)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
commit
    Ptr CChar
result <- Ptr Commit -> IO (Ptr CChar)
ggit_commit_get_message_encoding Ptr Commit
commit'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
commit
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

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

#endif

-- method Commit::get_nth_ancestor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "commit"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Commit" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitCommit." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the requested ancestor."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Ggit" , name = "Commit" })
-- throws : True
-- Skip return : False

foreign import ccall "ggit_commit_get_nth_ancestor" ggit_commit_get_nth_ancestor :: 
    Ptr Commit ->                           -- commit : TInterface (Name {namespace = "Ggit", name = "Commit"})
    Word32 ->                               -- n : TBasicType TUInt
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Commit)

-- | Gets the commit object that is the n-th generation ancestor
-- of the named commit object, following only the first parents.
-- Passing @/0/@ to the /@n@/ parameter returns another instance of /@commit@/.
commitGetNthAncestor ::
    (B.CallStack.HasCallStack, MonadIO m, IsCommit a) =>
    a
    -- ^ /@commit@/: a t'GI.Ggit.Objects.Commit.Commit'.
    -> Word32
    -- ^ /@n@/: the requested ancestor.
    -> m (Maybe Commit)
    -- ^ __Returns:__ the /@n@/ ancestor commit. /(Can throw 'Data.GI.Base.GError.GError')/
commitGetNthAncestor :: a -> Word32 -> m (Maybe Commit)
commitGetNthAncestor a
commit Word32
n = 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 Commit
commit' <- a -> IO (Ptr Commit)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
commit
    IO (Maybe Commit) -> IO () -> IO (Maybe Commit)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Commit
result <- (Ptr (Ptr GError) -> IO (Ptr Commit)) -> IO (Ptr Commit)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Commit)) -> IO (Ptr Commit))
-> (Ptr (Ptr GError) -> IO (Ptr Commit)) -> IO (Ptr Commit)
forall a b. (a -> b) -> a -> b
$ Ptr Commit -> Word32 -> Ptr (Ptr GError) -> IO (Ptr Commit)
ggit_commit_get_nth_ancestor Ptr Commit
commit' Word32
n
        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
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
commit
        Maybe Commit -> IO (Maybe Commit)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Commit
maybeResult
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data CommitGetNthAncestorMethodInfo
instance (signature ~ (Word32 -> m (Maybe Commit)), MonadIO m, IsCommit a) => O.MethodInfo CommitGetNthAncestorMethodInfo a signature where
    overloadedMethod = commitGetNthAncestor

#endif

-- method Commit::get_parents
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "commit"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Commit" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitCommit." , 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_get_parents" ggit_commit_get_parents :: 
    Ptr Commit ->                           -- commit : TInterface (Name {namespace = "Ggit", name = "Commit"})
    IO (Ptr Ggit.CommitParents.CommitParents)

-- | Gets the parents collection for /@commit@/.
commitGetParents ::
    (B.CallStack.HasCallStack, MonadIO m, IsCommit a) =>
    a
    -- ^ /@commit@/: a t'GI.Ggit.Objects.Commit.Commit'.
    -> m (Maybe Ggit.CommitParents.CommitParents)
    -- ^ __Returns:__ the parents collection of the commit.
commitGetParents :: a -> m (Maybe CommitParents)
commitGetParents a
commit = IO (Maybe CommitParents) -> m (Maybe CommitParents)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe CommitParents) -> m (Maybe CommitParents))
-> IO (Maybe CommitParents) -> m (Maybe 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_get_parents Ptr Commit
commit'
    Maybe CommitParents
maybeResult <- Ptr CommitParents
-> (Ptr CommitParents -> IO CommitParents)
-> IO (Maybe CommitParents)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CommitParents
result ((Ptr CommitParents -> IO CommitParents)
 -> IO (Maybe CommitParents))
-> (Ptr CommitParents -> IO CommitParents)
-> IO (Maybe CommitParents)
forall a b. (a -> b) -> a -> b
$ \Ptr CommitParents
result' -> do
        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
Ggit.CommitParents.CommitParents) Ptr CommitParents
result'
        CommitParents -> IO CommitParents
forall (m :: * -> *) a. Monad m => a -> m a
return CommitParents
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
commit
    Maybe CommitParents -> IO (Maybe CommitParents)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CommitParents
maybeResult

#if defined(ENABLE_OVERLOADING)
data CommitGetParentsMethodInfo
instance (signature ~ (m (Maybe Ggit.CommitParents.CommitParents)), MonadIO m, IsCommit a) => O.MethodInfo CommitGetParentsMethodInfo a signature where
    overloadedMethod = commitGetParents

#endif

-- method Commit::get_subject
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "commit"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Commit" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitCommit." , 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_commit_get_subject" ggit_commit_get_subject :: 
    Ptr Commit ->                           -- commit : TInterface (Name {namespace = "Ggit", name = "Commit"})
    IO CString

-- | Gets the subject of /@commit@/. The subject of a commit is the first line of
-- the commit message (as per convention). The resulting subject is always
-- encoded in UTF-8.
commitGetSubject ::
    (B.CallStack.HasCallStack, MonadIO m, IsCommit a) =>
    a
    -- ^ /@commit@/: a t'GI.Ggit.Objects.Commit.Commit'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the subject of the commit.
commitGetSubject :: a -> m (Maybe Text)
commitGetSubject a
commit = 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 Commit
commit' <- a -> IO (Ptr Commit)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
commit
    Ptr CChar
result <- Ptr Commit -> IO (Ptr CChar)
ggit_commit_get_subject Ptr Commit
commit'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
commit
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

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

#endif

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

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

-- | Get the tree object for /@commit@/.
commitGetTree ::
    (B.CallStack.HasCallStack, MonadIO m, IsCommit a) =>
    a
    -- ^ /@commit@/: a t'GI.Ggit.Objects.Commit.Commit'.
    -> m (Maybe Ggit.Tree.Tree)
    -- ^ __Returns:__ a t'GI.Ggit.Objects.Tree.Tree'.
commitGetTree :: a -> m (Maybe Tree)
commitGetTree a
commit = IO (Maybe Tree) -> m (Maybe Tree)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Tree) -> m (Maybe Tree))
-> IO (Maybe Tree) -> m (Maybe Tree)
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 Tree
result <- Ptr Commit -> IO (Ptr Tree)
ggit_commit_get_tree Ptr Commit
commit'
    Maybe Tree
maybeResult <- Ptr Tree -> (Ptr Tree -> IO Tree) -> IO (Maybe Tree)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Tree
result ((Ptr Tree -> IO Tree) -> IO (Maybe Tree))
-> (Ptr Tree -> IO Tree) -> IO (Maybe Tree)
forall a b. (a -> b) -> a -> b
$ \Ptr Tree
result' -> do
        Tree
result'' <- ((ManagedPtr Tree -> Tree) -> Ptr Tree -> IO Tree
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Tree -> Tree
Ggit.Tree.Tree) Ptr Tree
result'
        Tree -> IO Tree
forall (m :: * -> *) a. Monad m => a -> m a
return Tree
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
commit
    Maybe Tree -> IO (Maybe Tree)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Tree
maybeResult

#if defined(ENABLE_OVERLOADING)
data CommitGetTreeMethodInfo
instance (signature ~ (m (Maybe Ggit.Tree.Tree)), MonadIO m, IsCommit a) => O.MethodInfo CommitGetTreeMethodInfo a signature where
    overloadedMethod = commitGetTree

#endif

-- method Commit::get_tree_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "commit"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Commit" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitCommit." , 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_get_tree_id" ggit_commit_get_tree_id :: 
    Ptr Commit ->                           -- commit : TInterface (Name {namespace = "Ggit", name = "Commit"})
    IO (Ptr Ggit.OId.OId)

-- | Get the t'GI.Ggit.Structs.OId.OId' of the tree of /@commit@/. Note that this is more efficient
-- than getting the tree object with 'GI.Ggit.Objects.Commit.commitGetTree' because no additional
-- files need to be read from disk.
commitGetTreeId ::
    (B.CallStack.HasCallStack, MonadIO m, IsCommit a) =>
    a
    -- ^ /@commit@/: a t'GI.Ggit.Objects.Commit.Commit'.
    -> m (Maybe Ggit.OId.OId)
    -- ^ __Returns:__ a t'GI.Ggit.Structs.OId.OId'.
commitGetTreeId :: a -> m (Maybe OId)
commitGetTreeId a
commit = 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 Commit
commit' <- a -> IO (Ptr Commit)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
commit
    Ptr OId
result <- Ptr Commit -> IO (Ptr OId)
ggit_commit_get_tree_id Ptr Commit
commit'
    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
commit
    Maybe OId -> IO (Maybe OId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe OId
maybeResult

#if defined(ENABLE_OVERLOADING)
data CommitGetTreeIdMethodInfo
instance (signature ~ (m (Maybe Ggit.OId.OId)), MonadIO m, IsCommit a) => O.MethodInfo CommitGetTreeIdMethodInfo a signature where
    overloadedMethod = commitGetTreeId

#endif