{-# LANGUAGE TypeApplications #-}


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

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

module GI.Ggit.Objects.Signature
    ( 

-- * Exported types
    Signature(..)                           ,
    IsSignature                             ,
    toSignature                             ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [copy]("GI.Ggit.Objects.Signature#g:method:copy"), [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"), [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"), [getEmail]("GI.Ggit.Objects.Signature#g:method:getEmail"), [getName]("GI.Ggit.Objects.Signature#g:method:getName"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getTime]("GI.Ggit.Objects.Signature#g:method:getTime"), [getTimeZone]("GI.Ggit.Objects.Signature#g:method:getTimeZone").
-- 
-- ==== 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)
    ResolveSignatureMethod                  ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    SignatureCopyMethodInfo                 ,
#endif
    signatureCopy                           ,


-- ** getEmail #method:getEmail#

#if defined(ENABLE_OVERLOADING)
    SignatureGetEmailMethodInfo             ,
#endif
    signatureGetEmail                       ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    SignatureGetNameMethodInfo              ,
#endif
    signatureGetName                        ,


-- ** getTime #method:getTime#

#if defined(ENABLE_OVERLOADING)
    SignatureGetTimeMethodInfo              ,
#endif
    signatureGetTime                        ,


-- ** getTimeZone #method:getTimeZone#

#if defined(ENABLE_OVERLOADING)
    SignatureGetTimeZoneMethodInfo          ,
#endif
    signatureGetTimeZone                    ,


-- ** new #method:new#

    signatureNew                            ,


-- ** newNow #method:newNow#

    signatureNewNow                         ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    SignatureEncodingPropertyInfo           ,
#endif
    constructSignatureEncoding              ,
    getSignatureEncoding                    ,
#if defined(ENABLE_OVERLOADING)
    signatureEncoding                       ,
#endif




    ) 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.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.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 GI.GLib.Structs.DateTime as GLib.DateTime
import qualified GI.GLib.Structs.TimeZone as GLib.TimeZone
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

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

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

foreign import ccall "ggit_signature_get_type"
    c_ggit_signature_get_type :: IO B.Types.GType

instance B.Types.TypedObject Signature where
    glibType :: IO GType
glibType = IO GType
c_ggit_signature_get_type

instance B.Types.GObject Signature

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveSignatureMethod (t :: Symbol) (o :: *) :: * where
    ResolveSignatureMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSignatureMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSignatureMethod "copy" o = SignatureCopyMethodInfo
    ResolveSignatureMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSignatureMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSignatureMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSignatureMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSignatureMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSignatureMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSignatureMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSignatureMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSignatureMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSignatureMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSignatureMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSignatureMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSignatureMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSignatureMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSignatureMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSignatureMethod "getEmail" o = SignatureGetEmailMethodInfo
    ResolveSignatureMethod "getName" o = SignatureGetNameMethodInfo
    ResolveSignatureMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSignatureMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSignatureMethod "getTime" o = SignatureGetTimeMethodInfo
    ResolveSignatureMethod "getTimeZone" o = SignatureGetTimeZoneMethodInfo
    ResolveSignatureMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSignatureMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSignatureMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSignatureMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "encoding"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@encoding@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' signature #encoding
-- @
getSignatureEncoding :: (MonadIO m, IsSignature o) => o -> m (Maybe T.Text)
getSignatureEncoding :: forall (m :: * -> *) o.
(MonadIO m, IsSignature o) =>
o -> m (Maybe Text)
getSignatureEncoding o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"encoding"

