{-# LANGUAGE TypeApplications #-}


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

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

module GI.Ggit.Objects.Mailmap
    ( 

-- * Exported types
    Mailmap(..)                             ,
    IsMailmap                               ,
    toMailmap                               ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addEntry]("GI.Ggit.Objects.Mailmap#g:method:addEntry"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [resolve]("GI.Ggit.Objects.Mailmap#g:method:resolve"), [resolveSignature]("GI.Ggit.Objects.Mailmap#g:method:resolveSignature"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveMailmapMethod                    ,
#endif

-- ** addEntry #method:addEntry#

#if defined(ENABLE_OVERLOADING)
    MailmapAddEntryMethodInfo               ,
#endif
    mailmapAddEntry                         ,


-- ** new #method:new#

    mailmapNew                              ,


-- ** newFromRepository #method:newFromRepository#

    mailmapNewFromRepository                ,


-- ** resolve #method:resolve#

#if defined(ENABLE_OVERLOADING)
    MailmapResolveMethodInfo                ,
#endif
    mailmapResolve                          ,


-- ** resolveSignature #method:resolveSignature#

#if defined(ENABLE_OVERLOADING)
    MailmapResolveSignatureMethodInfo       ,
#endif
    mailmapResolveSignature                 ,




    ) where

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

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

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.Structs.DateTime as GLib.DateTime
import qualified GI.GLib.Structs.MatchInfo as GLib.MatchInfo
import qualified GI.GLib.Structs.Regex as GLib.Regex
import qualified GI.GLib.Structs.TimeZone as GLib.TimeZone
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Ggit.Callbacks as Ggit.Callbacks
import {-# SOURCE #-} qualified GI.Ggit.Enums as Ggit.Enums
import {-# SOURCE #-} qualified GI.Ggit.Flags as Ggit.Flags
import {-# SOURCE #-} qualified GI.Ggit.Objects.Blame as Ggit.Blame
import {-# SOURCE #-} qualified GI.Ggit.Objects.Blob as Ggit.Blob
import {-# SOURCE #-} qualified GI.Ggit.Objects.BlobOutputStream as Ggit.BlobOutputStream
import {-# SOURCE #-} qualified GI.Ggit.Objects.Branch as Ggit.Branch
import {-# SOURCE #-} qualified GI.Ggit.Objects.CheckoutOptions as Ggit.CheckoutOptions
import {-# SOURCE #-} qualified GI.Ggit.Objects.CherryPickOptions as Ggit.CherryPickOptions
import {-# SOURCE #-} qualified GI.Ggit.Objects.CloneOptions as Ggit.CloneOptions
import {-# SOURCE #-} qualified GI.Ggit.Objects.Commit as Ggit.Commit
import {-# SOURCE #-} qualified GI.Ggit.Objects.CommitParents as Ggit.CommitParents
import {-# SOURCE #-} qualified GI.Ggit.Objects.Config as Ggit.Config
import {-# SOURCE #-} qualified GI.Ggit.Objects.Index as Ggit.Index
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.ProxyOptions as Ggit.ProxyOptions
import {-# SOURCE #-} qualified GI.Ggit.Objects.PushOptions as Ggit.PushOptions
import {-# SOURCE #-} qualified GI.Ggit.Objects.Rebase as Ggit.Rebase
import {-# SOURCE #-} qualified GI.Ggit.Objects.Ref as Ggit.Ref
import {-# SOURCE #-} qualified GI.Ggit.Objects.Remote as Ggit.Remote
import {-# SOURCE #-} qualified GI.Ggit.Objects.RemoteCallbacks as Ggit.RemoteCallbacks
import {-# SOURCE #-} qualified GI.Ggit.Objects.Repository as Ggit.Repository
import {-# SOURCE #-} qualified GI.Ggit.Objects.Signature as Ggit.Signature
import {-# SOURCE #-} qualified GI.Ggit.Objects.SubmoduleUpdateOptions as Ggit.SubmoduleUpdateOptions
import {-# SOURCE #-} qualified GI.Ggit.Objects.Tag as Ggit.Tag
import {-# SOURCE #-} qualified GI.Ggit.Objects.Tree as Ggit.Tree
import {-# SOURCE #-} qualified GI.Ggit.Objects.TreeBuilder as Ggit.TreeBuilder
import {-# SOURCE #-} qualified GI.Ggit.Structs.AnnotatedCommit as Ggit.AnnotatedCommit
import {-# SOURCE #-} qualified GI.Ggit.Structs.BlameHunk as Ggit.BlameHunk
import {-# SOURCE #-} qualified GI.Ggit.Structs.BlameOptions as Ggit.BlameOptions
import {-# SOURCE #-} qualified GI.Ggit.Structs.BranchEnumerator as Ggit.BranchEnumerator
import {-# SOURCE #-} qualified GI.Ggit.Structs.ConfigEntry as Ggit.ConfigEntry
import {-# SOURCE #-} qualified GI.Ggit.Structs.DiffSimilarityMetric as Ggit.DiffSimilarityMetric
import {-# SOURCE #-} qualified GI.Ggit.Structs.FetchOptions as Ggit.FetchOptions
import {-# SOURCE #-} qualified GI.Ggit.Structs.IndexEntries as Ggit.IndexEntries
import {-# SOURCE #-} qualified GI.Ggit.Structs.IndexEntriesResolveUndo as Ggit.IndexEntriesResolveUndo
import {-# SOURCE #-} qualified GI.Ggit.Structs.IndexEntry as Ggit.IndexEntry
import {-# SOURCE #-} qualified GI.Ggit.Structs.IndexEntryResolveUndo as Ggit.IndexEntryResolveUndo
import {-# SOURCE #-} qualified GI.Ggit.Structs.MergeOptions as Ggit.MergeOptions
import {-# SOURCE #-} qualified GI.Ggit.Structs.Note as Ggit.Note
import {-# SOURCE #-} qualified GI.Ggit.Structs.OId as Ggit.OId
import {-# SOURCE #-} qualified GI.Ggit.Structs.RebaseOperation as Ggit.RebaseOperation
import {-# SOURCE #-} qualified GI.Ggit.Structs.RebaseOptions as Ggit.RebaseOptions
import {-# SOURCE #-} qualified GI.Ggit.Structs.Reflog as Ggit.Reflog
import {-# SOURCE #-} qualified GI.Ggit.Structs.ReflogEntry as Ggit.ReflogEntry
import {-# SOURCE #-} qualified GI.Ggit.Structs.RemoteHead as Ggit.RemoteHead
import {-# SOURCE #-} qualified GI.Ggit.Structs.RevertOptions as Ggit.RevertOptions
import {-# SOURCE #-} qualified GI.Ggit.Structs.StatusOptions as Ggit.StatusOptions
import {-# SOURCE #-} qualified GI.Ggit.Structs.Submodule as Ggit.Submodule
import {-# SOURCE #-} qualified GI.Ggit.Structs.TransferProgress as Ggit.TransferProgress
import {-# SOURCE #-} qualified GI.Ggit.Structs.TreeEntry as Ggit.TreeEntry
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
import qualified GI.Gio.Objects.OutputStream as Gio.OutputStream

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Ggit.Objects.Native as Ggit.Native
import {-# SOURCE #-} qualified GI.Ggit.Objects.ObjectFactoryBase as Ggit.ObjectFactoryBase
import {-# SOURCE #-} qualified GI.Ggit.Objects.Repository as Ggit.Repository
import {-# SOURCE #-} qualified GI.Ggit.Objects.Signature as Ggit.Signature

#endif

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

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

foreign import ccall "ggit_mailmap_get_type"
    c_ggit_mailmap_get_type :: IO B.Types.GType

instance B.Types.TypedObject Mailmap where
    glibType :: IO GType
glibType = IO GType
c_ggit_mailmap_get_type

instance B.Types.GObject Mailmap

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

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

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

-- | Convert 'Mailmap' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Mailmap) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_ggit_mailmap_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Mailmap -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Mailmap
P.Nothing = Ptr GValue -> Ptr Mailmap -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Mailmap
forall a. Ptr a
FP.nullPtr :: FP.Ptr Mailmap)
    gvalueSet_ Ptr GValue
gv (P.Just Mailmap
obj) = Mailmap -> (Ptr Mailmap -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Mailmap
obj (Ptr GValue -> Ptr Mailmap -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Mailmap)
gvalueGet_ Ptr GValue
gv = do
        Ptr Mailmap
ptr <- Ptr GValue -> IO (Ptr Mailmap)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Mailmap)
        if Ptr Mailmap
ptr Ptr Mailmap -> Ptr Mailmap -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Mailmap
forall a. Ptr a
FP.nullPtr
        then Mailmap -> Maybe Mailmap
forall a. a -> Maybe a
P.Just (Mailmap -> Maybe Mailmap) -> IO Mailmap -> IO (Maybe Mailmap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Mailmap -> Mailmap) -> Ptr Mailmap -> IO Mailmap
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Mailmap -> Mailmap
Mailmap Ptr Mailmap
ptr
        else Maybe Mailmap -> IO (Maybe Mailmap)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Mailmap
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveMailmapMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveMailmapMethod "addEntry" o = MailmapAddEntryMethodInfo
    ResolveMailmapMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveMailmapMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveMailmapMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveMailmapMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveMailmapMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveMailmapMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveMailmapMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveMailmapMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveMailmapMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveMailmapMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveMailmapMethod "resolve" o = MailmapResolveMethodInfo
    ResolveMailmapMethod "resolveSignature" o = MailmapResolveSignatureMethodInfo
    ResolveMailmapMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveMailmapMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveMailmapMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveMailmapMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveMailmapMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveMailmapMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveMailmapMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveMailmapMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveMailmapMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveMailmapMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveMailmapMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveMailmapMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveMailmapMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveMailmapMethod t Mailmap, O.OverloadedMethod info Mailmap p, R.HasField t Mailmap p) => R.HasField t Mailmap p where
    getField = O.overloadedMethod @info

#endif

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method Mailmap::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Ggit" , name = "Mailmap" })
-- throws : True
-- Skip return : False

foreign import ccall "ggit_mailmap_new" ggit_mailmap_new :: 
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Mailmap)

-- | Creates a new t'GI.Ggit.Objects.Mailmap.Mailmap'.
mailmapNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m (Maybe Mailmap)
    -- ^ __Returns:__ a newly allocated t'GI.Ggit.Objects.Mailmap.Mailmap' or 'P.Nothing'. /(Can throw 'Data.GI.Base.GError.GError')/
mailmapNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m (Maybe Mailmap)
mailmapNew  = IO (Maybe Mailmap) -> m (Maybe Mailmap)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Mailmap) -> m (Maybe Mailmap))
-> IO (Maybe Mailmap) -> m (Maybe Mailmap)
forall a b. (a -> b) -> a -> b
$ do
    IO (Maybe Mailmap) -> IO () -> IO (Maybe Mailmap)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Mailmap
result <- (Ptr (Ptr GError) -> IO (Ptr Mailmap)) -> IO (Ptr Mailmap)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Mailmap)) -> IO (Ptr Mailmap))
-> (Ptr (Ptr GError) -> IO (Ptr Mailmap)) -> IO (Ptr Mailmap)
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr GError) -> IO (Ptr Mailmap)
ggit_mailmap_new
        Maybe Mailmap
maybeResult <- Ptr Mailmap -> (Ptr Mailmap -> IO Mailmap) -> IO (Maybe Mailmap)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Mailmap
result ((Ptr Mailmap -> IO Mailmap) -> IO (Maybe Mailmap))
-> (Ptr Mailmap -> IO Mailmap) -> IO (Maybe Mailmap)
forall a b. (a -> b) -> a -> b
$ \Ptr Mailmap
result' -> do
            Mailmap
result'' <- ((ManagedPtr Mailmap -> Mailmap) -> Ptr Mailmap -> IO Mailmap
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Mailmap -> Mailmap
Mailmap) Ptr Mailmap
result'
            Mailmap -> IO Mailmap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Mailmap
result''
        Maybe Mailmap -> IO (Maybe Mailmap)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Mailmap
maybeResult
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Mailmap::new_from_repository
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "repository"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Repository" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitRepository." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Ggit" , name = "Mailmap" })
-- throws : True
-- Skip return : False

foreign import ccall "ggit_mailmap_new_from_repository" ggit_mailmap_new_from_repository :: 
    Ptr Ggit.Repository.Repository ->       -- repository : TInterface (Name {namespace = "Ggit", name = "Repository"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Mailmap)

-- | Creates a new t'GI.Ggit.Objects.Mailmap.Mailmap' and loads mailmap files according to the
-- configuration of /@repository@/.
mailmapNewFromRepository ::
    (B.CallStack.HasCallStack, MonadIO m, Ggit.Repository.IsRepository a) =>
    a
    -- ^ /@repository@/: a t'GI.Ggit.Objects.Repository.Repository'.
    -> m (Maybe Mailmap)
    -- ^ __Returns:__ a newly allocated t'GI.Ggit.Objects.Mailmap.Mailmap' or 'P.Nothing'. /(Can throw 'Data.GI.Base.GError.GError')/
mailmapNewFromRepository :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRepository a) =>
a -> m (Maybe Mailmap)
mailmapNewFromRepository a
repository = IO (Maybe Mailmap) -> m (Maybe Mailmap)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Mailmap) -> m (Maybe Mailmap))
-> IO (Maybe Mailmap) -> m (Maybe Mailmap)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repository
repository' <- a -> IO (Ptr Repository)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
repository
    IO (Maybe Mailmap) -> IO () -> IO (Maybe Mailmap)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Mailmap
result <- (Ptr (Ptr GError) -> IO (Ptr Mailmap)) -> IO (Ptr Mailmap)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Mailmap)) -> IO (Ptr Mailmap))
-> (Ptr (Ptr GError) -> IO (Ptr Mailmap)) -> IO (Ptr Mailmap)
forall a b. (a -> b) -> a -> b
$ Ptr Repository -> Ptr (Ptr GError) -> IO (Ptr Mailmap)
ggit_mailmap_new_from_repository Ptr Repository
repository'
        Maybe Mailmap
maybeResult <- Ptr Mailmap -> (Ptr Mailmap -> IO Mailmap) -> IO (Maybe Mailmap)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Mailmap
result ((Ptr Mailmap -> IO Mailmap) -> IO (Maybe Mailmap))
-> (Ptr Mailmap -> IO Mailmap) -> IO (Maybe Mailmap)
forall a b. (a -> b) -> a -> b
$ \Ptr Mailmap
result' -> do
            Mailmap
result'' <- ((ManagedPtr Mailmap -> Mailmap) -> Ptr Mailmap -> IO Mailmap
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Mailmap -> Mailmap
Mailmap) Ptr Mailmap
result'
            Mailmap -> IO Mailmap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Mailmap
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
repository
        Maybe Mailmap -> IO (Maybe Mailmap)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Mailmap
maybeResult
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Mailmap::add_entry
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mailmap"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Mailmap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the mailmap to add the entry in."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "real_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the real name of the person."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "real_email"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the real email of the person."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "replace_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name to replace."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "replace_email"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the email to replace."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : True
-- Skip return : False

foreign import ccall "ggit_mailmap_add_entry" ggit_mailmap_add_entry :: 
    Ptr Mailmap ->                          -- mailmap : TInterface (Name {namespace = "Ggit", name = "Mailmap"})
    CString ->                              -- real_name : TBasicType TUTF8
    CString ->                              -- real_email : TBasicType TUTF8
    CString ->                              -- replace_name : TBasicType TUTF8
    CString ->                              -- replace_email : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO ()

-- | Adds a new entry to /@mailmap@/, replacing /@replaceName@/ and /@replaceEmail@/
-- with /@realName@/ and /@realEmail@/ respectively.  If /@replaceName@/ is 'P.Nothing',
-- it is ignored during matching.  If either /@realName@/ or /@realEmail@/ is 'P.Nothing',
-- the respective field is not replaced.
mailmapAddEntry ::
    (B.CallStack.HasCallStack, MonadIO m, IsMailmap a) =>
    a
    -- ^ /@mailmap@/: the mailmap to add the entry in.
    -> Maybe (T.Text)
    -- ^ /@realName@/: the real name of the person.
    -> Maybe (T.Text)
    -- ^ /@realEmail@/: the real email of the person.
    -> Maybe (T.Text)
    -- ^ /@replaceName@/: the name to replace.
    -> T.Text
    -- ^ /@replaceEmail@/: the email to replace.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
mailmapAddEntry :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMailmap a) =>
a -> Maybe Text -> Maybe Text -> Maybe Text -> Text -> m ()
mailmapAddEntry a
mailmap Maybe Text
realName Maybe Text
realEmail Maybe Text
replaceName Text
replaceEmail = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Mailmap
mailmap' <- a -> IO (Ptr Mailmap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mailmap
    Ptr CChar
maybeRealName <- case Maybe Text
realName of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jRealName -> do
            Ptr CChar
jRealName' <- Text -> IO (Ptr CChar)
textToCString Text
jRealName
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jRealName'
    Ptr CChar
maybeRealEmail <- case Maybe Text
realEmail of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jRealEmail -> do
            Ptr CChar
jRealEmail' <- Text -> IO (Ptr CChar)
textToCString Text
jRealEmail
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jRealEmail'
    Ptr CChar
maybeReplaceName <- case Maybe Text
replaceName of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jReplaceName -> do
            Ptr CChar
jReplaceName' <- Text -> IO (Ptr CChar)
textToCString Text
jReplaceName
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jReplaceName'
    Ptr CChar
replaceEmail' <- Text -> IO (Ptr CChar)
textToCString Text
replaceEmail
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        (Ptr (Ptr GError) -> IO ()) -> IO ()
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO ()) -> IO ())
-> (Ptr (Ptr GError) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Mailmap
-> Ptr CChar
-> Ptr CChar
-> Ptr CChar
-> Ptr CChar
-> Ptr (Ptr GError)
-> IO ()
ggit_mailmap_add_entry Ptr Mailmap
mailmap' Ptr CChar
maybeRealName Ptr CChar
maybeRealEmail Ptr CChar
maybeReplaceName Ptr CChar
replaceEmail'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mailmap
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeRealName
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeRealEmail
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeReplaceName
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
replaceEmail'
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeRealName
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeRealEmail
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeReplaceName
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
replaceEmail'
     )

#if defined(ENABLE_OVERLOADING)
data MailmapAddEntryMethodInfo
instance (signature ~ (Maybe (T.Text) -> Maybe (T.Text) -> Maybe (T.Text) -> T.Text -> m ()), MonadIO m, IsMailmap a) => O.OverloadedMethod MailmapAddEntryMethodInfo a signature where
    overloadedMethod = mailmapAddEntry

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


#endif

-- method Mailmap::resolve
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mailmap"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Mailmap" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the mailmap to search for replacements in."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "real_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the real name of the person."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "real_email"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the real email of the person."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "replace_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name to replace."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "replace_email"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the email to replace."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : True
-- Skip return : False

foreign import ccall "ggit_mailmap_resolve" ggit_mailmap_resolve :: 
    Ptr Mailmap ->                          -- mailmap : TInterface (Name {namespace = "Ggit", name = "Mailmap"})
    Ptr CString ->                          -- real_name : TBasicType TUTF8
    Ptr CString ->                          -- real_email : TBasicType TUTF8
    CString ->                              -- replace_name : TBasicType TUTF8
    CString ->                              -- replace_email : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO ()

-- | Resolves /@replaceName@/ and /@replaceEmail@/ to /@realName@/ and /@realEmail@/.
-- If /@mailmap@/ is @/NULL/@, no substitution is performed.
mailmapResolve ::
    (B.CallStack.HasCallStack, MonadIO m, IsMailmap a) =>
    Maybe (a)
    -- ^ /@mailmap@/: the mailmap to search for replacements in.
    -> T.Text
    -- ^ /@replaceName@/: the name to replace.
    -> T.Text
    -- ^ /@replaceEmail@/: the email to replace.
    -> m ((T.Text, T.Text))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
mailmapResolve :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMailmap a) =>
Maybe a -> Text -> Text -> m (Text, Text)
mailmapResolve Maybe a
mailmap Text
replaceName Text
replaceEmail = IO (Text, Text) -> m (Text, Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Text, Text) -> m (Text, Text))
-> IO (Text, Text) -> m (Text, Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Mailmap
maybeMailmap <- case Maybe a
mailmap of
        Maybe a
Nothing -> Ptr Mailmap -> IO (Ptr Mailmap)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Mailmap
forall a. Ptr a
nullPtr
        Just a
jMailmap -> do
            Ptr Mailmap
jMailmap' <- a -> IO (Ptr Mailmap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jMailmap
            Ptr Mailmap -> IO (Ptr Mailmap)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Mailmap
jMailmap'
    Ptr (Ptr CChar)
realName <- IO (Ptr (Ptr CChar))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Ptr (Ptr CChar)
realEmail <- IO (Ptr (Ptr CChar))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Ptr CChar
replaceName' <- Text -> IO (Ptr CChar)
textToCString Text
replaceName
    Ptr CChar
replaceEmail' <- Text -> IO (Ptr CChar)
textToCString Text
replaceEmail
    IO (Text, Text) -> IO () -> IO (Text, Text)
forall a b. IO a -> IO b -> IO a
onException (do
        (Ptr (Ptr GError) -> IO ()) -> IO ()
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO ()) -> IO ())
-> (Ptr (Ptr GError) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Mailmap
-> Ptr (Ptr CChar)
-> Ptr (Ptr CChar)
-> Ptr CChar
-> Ptr CChar
-> Ptr (Ptr GError)
-> IO ()
ggit_mailmap_resolve Ptr Mailmap
maybeMailmap Ptr (Ptr CChar)
realName Ptr (Ptr CChar)
realEmail Ptr CChar
replaceName' Ptr CChar
replaceEmail'
        Ptr CChar
realName' <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
realName
        Text
realName'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
realName'
        Ptr CChar
realEmail' <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
realEmail
        Text
realEmail'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
realEmail'
        Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
mailmap a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
realName
        Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
realEmail
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
replaceName'
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
replaceEmail'
        (Text, Text) -> IO (Text, Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
realName'', Text
realEmail'')
     ) (do
        Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
realName
        Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
realEmail
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
replaceName'
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
replaceEmail'
     )

#if defined(ENABLE_OVERLOADING)
data MailmapResolveMethodInfo
instance (signature ~ (T.Text -> T.Text -> m ((T.Text, T.Text))), MonadIO m, IsMailmap a) => O.OverloadedMethod MailmapResolveMethodInfo a signature where
    overloadedMethod i = mailmapResolve (Just i)

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


#endif

-- method Mailmap::resolve_signature
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mailmap"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Mailmap" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the mailmap to resolve names and emails with."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "signature"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Signature" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the commit signature as recorded."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Ggit" , name = "Signature" })
-- throws : True
-- Skip return : False

foreign import ccall "ggit_mailmap_resolve_signature" ggit_mailmap_resolve_signature :: 
    Ptr Mailmap ->                          -- mailmap : TInterface (Name {namespace = "Ggit", name = "Mailmap"})
    Ptr Ggit.Signature.Signature ->         -- signature : TInterface (Name {namespace = "Ggit", name = "Signature"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Ggit.Signature.Signature)

-- | Resolves /@signature@/ to use the real name and email according to /@mailmap@/.
-- If /@mailmap@/ is @/NULL/@, no substitution is performed, but a new signature is
-- still allocated and returned.
mailmapResolveSignature ::
    (B.CallStack.HasCallStack, MonadIO m, IsMailmap a, Ggit.Signature.IsSignature b) =>
    Maybe (a)
    -- ^ /@mailmap@/: the mailmap to resolve names and emails with.
    -> b
    -- ^ /@signature@/: the commit signature as recorded.
    -> m (Maybe Ggit.Signature.Signature)
    -- ^ __Returns:__ The corrected signature or 'P.Nothing'. /(Can throw 'Data.GI.Base.GError.GError')/
mailmapResolveSignature :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMailmap a, IsSignature b) =>
Maybe a -> b -> m (Maybe Signature)
mailmapResolveSignature Maybe a
mailmap b
signature = IO (Maybe Signature) -> m (Maybe Signature)
forall a. IO a -> m a
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 Mailmap
maybeMailmap <- case Maybe a
mailmap of
        Maybe a
Nothing -> Ptr Mailmap -> IO (Ptr Mailmap)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Mailmap
forall a. Ptr a
nullPtr
        Just a
jMailmap -> do
            Ptr Mailmap
jMailmap' <- a -> IO (Ptr Mailmap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jMailmap
            Ptr Mailmap -> IO (Ptr Mailmap)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Mailmap
jMailmap'
    Ptr Signature
signature' <- b -> IO (Ptr Signature)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
signature
    IO (Maybe Signature) -> IO () -> IO (Maybe Signature)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Signature
result <- (Ptr (Ptr GError) -> IO (Ptr Signature)) -> IO (Ptr Signature)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Signature)) -> IO (Ptr Signature))
-> (Ptr (Ptr GError) -> IO (Ptr Signature)) -> IO (Ptr Signature)
forall a b. (a -> b) -> a -> b
$ Ptr Mailmap
-> Ptr Signature -> Ptr (Ptr GError) -> IO (Ptr Signature)
ggit_mailmap_resolve_signature Ptr Mailmap
maybeMailmap Ptr Signature
signature'
        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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Signature
result''
        Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
mailmap a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
signature
        Maybe Signature -> IO (Maybe Signature)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Signature
maybeResult
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data MailmapResolveSignatureMethodInfo
instance (signature ~ (b -> m (Maybe Ggit.Signature.Signature)), MonadIO m, IsMailmap a, Ggit.Signature.IsSignature b) => O.OverloadedMethod MailmapResolveSignatureMethodInfo a signature where
    overloadedMethod i = mailmapResolveSignature (Just i)

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


#endif