-- | Construct a `GValueConstruct` with valid value for the “@encoding@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSignatureEncoding :: (IsSignature o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructSignatureEncoding :: forall o (m :: * -> *).
(IsSignature o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructSignatureEncoding Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"encoding" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data SignatureEncodingPropertyInfo
instance AttrInfo SignatureEncodingPropertyInfo where
    type AttrAllowedOps SignatureEncodingPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SignatureEncodingPropertyInfo = IsSignature
    type AttrSetTypeConstraint SignatureEncodingPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint SignatureEncodingPropertyInfo = (~) T.Text
    type AttrTransferType SignatureEncodingPropertyInfo = T.Text
    type AttrGetType SignatureEncodingPropertyInfo = (Maybe T.Text)
    type AttrLabel SignatureEncodingPropertyInfo = "encoding"
    type AttrOrigin SignatureEncodingPropertyInfo = Signature
    attrGet = getSignatureEncoding
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructSignatureEncoding
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Objects.Signature.encoding"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Objects-Signature.html#g:attr:encoding"
        })
#endif

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

#if defined(ENABLE_OVERLOADING)
signatureEncoding :: AttrLabelProxy "encoding"
signatureEncoding = AttrLabelProxy

#endif

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

#endif

-- method Signature::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the person."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "email"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the email of the person."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "signature_time"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the time when the action happened."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Ggit" , name = "Signature" })
-- throws : True
-- Skip return : False

foreign import ccall "ggit_signature_new" ggit_signature_new :: 
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- email : TBasicType TUTF8
    Ptr GLib.DateTime.DateTime ->           -- signature_time : TInterface (Name {namespace = "GLib", name = "DateTime"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Signature)

-- | Creates a new t'GI.Ggit.Objects.Signature.Signature'. Name and e-mail are assumed to be in UTF-8.
signatureNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@name@/: the name of the person.
    -> T.Text
    -- ^ /@email@/: the email of the person.
    -> GLib.DateTime.DateTime
    -- ^ /@signatureTime@/: the time when the action happened.
    -> m (Maybe Signature)
    -- ^ __Returns:__ a newly allocated t'GI.Ggit.Objects.Signature.Signature' or 'P.Nothing'. /(Can throw 'Data.GI.Base.GError.GError')/
signatureNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Text -> DateTime -> m (Maybe Signature)
signatureNew Text
name Text
email DateTime
signatureTime = 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
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
email' <- Text -> IO CString
textToCString Text
email
    Ptr DateTime
signatureTime' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
signatureTime
    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
$ CString
-> CString
-> Ptr DateTime
-> Ptr (Ptr GError)
-> IO (Ptr Signature)
ggit_signature_new CString
name' CString
email' Ptr DateTime
signatureTime'
        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
Signature) Ptr Signature
result'
            Signature -> IO Signature
forall (m :: * -> *) a. Monad m => a -> m a
return Signature
result''
        DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
signatureTime
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
email'
        Maybe Signature -> IO (Maybe Signature)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Signature
maybeResult
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
email'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Signature::new_now
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the person."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "email"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the email of the person."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Ggit" , name = "Signature" })
-- throws : True
-- Skip return : False

foreign import ccall "ggit_signature_new_now" ggit_signature_new_now :: 
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- email : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Signature)

-- | Creates a new t'GI.Ggit.Objects.Signature.Signature' with a timestamp of \'now\'. Name and e-mail are
-- assumed to be in UTF-8.
signatureNewNow ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@name@/: the name of the person.
    -> T.Text
    -- ^ /@email@/: the email of the person.
    -> m (Maybe Signature)
    -- ^ __Returns:__ a newly allocated t'GI.Ggit.Objects.Signature.Signature' or 'P.Nothing'. /(Can throw 'Data.GI.Base.GError.GError')/
signatureNewNow :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Text -> m (Maybe Signature)
signatureNewNow Text
name Text
email = 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
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
email' <- Text -> IO CString
textToCString Text
email
    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
$ CString -> CString -> Ptr (Ptr GError) -> IO (Ptr Signature)
ggit_signature_new_now CString
name' CString
email'
        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
Signature) Ptr Signature
result'
            Signature -> IO Signature
forall (m :: * -> *) a. Monad m => a -> m a
return Signature
result''
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
email'
        Maybe Signature -> IO (Maybe Signature)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Signature
maybeResult
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
email'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Signature::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "signature"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Signature" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitSignature." , 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_signature_copy" ggit_signature_copy :: 
    Ptr Signature ->                        -- signature : TInterface (Name {namespace = "Ggit", name = "Signature"})
    IO (Ptr Signature)

-- | Create a copy of the signature.
signatureCopy ::
    (B.CallStack.HasCallStack, MonadIO m, IsSignature a) =>
    a
    -- ^ /@signature@/: a t'GI.Ggit.Objects.Signature.Signature'.
    -> m (Maybe Signature)
    -- ^ __Returns:__ a t'GI.Ggit.Objects.Signature.Signature' or 'P.Nothing'.
signatureCopy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSignature a) =>
a -> m (Maybe Signature)
signatureCopy a
signature = 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 Signature
signature' <- a -> IO (Ptr Signature)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
signature
    Ptr Signature
result <- Ptr Signature -> IO (Ptr Signature)
ggit_signature_copy 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
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
signature
    Maybe Signature -> IO (Maybe Signature)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Signature
maybeResult

#if defined(ENABLE_OVERLOADING)
data SignatureCopyMethodInfo
instance (signature ~ (m (Maybe Signature)), MonadIO m, IsSignature a) => O.OverloadedMethod SignatureCopyMethodInfo a signature where
    overloadedMethod = signatureCopy

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


#endif

-- method Signature::get_email
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "signature"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Signature" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitSignature." , 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_signature_get_email" ggit_signature_get_email :: 
    Ptr Signature ->                        -- signature : TInterface (Name {namespace = "Ggit", name = "Signature"})
    IO CString

-- | Gets the email of the person.
signatureGetEmail ::
    (B.CallStack.HasCallStack, MonadIO m, IsSignature a) =>
    a
    -- ^ /@signature@/: a t'GI.Ggit.Objects.Signature.Signature'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the email of the person or 'P.Nothing'.
signatureGetEmail :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSignature a) =>
a -> m (Maybe Text)
signatureGetEmail a
signature = 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 Signature
signature' <- a -> IO (Ptr Signature)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
signature
    CString
result <- Ptr Signature -> IO CString
ggit_signature_get_email Ptr Signature
signature'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
signature
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data SignatureGetEmailMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsSignature a) => O.OverloadedMethod SignatureGetEmailMethodInfo a signature where
    overloadedMethod = signatureGetEmail

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


#endif

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

-- | Gets the name of the person.
signatureGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsSignature a) =>
    a
    -- ^ /@signature@/: a t'GI.Ggit.Objects.Signature.Signature'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the name of the person or 'P.Nothing'.
signatureGetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSignature a) =>
a -> m (Maybe Text)
signatureGetName a
signature = 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 Signature
signature' <- a -> IO (Ptr Signature)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
signature
    CString
result <- Ptr Signature -> IO CString
ggit_signature_get_name Ptr Signature
signature'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
signature
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data SignatureGetNameMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsSignature a) => O.OverloadedMethod SignatureGetNameMethodInfo a signature where
    overloadedMethod = signatureGetName

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


#endif

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

foreign import ccall "ggit_signature_get_time" ggit_signature_get_time :: 
    Ptr Signature ->                        -- signature : TInterface (Name {namespace = "Ggit", name = "Signature"})
    IO (Ptr GLib.DateTime.DateTime)

-- | Gets the time when the action happened. Note that the time is returned in
-- the timezone of the commit (see @/ggit_signature_get_time_zone/@).
signatureGetTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsSignature a) =>
    a
    -- ^ /@signature@/: a t'GI.Ggit.Objects.Signature.Signature'.
    -> m (Maybe GLib.DateTime.DateTime)
    -- ^ __Returns:__ the time when the action happened or 'P.Nothing'.
signatureGetTime :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSignature a) =>
a -> m (Maybe DateTime)
signatureGetTime a
signature = IO (Maybe DateTime) -> m (Maybe DateTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DateTime) -> m (Maybe DateTime))
-> IO (Maybe DateTime) -> m (Maybe DateTime)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Signature
signature' <- a -> IO (Ptr Signature)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
signature
    Ptr DateTime
result <- Ptr Signature -> IO (Ptr DateTime)
ggit_signature_get_time Ptr Signature
signature'
    Maybe DateTime
maybeResult <- Ptr DateTime
-> (Ptr DateTime -> IO DateTime) -> IO (Maybe DateTime)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr DateTime
result ((Ptr DateTime -> IO DateTime) -> IO (Maybe DateTime))
-> (Ptr DateTime -> IO DateTime) -> IO (Maybe DateTime)
forall a b. (a -> b) -> a -> b
$ \Ptr DateTime
result' -> do
        DateTime
result'' <- ((ManagedPtr DateTime -> DateTime) -> Ptr DateTime -> IO DateTime
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DateTime -> DateTime
GLib.DateTime.DateTime) Ptr DateTime
result'
        DateTime -> IO DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return DateTime
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
signature
    Maybe DateTime -> IO (Maybe DateTime)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DateTime
maybeResult

#if defined(ENABLE_OVERLOADING)
data SignatureGetTimeMethodInfo
instance (signature ~ (m (Maybe GLib.DateTime.DateTime)), MonadIO m, IsSignature a) => O.OverloadedMethod SignatureGetTimeMethodInfo a signature where
    overloadedMethod = signatureGetTime

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


#endif

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

foreign import ccall "ggit_signature_get_time_zone" ggit_signature_get_time_zone :: 
    Ptr Signature ->                        -- signature : TInterface (Name {namespace = "Ggit", name = "Signature"})
    IO (Ptr GLib.TimeZone.TimeZone)

-- | Gets the timezone in which the action happened.
signatureGetTimeZone ::
    (B.CallStack.HasCallStack, MonadIO m, IsSignature a) =>
    a
    -- ^ /@signature@/: a t'GI.Ggit.Objects.Signature.Signature'.
    -> m (Maybe GLib.TimeZone.TimeZone)
    -- ^ __Returns:__ the timezone in which the action happened or 'P.Nothing'.
signatureGetTimeZone :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSignature a) =>
a -> m (Maybe TimeZone)
signatureGetTimeZone a
signature = IO (Maybe TimeZone) -> m (Maybe TimeZone)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TimeZone) -> m (Maybe TimeZone))
-> IO (Maybe TimeZone) -> m (Maybe TimeZone)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Signature
signature' <- a -> IO (Ptr Signature)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
signature
    Ptr TimeZone
result <- Ptr Signature -> IO (Ptr TimeZone)
ggit_signature_get_time_zone Ptr Signature
signature'
    Maybe TimeZone
maybeResult <- Ptr TimeZone
-> (Ptr TimeZone -> IO TimeZone) -> IO (Maybe TimeZone)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr TimeZone
result ((Ptr TimeZone -> IO TimeZone) -> IO (Maybe TimeZone))
-> (Ptr TimeZone -> IO TimeZone) -> IO (Maybe TimeZone)
forall a b. (a -> b) -> a -> b
$ \Ptr TimeZone
result' -> do
        TimeZone
result'' <- ((ManagedPtr TimeZone -> TimeZone) -> Ptr TimeZone -> IO TimeZone
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TimeZone -> TimeZone
GLib.TimeZone.TimeZone) Ptr TimeZone
result'
        TimeZone -> IO TimeZone
forall (m :: * -> *) a. Monad m => a -> m a
return TimeZone
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
signature
    Maybe TimeZone -> IO (Maybe TimeZone)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TimeZone
maybeResult

#if defined(ENABLE_OVERLOADING)
data SignatureGetTimeZoneMethodInfo
instance (signature ~ (m (Maybe GLib.TimeZone.TimeZone)), MonadIO m, IsSignature a) => O.OverloadedMethod SignatureGetTimeZoneMethodInfo a signature where
    overloadedMethod = signatureGetTimeZone

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


#endif