{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Ggit.Objects.DiffFormatEmailOptions
    ( 

-- * Exported types
    DiffFormatEmailOptions(..)              ,
    IsDiffFormatEmailOptions                ,
    toDiffFormatEmailOptions                ,


 -- * 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"), [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
-- [getAuthor]("GI.Ggit.Objects.DiffFormatEmailOptions#g:method:getAuthor"), [getBody]("GI.Ggit.Objects.DiffFormatEmailOptions#g:method:getBody"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFlags]("GI.Ggit.Objects.DiffFormatEmailOptions#g:method:getFlags"), [getId]("GI.Ggit.Objects.DiffFormatEmailOptions#g:method:getId"), [getPatchNumber]("GI.Ggit.Objects.DiffFormatEmailOptions#g:method:getPatchNumber"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSummary]("GI.Ggit.Objects.DiffFormatEmailOptions#g:method:getSummary"), [getTotalPatches]("GI.Ggit.Objects.DiffFormatEmailOptions#g:method:getTotalPatches").
-- 
-- ==== Setters
-- [setAuthor]("GI.Ggit.Objects.DiffFormatEmailOptions#g:method:setAuthor"), [setBody]("GI.Ggit.Objects.DiffFormatEmailOptions#g:method:setBody"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setFlags]("GI.Ggit.Objects.DiffFormatEmailOptions#g:method:setFlags"), [setId]("GI.Ggit.Objects.DiffFormatEmailOptions#g:method:setId"), [setPatchNumber]("GI.Ggit.Objects.DiffFormatEmailOptions#g:method:setPatchNumber"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSummary]("GI.Ggit.Objects.DiffFormatEmailOptions#g:method:setSummary"), [setTotalPatches]("GI.Ggit.Objects.DiffFormatEmailOptions#g:method:setTotalPatches").

#if defined(ENABLE_OVERLOADING)
    ResolveDiffFormatEmailOptionsMethod     ,
#endif

-- ** getAuthor #method:getAuthor#

#if defined(ENABLE_OVERLOADING)
    DiffFormatEmailOptionsGetAuthorMethodInfo,
#endif
    diffFormatEmailOptionsGetAuthor         ,


-- ** getBody #method:getBody#

#if defined(ENABLE_OVERLOADING)
    DiffFormatEmailOptionsGetBodyMethodInfo ,
#endif
    diffFormatEmailOptionsGetBody           ,


-- ** getFlags #method:getFlags#

#if defined(ENABLE_OVERLOADING)
    DiffFormatEmailOptionsGetFlagsMethodInfo,
#endif
    diffFormatEmailOptionsGetFlags          ,


-- ** getId #method:getId#

#if defined(ENABLE_OVERLOADING)
    DiffFormatEmailOptionsGetIdMethodInfo   ,
#endif
    diffFormatEmailOptionsGetId             ,


-- ** getPatchNumber #method:getPatchNumber#

#if defined(ENABLE_OVERLOADING)
    DiffFormatEmailOptionsGetPatchNumberMethodInfo,
#endif
    diffFormatEmailOptionsGetPatchNumber    ,


-- ** getSummary #method:getSummary#

#if defined(ENABLE_OVERLOADING)
    DiffFormatEmailOptionsGetSummaryMethodInfo,
#endif
    diffFormatEmailOptionsGetSummary        ,


-- ** getTotalPatches #method:getTotalPatches#

#if defined(ENABLE_OVERLOADING)
    DiffFormatEmailOptionsGetTotalPatchesMethodInfo,
#endif
    diffFormatEmailOptionsGetTotalPatches   ,


-- ** new #method:new#

    diffFormatEmailOptionsNew               ,


-- ** setAuthor #method:setAuthor#

#if defined(ENABLE_OVERLOADING)
    DiffFormatEmailOptionsSetAuthorMethodInfo,
#endif
    diffFormatEmailOptionsSetAuthor         ,


-- ** setBody #method:setBody#

#if defined(ENABLE_OVERLOADING)
    DiffFormatEmailOptionsSetBodyMethodInfo ,
#endif
    diffFormatEmailOptionsSetBody           ,


-- ** setFlags #method:setFlags#

#if defined(ENABLE_OVERLOADING)
    DiffFormatEmailOptionsSetFlagsMethodInfo,
#endif
    diffFormatEmailOptionsSetFlags          ,


-- ** setId #method:setId#

#if defined(ENABLE_OVERLOADING)
    DiffFormatEmailOptionsSetIdMethodInfo   ,
#endif
    diffFormatEmailOptionsSetId             ,


-- ** setPatchNumber #method:setPatchNumber#

#if defined(ENABLE_OVERLOADING)
    DiffFormatEmailOptionsSetPatchNumberMethodInfo,
#endif
    diffFormatEmailOptionsSetPatchNumber    ,


-- ** setSummary #method:setSummary#

#if defined(ENABLE_OVERLOADING)
    DiffFormatEmailOptionsSetSummaryMethodInfo,
#endif
    diffFormatEmailOptionsSetSummary        ,


-- ** setTotalPatches #method:setTotalPatches#

#if defined(ENABLE_OVERLOADING)
    DiffFormatEmailOptionsSetTotalPatchesMethodInfo,
#endif
    diffFormatEmailOptionsSetTotalPatches   ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    DiffFormatEmailOptionsAuthorPropertyInfo,
#endif
    clearDiffFormatEmailOptionsAuthor       ,
    constructDiffFormatEmailOptionsAuthor   ,
#if defined(ENABLE_OVERLOADING)
    diffFormatEmailOptionsAuthor            ,
#endif
    getDiffFormatEmailOptionsAuthor         ,
    setDiffFormatEmailOptionsAuthor         ,


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

#if defined(ENABLE_OVERLOADING)
    DiffFormatEmailOptionsBodyPropertyInfo  ,
#endif
    clearDiffFormatEmailOptionsBody         ,
    constructDiffFormatEmailOptionsBody     ,
#if defined(ENABLE_OVERLOADING)
    diffFormatEmailOptionsBody              ,
#endif
    getDiffFormatEmailOptionsBody           ,
    setDiffFormatEmailOptionsBody           ,


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

#if defined(ENABLE_OVERLOADING)
    DiffFormatEmailOptionsFlagsPropertyInfo ,
#endif
    constructDiffFormatEmailOptionsFlags    ,
#if defined(ENABLE_OVERLOADING)
    diffFormatEmailOptionsFlags             ,
#endif
    getDiffFormatEmailOptionsFlags          ,
    setDiffFormatEmailOptionsFlags          ,


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

#if defined(ENABLE_OVERLOADING)
    DiffFormatEmailOptionsIdPropertyInfo    ,
#endif
    clearDiffFormatEmailOptionsId           ,
    constructDiffFormatEmailOptionsId       ,
#if defined(ENABLE_OVERLOADING)
    diffFormatEmailOptionsId                ,
#endif
    getDiffFormatEmailOptionsId             ,
    setDiffFormatEmailOptionsId             ,


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

#if defined(ENABLE_OVERLOADING)
    DiffFormatEmailOptionsPatchNumberPropertyInfo,
#endif
    constructDiffFormatEmailOptionsPatchNumber,
#if defined(ENABLE_OVERLOADING)
    diffFormatEmailOptionsPatchNumber       ,
#endif
    getDiffFormatEmailOptionsPatchNumber    ,
    setDiffFormatEmailOptionsPatchNumber    ,


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

#if defined(ENABLE_OVERLOADING)
    DiffFormatEmailOptionsSummaryPropertyInfo,
#endif
    clearDiffFormatEmailOptionsSummary      ,
    constructDiffFormatEmailOptionsSummary  ,
#if defined(ENABLE_OVERLOADING)
    diffFormatEmailOptionsSummary           ,
#endif
    getDiffFormatEmailOptionsSummary        ,
    setDiffFormatEmailOptionsSummary        ,


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

#if defined(ENABLE_OVERLOADING)
    DiffFormatEmailOptionsTotalPatchesPropertyInfo,
#endif
    constructDiffFormatEmailOptionsTotalPatches,
#if defined(ENABLE_OVERLOADING)
    diffFormatEmailOptionsTotalPatches      ,
#endif
    getDiffFormatEmailOptionsTotalPatches   ,
    setDiffFormatEmailOptionsTotalPatches   ,




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

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

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

foreign import ccall "ggit_diff_format_email_options_get_type"
    c_ggit_diff_format_email_options_get_type :: IO B.Types.GType

instance B.Types.TypedObject DiffFormatEmailOptions where
    glibType :: IO GType
glibType = IO GType
c_ggit_diff_format_email_options_get_type

instance B.Types.GObject DiffFormatEmailOptions

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveDiffFormatEmailOptionsMethod (t :: Symbol) (o :: *) :: * where
    ResolveDiffFormatEmailOptionsMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDiffFormatEmailOptionsMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDiffFormatEmailOptionsMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDiffFormatEmailOptionsMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDiffFormatEmailOptionsMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDiffFormatEmailOptionsMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDiffFormatEmailOptionsMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDiffFormatEmailOptionsMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDiffFormatEmailOptionsMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDiffFormatEmailOptionsMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDiffFormatEmailOptionsMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDiffFormatEmailOptionsMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDiffFormatEmailOptionsMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDiffFormatEmailOptionsMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDiffFormatEmailOptionsMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDiffFormatEmailOptionsMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDiffFormatEmailOptionsMethod "getAuthor" o = DiffFormatEmailOptionsGetAuthorMethodInfo
    ResolveDiffFormatEmailOptionsMethod "getBody" o = DiffFormatEmailOptionsGetBodyMethodInfo
    ResolveDiffFormatEmailOptionsMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDiffFormatEmailOptionsMethod "getFlags" o = DiffFormatEmailOptionsGetFlagsMethodInfo
    ResolveDiffFormatEmailOptionsMethod "getId" o = DiffFormatEmailOptionsGetIdMethodInfo
    ResolveDiffFormatEmailOptionsMethod "getPatchNumber" o = DiffFormatEmailOptionsGetPatchNumberMethodInfo
    ResolveDiffFormatEmailOptionsMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDiffFormatEmailOptionsMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDiffFormatEmailOptionsMethod "getSummary" o = DiffFormatEmailOptionsGetSummaryMethodInfo
    ResolveDiffFormatEmailOptionsMethod "getTotalPatches" o = DiffFormatEmailOptionsGetTotalPatchesMethodInfo
    ResolveDiffFormatEmailOptionsMethod "setAuthor" o = DiffFormatEmailOptionsSetAuthorMethodInfo
    ResolveDiffFormatEmailOptionsMethod "setBody" o = DiffFormatEmailOptionsSetBodyMethodInfo
    ResolveDiffFormatEmailOptionsMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDiffFormatEmailOptionsMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDiffFormatEmailOptionsMethod "setFlags" o = DiffFormatEmailOptionsSetFlagsMethodInfo
    ResolveDiffFormatEmailOptionsMethod "setId" o = DiffFormatEmailOptionsSetIdMethodInfo
    ResolveDiffFormatEmailOptionsMethod "setPatchNumber" o = DiffFormatEmailOptionsSetPatchNumberMethodInfo
    ResolveDiffFormatEmailOptionsMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDiffFormatEmailOptionsMethod "setSummary" o = DiffFormatEmailOptionsSetSummaryMethodInfo
    ResolveDiffFormatEmailOptionsMethod "setTotalPatches" o = DiffFormatEmailOptionsSetTotalPatchesMethodInfo
    ResolveDiffFormatEmailOptionsMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "author"
   -- Type: TInterface (Name {namespace = "Ggit", name = "Signature"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

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

-- | Set the value of the “@author@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' diffFormatEmailOptions [ #author 'Data.GI.Base.Attributes.:=' value ]
-- @
setDiffFormatEmailOptionsAuthor :: (MonadIO m, IsDiffFormatEmailOptions o, Ggit.Signature.IsSignature a) => o -> a -> m ()
setDiffFormatEmailOptionsAuthor :: forall (m :: * -> *) o a.
(MonadIO m, IsDiffFormatEmailOptions o, IsSignature a) =>
o -> a -> m ()
setDiffFormatEmailOptionsAuthor o
obj a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"author" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@author@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDiffFormatEmailOptionsAuthor :: (IsDiffFormatEmailOptions o, MIO.MonadIO m, Ggit.Signature.IsSignature a) => a -> m (GValueConstruct o)
constructDiffFormatEmailOptionsAuthor :: forall o (m :: * -> *) a.
(IsDiffFormatEmailOptions o, MonadIO m, IsSignature a) =>
a -> m (GValueConstruct o)
constructDiffFormatEmailOptionsAuthor a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ 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 a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"author" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@author@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #author
-- @
clearDiffFormatEmailOptionsAuthor :: (MonadIO m, IsDiffFormatEmailOptions o) => o -> m ()
clearDiffFormatEmailOptionsAuthor :: forall (m :: * -> *) o.
(MonadIO m, IsDiffFormatEmailOptions o) =>
o -> m ()
clearDiffFormatEmailOptionsAuthor o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Signature -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"author" (Maybe Signature
forall a. Maybe a
Nothing :: Maybe Ggit.Signature.Signature)

#if defined(ENABLE_OVERLOADING)
data DiffFormatEmailOptionsAuthorPropertyInfo
instance AttrInfo DiffFormatEmailOptionsAuthorPropertyInfo where
    type AttrAllowedOps DiffFormatEmailOptionsAuthorPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DiffFormatEmailOptionsAuthorPropertyInfo = IsDiffFormatEmailOptions
    type AttrSetTypeConstraint DiffFormatEmailOptionsAuthorPropertyInfo = Ggit.Signature.IsSignature
    type AttrTransferTypeConstraint DiffFormatEmailOptionsAuthorPropertyInfo = Ggit.Signature.IsSignature
    type AttrTransferType DiffFormatEmailOptionsAuthorPropertyInfo = Ggit.Signature.Signature
    type AttrGetType DiffFormatEmailOptionsAuthorPropertyInfo = (Maybe Ggit.Signature.Signature)
    type AttrLabel DiffFormatEmailOptionsAuthorPropertyInfo = "author"
    type AttrOrigin DiffFormatEmailOptionsAuthorPropertyInfo = DiffFormatEmailOptions
    attrGet = getDiffFormatEmailOptionsAuthor
    attrSet = setDiffFormatEmailOptionsAuthor
    attrTransfer _ v = do
        unsafeCastTo Ggit.Signature.Signature v
    attrConstruct = constructDiffFormatEmailOptionsAuthor
    attrClear = clearDiffFormatEmailOptionsAuthor
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Objects.DiffFormatEmailOptions.author"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Objects-DiffFormatEmailOptions.html#g:attr:author"
        })
#endif

-- VVV Prop "body"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

-- | Get the value of the “@body@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' diffFormatEmailOptions #body
-- @
getDiffFormatEmailOptionsBody :: (MonadIO m, IsDiffFormatEmailOptions o) => o -> m (Maybe T.Text)
getDiffFormatEmailOptionsBody :: forall (m :: * -> *) o.
(MonadIO m, IsDiffFormatEmailOptions o) =>
o -> m (Maybe Text)
getDiffFormatEmailOptionsBody 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
"body"

-- | Set the value of the “@body@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' diffFormatEmailOptions [ #body 'Data.GI.Base.Attributes.:=' value ]
-- @
setDiffFormatEmailOptionsBody :: (MonadIO m, IsDiffFormatEmailOptions o) => o -> T.Text -> m ()
setDiffFormatEmailOptionsBody :: forall (m :: * -> *) o.
(MonadIO m, IsDiffFormatEmailOptions o) =>
o -> Text -> m ()
setDiffFormatEmailOptionsBody o
obj Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"body" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@body@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDiffFormatEmailOptionsBody :: (IsDiffFormatEmailOptions o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructDiffFormatEmailOptionsBody :: forall o (m :: * -> *).
(IsDiffFormatEmailOptions o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructDiffFormatEmailOptionsBody 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
"body" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@body@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #body
-- @
clearDiffFormatEmailOptionsBody :: (MonadIO m, IsDiffFormatEmailOptions o) => o -> m ()
clearDiffFormatEmailOptionsBody :: forall (m :: * -> *) o.
(MonadIO m, IsDiffFormatEmailOptions o) =>
o -> m ()
clearDiffFormatEmailOptionsBody o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"body" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

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

-- VVV Prop "flags"
   -- Type: TInterface (Name {namespace = "Ggit", name = "DiffFormatEmailFlags"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' diffFormatEmailOptions #flags
-- @
getDiffFormatEmailOptionsFlags :: (MonadIO m, IsDiffFormatEmailOptions o) => o -> m [Ggit.Flags.DiffFormatEmailFlags]
getDiffFormatEmailOptionsFlags :: forall (m :: * -> *) o.
(MonadIO m, IsDiffFormatEmailOptions o) =>
o -> m [DiffFormatEmailFlags]
getDiffFormatEmailOptionsFlags o
obj = IO [DiffFormatEmailFlags] -> m [DiffFormatEmailFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO [DiffFormatEmailFlags] -> m [DiffFormatEmailFlags])
-> IO [DiffFormatEmailFlags] -> m [DiffFormatEmailFlags]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [DiffFormatEmailFlags]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"flags"

-- | Set the value of the “@flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' diffFormatEmailOptions [ #flags 'Data.GI.Base.Attributes.:=' value ]
-- @
setDiffFormatEmailOptionsFlags :: (MonadIO m, IsDiffFormatEmailOptions o) => o -> [Ggit.Flags.DiffFormatEmailFlags] -> m ()
setDiffFormatEmailOptionsFlags :: forall (m :: * -> *) o.
(MonadIO m, IsDiffFormatEmailOptions o) =>
o -> [DiffFormatEmailFlags] -> m ()
setDiffFormatEmailOptionsFlags o
obj [DiffFormatEmailFlags]
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> [DiffFormatEmailFlags] -> IO ()
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj String
"flags" [DiffFormatEmailFlags]
val

-- | Construct a `GValueConstruct` with valid value for the “@flags@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDiffFormatEmailOptionsFlags :: (IsDiffFormatEmailOptions o, MIO.MonadIO m) => [Ggit.Flags.DiffFormatEmailFlags] -> m (GValueConstruct o)
constructDiffFormatEmailOptionsFlags :: forall o (m :: * -> *).
(IsDiffFormatEmailOptions o, MonadIO m) =>
[DiffFormatEmailFlags] -> m (GValueConstruct o)
constructDiffFormatEmailOptionsFlags [DiffFormatEmailFlags]
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 -> [DiffFormatEmailFlags] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"flags" [DiffFormatEmailFlags]
val

#if defined(ENABLE_OVERLOADING)
data DiffFormatEmailOptionsFlagsPropertyInfo
instance AttrInfo DiffFormatEmailOptionsFlagsPropertyInfo where
    type AttrAllowedOps DiffFormatEmailOptionsFlagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DiffFormatEmailOptionsFlagsPropertyInfo = IsDiffFormatEmailOptions
    type AttrSetTypeConstraint DiffFormatEmailOptionsFlagsPropertyInfo = (~) [Ggit.Flags.DiffFormatEmailFlags]
    type AttrTransferTypeConstraint DiffFormatEmailOptionsFlagsPropertyInfo = (~) [Ggit.Flags.DiffFormatEmailFlags]
    type AttrTransferType DiffFormatEmailOptionsFlagsPropertyInfo = [Ggit.Flags.DiffFormatEmailFlags]
    type AttrGetType DiffFormatEmailOptionsFlagsPropertyInfo = [Ggit.Flags.DiffFormatEmailFlags]
    type AttrLabel DiffFormatEmailOptionsFlagsPropertyInfo = "flags"
    type AttrOrigin DiffFormatEmailOptionsFlagsPropertyInfo = DiffFormatEmailOptions
    attrGet = getDiffFormatEmailOptionsFlags
    attrSet = setDiffFormatEmailOptionsFlags
    attrTransfer _ v = do
        return v
    attrConstruct = constructDiffFormatEmailOptionsFlags
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Objects.DiffFormatEmailOptions.flags"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Objects-DiffFormatEmailOptions.html#g:attr:flags"
        })
#endif

-- VVV Prop "id"
   -- Type: TInterface (Name {namespace = "Ggit", name = "OId"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

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

-- | Set the value of the “@id@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' diffFormatEmailOptions [ #id 'Data.GI.Base.Attributes.:=' value ]
-- @
setDiffFormatEmailOptionsId :: (MonadIO m, IsDiffFormatEmailOptions o) => o -> Ggit.OId.OId -> m ()
setDiffFormatEmailOptionsId :: forall (m :: * -> *) o.
(MonadIO m, IsDiffFormatEmailOptions o) =>
o -> OId -> m ()
setDiffFormatEmailOptionsId o
obj OId
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe OId -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"id" (OId -> Maybe OId
forall a. a -> Maybe a
Just OId
val)

-- | Construct a `GValueConstruct` with valid value for the “@id@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDiffFormatEmailOptionsId :: (IsDiffFormatEmailOptions o, MIO.MonadIO m) => Ggit.OId.OId -> m (GValueConstruct o)
constructDiffFormatEmailOptionsId :: forall o (m :: * -> *).
(IsDiffFormatEmailOptions o, MonadIO m) =>
OId -> m (GValueConstruct o)
constructDiffFormatEmailOptionsId OId
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 OId -> IO (GValueConstruct o)
forall a o. GBoxed a => String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed String
"id" (OId -> Maybe OId
forall a. a -> Maybe a
P.Just OId
val)

-- | Set the value of the “@id@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #id
-- @
clearDiffFormatEmailOptionsId :: (MonadIO m, IsDiffFormatEmailOptions o) => o -> m ()
clearDiffFormatEmailOptionsId :: forall (m :: * -> *) o.
(MonadIO m, IsDiffFormatEmailOptions o) =>
o -> m ()
clearDiffFormatEmailOptionsId o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe OId -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"id" (Maybe OId
forall a. Maybe a
Nothing :: Maybe Ggit.OId.OId)

#if defined(ENABLE_OVERLOADING)
data DiffFormatEmailOptionsIdPropertyInfo
instance AttrInfo DiffFormatEmailOptionsIdPropertyInfo where
    type AttrAllowedOps DiffFormatEmailOptionsIdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DiffFormatEmailOptionsIdPropertyInfo = IsDiffFormatEmailOptions
    type AttrSetTypeConstraint DiffFormatEmailOptionsIdPropertyInfo = (~) Ggit.OId.OId
    type AttrTransferTypeConstraint DiffFormatEmailOptionsIdPropertyInfo = (~) Ggit.OId.OId
    type AttrTransferType DiffFormatEmailOptionsIdPropertyInfo = Ggit.OId.OId
    type AttrGetType DiffFormatEmailOptionsIdPropertyInfo = (Maybe Ggit.OId.OId)
    type AttrLabel DiffFormatEmailOptionsIdPropertyInfo = "id"
    type AttrOrigin DiffFormatEmailOptionsIdPropertyInfo = DiffFormatEmailOptions
    attrGet = getDiffFormatEmailOptionsId
    attrSet = setDiffFormatEmailOptionsId
    attrTransfer _ v = do
        return v
    attrConstruct = constructDiffFormatEmailOptionsId
    attrClear = clearDiffFormatEmailOptionsId
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Objects.DiffFormatEmailOptions.id"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Objects-DiffFormatEmailOptions.html#g:attr:id"
        })
#endif

-- VVV Prop "patch-number"
   -- Type: TBasicType TUInt64
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@patch-number@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' diffFormatEmailOptions #patchNumber
-- @
getDiffFormatEmailOptionsPatchNumber :: (MonadIO m, IsDiffFormatEmailOptions o) => o -> m Word64
getDiffFormatEmailOptionsPatchNumber :: forall (m :: * -> *) o.
(MonadIO m, IsDiffFormatEmailOptions o) =>
o -> m Word64
getDiffFormatEmailOptionsPatchNumber o
obj = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word64
forall a. GObject a => a -> String -> IO Word64
B.Properties.getObjectPropertyUInt64 o
obj String
"patch-number"

-- | Set the value of the “@patch-number@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' diffFormatEmailOptions [ #patchNumber 'Data.GI.Base.Attributes.:=' value ]
-- @
setDiffFormatEmailOptionsPatchNumber :: (MonadIO m, IsDiffFormatEmailOptions o) => o -> Word64 -> m ()
setDiffFormatEmailOptionsPatchNumber :: forall (m :: * -> *) o.
(MonadIO m, IsDiffFormatEmailOptions o) =>
o -> Word64 -> m ()
setDiffFormatEmailOptionsPatchNumber o
obj Word64
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Word64 -> IO ()
forall a. GObject a => a -> String -> Word64 -> IO ()
B.Properties.setObjectPropertyUInt64 o
obj String
"patch-number" Word64
val

-- | Construct a `GValueConstruct` with valid value for the “@patch-number@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDiffFormatEmailOptionsPatchNumber :: (IsDiffFormatEmailOptions o, MIO.MonadIO m) => Word64 -> m (GValueConstruct o)
constructDiffFormatEmailOptionsPatchNumber :: forall o (m :: * -> *).
(IsDiffFormatEmailOptions o, MonadIO m) =>
Word64 -> m (GValueConstruct o)
constructDiffFormatEmailOptionsPatchNumber Word64
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 -> Word64 -> IO (GValueConstruct o)
forall o. String -> Word64 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt64 String
"patch-number" Word64
val

#if defined(ENABLE_OVERLOADING)
data DiffFormatEmailOptionsPatchNumberPropertyInfo
instance AttrInfo DiffFormatEmailOptionsPatchNumberPropertyInfo where
    type AttrAllowedOps DiffFormatEmailOptionsPatchNumberPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DiffFormatEmailOptionsPatchNumberPropertyInfo = IsDiffFormatEmailOptions
    type AttrSetTypeConstraint DiffFormatEmailOptionsPatchNumberPropertyInfo = (~) Word64
    type AttrTransferTypeConstraint DiffFormatEmailOptionsPatchNumberPropertyInfo = (~) Word64
    type AttrTransferType DiffFormatEmailOptionsPatchNumberPropertyInfo = Word64
    type AttrGetType DiffFormatEmailOptionsPatchNumberPropertyInfo = Word64
    type AttrLabel DiffFormatEmailOptionsPatchNumberPropertyInfo = "patch-number"
    type AttrOrigin DiffFormatEmailOptionsPatchNumberPropertyInfo = DiffFormatEmailOptions
    attrGet = getDiffFormatEmailOptionsPatchNumber
    attrSet = setDiffFormatEmailOptionsPatchNumber
    attrTransfer _ v = do
        return v
    attrConstruct = constructDiffFormatEmailOptionsPatchNumber
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Objects.DiffFormatEmailOptions.patchNumber"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Objects-DiffFormatEmailOptions.html#g:attr:patchNumber"
        })
#endif

-- VVV Prop "summary"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

-- | Get the value of the “@summary@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' diffFormatEmailOptions #summary
-- @
getDiffFormatEmailOptionsSummary :: (MonadIO m, IsDiffFormatEmailOptions o) => o -> m (Maybe T.Text)
getDiffFormatEmailOptionsSummary :: forall (m :: * -> *) o.
(MonadIO m, IsDiffFormatEmailOptions o) =>
o -> m (Maybe Text)
getDiffFormatEmailOptionsSummary 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
"summary"

-- | Set the value of the “@summary@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' diffFormatEmailOptions [ #summary 'Data.GI.Base.Attributes.:=' value ]
-- @
setDiffFormatEmailOptionsSummary :: (MonadIO m, IsDiffFormatEmailOptions o) => o -> T.Text -> m ()
setDiffFormatEmailOptionsSummary :: forall (m :: * -> *) o.
(MonadIO m, IsDiffFormatEmailOptions o) =>
o -> Text -> m ()
setDiffFormatEmailOptionsSummary o
obj Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"summary" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@summary@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDiffFormatEmailOptionsSummary :: (IsDiffFormatEmailOptions o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructDiffFormatEmailOptionsSummary :: forall o (m :: * -> *).
(IsDiffFormatEmailOptions o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructDiffFormatEmailOptionsSummary 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
"summary" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@summary@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #summary
-- @
clearDiffFormatEmailOptionsSummary :: (MonadIO m, IsDiffFormatEmailOptions o) => o -> m ()
clearDiffFormatEmailOptionsSummary :: forall (m :: * -> *) o.
(MonadIO m, IsDiffFormatEmailOptions o) =>
o -> m ()
clearDiffFormatEmailOptionsSummary o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"summary" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

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

-- VVV Prop "total-patches"
   -- Type: TBasicType TUInt64
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@total-patches@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' diffFormatEmailOptions #totalPatches
-- @
getDiffFormatEmailOptionsTotalPatches :: (MonadIO m, IsDiffFormatEmailOptions o) => o -> m Word64
getDiffFormatEmailOptionsTotalPatches :: forall (m :: * -> *) o.
(MonadIO m, IsDiffFormatEmailOptions o) =>
o -> m Word64
getDiffFormatEmailOptionsTotalPatches o
obj = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word64
forall a. GObject a => a -> String -> IO Word64
B.Properties.getObjectPropertyUInt64 o
obj String
"total-patches"

-- | Set the value of the “@total-patches@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' diffFormatEmailOptions [ #totalPatches 'Data.GI.Base.Attributes.:=' value ]
-- @
setDiffFormatEmailOptionsTotalPatches :: (MonadIO m, IsDiffFormatEmailOptions o) => o -> Word64 -> m ()
setDiffFormatEmailOptionsTotalPatches :: forall (m :: * -> *) o.
(MonadIO m, IsDiffFormatEmailOptions o) =>
o -> Word64 -> m ()
setDiffFormatEmailOptionsTotalPatches o
obj Word64
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Word64 -> IO ()
forall a. GObject a => a -> String -> Word64 -> IO ()
B.Properties.setObjectPropertyUInt64 o
obj String
"total-patches" Word64
val

-- | Construct a `GValueConstruct` with valid value for the “@total-patches@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDiffFormatEmailOptionsTotalPatches :: (IsDiffFormatEmailOptions o, MIO.MonadIO m) => Word64 -> m (GValueConstruct o)
constructDiffFormatEmailOptionsTotalPatches :: forall o (m :: * -> *).
(IsDiffFormatEmailOptions o, MonadIO m) =>
Word64 -> m (GValueConstruct o)
constructDiffFormatEmailOptionsTotalPatches Word64
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 -> Word64 -> IO (GValueConstruct o)
forall o. String -> Word64 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt64 String
"total-patches" Word64
val

#if defined(ENABLE_OVERLOADING)
data DiffFormatEmailOptionsTotalPatchesPropertyInfo
instance AttrInfo DiffFormatEmailOptionsTotalPatchesPropertyInfo where
    type AttrAllowedOps DiffFormatEmailOptionsTotalPatchesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DiffFormatEmailOptionsTotalPatchesPropertyInfo = IsDiffFormatEmailOptions
    type AttrSetTypeConstraint DiffFormatEmailOptionsTotalPatchesPropertyInfo = (~) Word64
    type AttrTransferTypeConstraint DiffFormatEmailOptionsTotalPatchesPropertyInfo = (~) Word64
    type AttrTransferType DiffFormatEmailOptionsTotalPatchesPropertyInfo = Word64
    type AttrGetType DiffFormatEmailOptionsTotalPatchesPropertyInfo = Word64
    type AttrLabel DiffFormatEmailOptionsTotalPatchesPropertyInfo = "total-patches"
    type AttrOrigin DiffFormatEmailOptionsTotalPatchesPropertyInfo = DiffFormatEmailOptions
    attrGet = getDiffFormatEmailOptionsTotalPatches
    attrSet = setDiffFormatEmailOptionsTotalPatches
    attrTransfer _ v = do
        return v
    attrConstruct = constructDiffFormatEmailOptionsTotalPatches
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Objects.DiffFormatEmailOptions.totalPatches"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Objects-DiffFormatEmailOptions.html#g:attr:totalPatches"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DiffFormatEmailOptions
type instance O.AttributeList DiffFormatEmailOptions = DiffFormatEmailOptionsAttributeList
type DiffFormatEmailOptionsAttributeList = ('[ '("author", DiffFormatEmailOptionsAuthorPropertyInfo), '("body", DiffFormatEmailOptionsBodyPropertyInfo), '("flags", DiffFormatEmailOptionsFlagsPropertyInfo), '("id", DiffFormatEmailOptionsIdPropertyInfo), '("patchNumber", DiffFormatEmailOptionsPatchNumberPropertyInfo), '("summary", DiffFormatEmailOptionsSummaryPropertyInfo), '("totalPatches", DiffFormatEmailOptionsTotalPatchesPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
diffFormatEmailOptionsAuthor :: AttrLabelProxy "author"
diffFormatEmailOptionsAuthor = AttrLabelProxy

diffFormatEmailOptionsBody :: AttrLabelProxy "body"
diffFormatEmailOptionsBody = AttrLabelProxy

diffFormatEmailOptionsFlags :: AttrLabelProxy "flags"
diffFormatEmailOptionsFlags = AttrLabelProxy

diffFormatEmailOptionsId :: AttrLabelProxy "id"
diffFormatEmailOptionsId = AttrLabelProxy

diffFormatEmailOptionsPatchNumber :: AttrLabelProxy "patchNumber"
diffFormatEmailOptionsPatchNumber = AttrLabelProxy

diffFormatEmailOptionsSummary :: AttrLabelProxy "summary"
diffFormatEmailOptionsSummary = AttrLabelProxy

diffFormatEmailOptionsTotalPatches :: AttrLabelProxy "totalPatches"
diffFormatEmailOptionsTotalPatches = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "ggit_diff_format_email_options_new" ggit_diff_format_email_options_new :: 
    IO (Ptr DiffFormatEmailOptions)

-- | Create a new checkout options object.
diffFormatEmailOptionsNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m (Maybe DiffFormatEmailOptions)
    -- ^ __Returns:__ a t'GI.Ggit.Objects.DiffFormatEmailOptions.DiffFormatEmailOptions' or 'P.Nothing'.
diffFormatEmailOptionsNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m (Maybe DiffFormatEmailOptions)
diffFormatEmailOptionsNew  = IO (Maybe DiffFormatEmailOptions)
-> m (Maybe DiffFormatEmailOptions)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DiffFormatEmailOptions)
 -> m (Maybe DiffFormatEmailOptions))
-> IO (Maybe DiffFormatEmailOptions)
-> m (Maybe DiffFormatEmailOptions)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFormatEmailOptions
result <- IO (Ptr DiffFormatEmailOptions)
ggit_diff_format_email_options_new
    Maybe DiffFormatEmailOptions
maybeResult <- Ptr DiffFormatEmailOptions
-> (Ptr DiffFormatEmailOptions -> IO DiffFormatEmailOptions)
-> IO (Maybe DiffFormatEmailOptions)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr DiffFormatEmailOptions
result ((Ptr DiffFormatEmailOptions -> IO DiffFormatEmailOptions)
 -> IO (Maybe DiffFormatEmailOptions))
-> (Ptr DiffFormatEmailOptions -> IO DiffFormatEmailOptions)
-> IO (Maybe DiffFormatEmailOptions)
forall a b. (a -> b) -> a -> b
$ \Ptr DiffFormatEmailOptions
result' -> do
        DiffFormatEmailOptions
result'' <- ((ManagedPtr DiffFormatEmailOptions -> DiffFormatEmailOptions)
-> Ptr DiffFormatEmailOptions -> IO DiffFormatEmailOptions
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DiffFormatEmailOptions -> DiffFormatEmailOptions
DiffFormatEmailOptions) Ptr DiffFormatEmailOptions
result'
        DiffFormatEmailOptions -> IO DiffFormatEmailOptions
forall (m :: * -> *) a. Monad m => a -> m a
return DiffFormatEmailOptions
result''
    Maybe DiffFormatEmailOptions -> IO (Maybe DiffFormatEmailOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DiffFormatEmailOptions
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method DiffFormatEmailOptions::get_author
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface
--                 Name { namespace = "Ggit" , name = "DiffFormatEmailOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFormatEmailOptions."
--                 , 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_diff_format_email_options_get_author" ggit_diff_format_email_options_get_author :: 
    Ptr DiffFormatEmailOptions ->           -- options : TInterface (Name {namespace = "Ggit", name = "DiffFormatEmailOptions"})
    IO (Ptr Ggit.Signature.Signature)

-- | Get the author.
diffFormatEmailOptionsGetAuthor ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFormatEmailOptions.DiffFormatEmailOptions'.
    -> m (Maybe Ggit.Signature.Signature)
    -- ^ __Returns:__ a t'GI.Ggit.Objects.Signature.Signature' or 'P.Nothing'.
diffFormatEmailOptionsGetAuthor :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
a -> m (Maybe Signature)
diffFormatEmailOptionsGetAuthor a
options = 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 DiffFormatEmailOptions
options' <- a -> IO (Ptr DiffFormatEmailOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Ptr Signature
result <- Ptr DiffFormatEmailOptions -> IO (Ptr Signature)
ggit_diff_format_email_options_get_author Ptr DiffFormatEmailOptions
options'
    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
newObject 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
options
    Maybe Signature -> IO (Maybe Signature)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Signature
maybeResult

#if defined(ENABLE_OVERLOADING)
data DiffFormatEmailOptionsGetAuthorMethodInfo
instance (signature ~ (m (Maybe Ggit.Signature.Signature)), MonadIO m, IsDiffFormatEmailOptions a) => O.OverloadedMethod DiffFormatEmailOptionsGetAuthorMethodInfo a signature where
    overloadedMethod = diffFormatEmailOptionsGetAuthor

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


#endif

-- method DiffFormatEmailOptions::get_body
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface
--                 Name { namespace = "Ggit" , name = "DiffFormatEmailOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFormatEmailOptions."
--                 , 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_diff_format_email_options_get_body" ggit_diff_format_email_options_get_body :: 
    Ptr DiffFormatEmailOptions ->           -- options : TInterface (Name {namespace = "Ggit", name = "DiffFormatEmailOptions"})
    IO CString

-- | Get the body.
diffFormatEmailOptionsGetBody ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFormatEmailOptions.DiffFormatEmailOptions'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the body.
diffFormatEmailOptionsGetBody :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
a -> m (Maybe Text)
diffFormatEmailOptionsGetBody a
options = 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 DiffFormatEmailOptions
options' <- a -> IO (Ptr DiffFormatEmailOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    CString
result <- Ptr DiffFormatEmailOptions -> IO CString
ggit_diff_format_email_options_get_body Ptr DiffFormatEmailOptions
options'
    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
options
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

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

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


#endif

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

foreign import ccall "ggit_diff_format_email_options_get_flags" ggit_diff_format_email_options_get_flags :: 
    Ptr DiffFormatEmailOptions ->           -- options : TInterface (Name {namespace = "Ggit", name = "DiffFormatEmailOptions"})
    IO CUInt

-- | Get the flags.
diffFormatEmailOptionsGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFormatEmailOptions.DiffFormatEmailOptions'.
    -> m [Ggit.Flags.DiffFormatEmailFlags]
    -- ^ __Returns:__ a t'GI.Ggit.Flags.DiffFormatEmailFlags'.
diffFormatEmailOptionsGetFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
a -> m [DiffFormatEmailFlags]
diffFormatEmailOptionsGetFlags a
options = IO [DiffFormatEmailFlags] -> m [DiffFormatEmailFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DiffFormatEmailFlags] -> m [DiffFormatEmailFlags])
-> IO [DiffFormatEmailFlags] -> m [DiffFormatEmailFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFormatEmailOptions
options' <- a -> IO (Ptr DiffFormatEmailOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    CUInt
result <- Ptr DiffFormatEmailOptions -> IO CUInt
ggit_diff_format_email_options_get_flags Ptr DiffFormatEmailOptions
options'
    let result' :: [DiffFormatEmailFlags]
result' = CUInt -> [DiffFormatEmailFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    [DiffFormatEmailFlags] -> IO [DiffFormatEmailFlags]
forall (m :: * -> *) a. Monad m => a -> m a
return [DiffFormatEmailFlags]
result'

#if defined(ENABLE_OVERLOADING)
data DiffFormatEmailOptionsGetFlagsMethodInfo
instance (signature ~ (m [Ggit.Flags.DiffFormatEmailFlags]), MonadIO m, IsDiffFormatEmailOptions a) => O.OverloadedMethod DiffFormatEmailOptionsGetFlagsMethodInfo a signature where
    overloadedMethod = diffFormatEmailOptionsGetFlags

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


#endif

-- method DiffFormatEmailOptions::get_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface
--                 Name { namespace = "Ggit" , name = "DiffFormatEmailOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFormatEmailOptions."
--                 , 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_diff_format_email_options_get_id" ggit_diff_format_email_options_get_id :: 
    Ptr DiffFormatEmailOptions ->           -- options : TInterface (Name {namespace = "Ggit", name = "DiffFormatEmailOptions"})
    IO (Ptr Ggit.OId.OId)

-- | Get the object id.
diffFormatEmailOptionsGetId ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFormatEmailOptions.DiffFormatEmailOptions'.
    -> m (Maybe Ggit.OId.OId)
    -- ^ __Returns:__ a t'GI.Ggit.Structs.OId.OId' or 'P.Nothing'.
diffFormatEmailOptionsGetId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
a -> m (Maybe OId)
diffFormatEmailOptionsGetId a
options = 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 DiffFormatEmailOptions
options' <- a -> IO (Ptr DiffFormatEmailOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Ptr OId
result <- Ptr DiffFormatEmailOptions -> IO (Ptr OId)
ggit_diff_format_email_options_get_id Ptr DiffFormatEmailOptions
options'
    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
newBoxed 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
options
    Maybe OId -> IO (Maybe OId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe OId
maybeResult

#if defined(ENABLE_OVERLOADING)
data DiffFormatEmailOptionsGetIdMethodInfo
instance (signature ~ (m (Maybe Ggit.OId.OId)), MonadIO m, IsDiffFormatEmailOptions a) => O.OverloadedMethod DiffFormatEmailOptionsGetIdMethodInfo a signature where
    overloadedMethod = diffFormatEmailOptionsGetId

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


#endif

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

foreign import ccall "ggit_diff_format_email_options_get_patch_number" ggit_diff_format_email_options_get_patch_number :: 
    Ptr DiffFormatEmailOptions ->           -- options : TInterface (Name {namespace = "Ggit", name = "DiffFormatEmailOptions"})
    IO Word64

-- | Get the patch number.
diffFormatEmailOptionsGetPatchNumber ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFormatEmailOptions.DiffFormatEmailOptions'.
    -> m Word64
    -- ^ __Returns:__ the patch number.
diffFormatEmailOptionsGetPatchNumber :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
a -> m Word64
diffFormatEmailOptionsGetPatchNumber a
options = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFormatEmailOptions
options' <- a -> IO (Ptr DiffFormatEmailOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Word64
result <- Ptr DiffFormatEmailOptions -> IO Word64
ggit_diff_format_email_options_get_patch_number Ptr DiffFormatEmailOptions
options'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data DiffFormatEmailOptionsGetPatchNumberMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsDiffFormatEmailOptions a) => O.OverloadedMethod DiffFormatEmailOptionsGetPatchNumberMethodInfo a signature where
    overloadedMethod = diffFormatEmailOptionsGetPatchNumber

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


#endif

-- method DiffFormatEmailOptions::get_summary
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface
--                 Name { namespace = "Ggit" , name = "DiffFormatEmailOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFormatEmailOptions."
--                 , 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_diff_format_email_options_get_summary" ggit_diff_format_email_options_get_summary :: 
    Ptr DiffFormatEmailOptions ->           -- options : TInterface (Name {namespace = "Ggit", name = "DiffFormatEmailOptions"})
    IO CString

-- | Get the summary.
diffFormatEmailOptionsGetSummary ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFormatEmailOptions.DiffFormatEmailOptions'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the summary.
diffFormatEmailOptionsGetSummary :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
a -> m (Maybe Text)
diffFormatEmailOptionsGetSummary a
options = 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 DiffFormatEmailOptions
options' <- a -> IO (Ptr DiffFormatEmailOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    CString
result <- Ptr DiffFormatEmailOptions -> IO CString
ggit_diff_format_email_options_get_summary Ptr DiffFormatEmailOptions
options'
    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
options
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

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

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


#endif

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

foreign import ccall "ggit_diff_format_email_options_get_total_patches" ggit_diff_format_email_options_get_total_patches :: 
    Ptr DiffFormatEmailOptions ->           -- options : TInterface (Name {namespace = "Ggit", name = "DiffFormatEmailOptions"})
    IO Word64

-- | Get the total number of patches.
diffFormatEmailOptionsGetTotalPatches ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFormatEmailOptions.DiffFormatEmailOptions'.
    -> m Word64
    -- ^ __Returns:__ the total number of patches.
diffFormatEmailOptionsGetTotalPatches :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
a -> m Word64
diffFormatEmailOptionsGetTotalPatches a
options = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFormatEmailOptions
options' <- a -> IO (Ptr DiffFormatEmailOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Word64
result <- Ptr DiffFormatEmailOptions -> IO Word64
ggit_diff_format_email_options_get_total_patches Ptr DiffFormatEmailOptions
options'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data DiffFormatEmailOptionsGetTotalPatchesMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsDiffFormatEmailOptions a) => O.OverloadedMethod DiffFormatEmailOptionsGetTotalPatchesMethodInfo a signature where
    overloadedMethod = diffFormatEmailOptionsGetTotalPatches

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


#endif

-- method DiffFormatEmailOptions::set_author
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface
--                 Name { namespace = "Ggit" , name = "DiffFormatEmailOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFormatEmailOptions."
--                 , 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 = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitSignature." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ggit_diff_format_email_options_set_author" ggit_diff_format_email_options_set_author :: 
    Ptr DiffFormatEmailOptions ->           -- options : TInterface (Name {namespace = "Ggit", name = "DiffFormatEmailOptions"})
    Ptr Ggit.Signature.Signature ->         -- author : TInterface (Name {namespace = "Ggit", name = "Signature"})
    IO ()

-- | Set the author.
diffFormatEmailOptionsSetAuthor ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFormatEmailOptions a, Ggit.Signature.IsSignature b) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFormatEmailOptions.DiffFormatEmailOptions'.
    -> Maybe (b)
    -- ^ /@author@/: a t'GI.Ggit.Objects.Signature.Signature'.
    -> m ()
diffFormatEmailOptionsSetAuthor :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDiffFormatEmailOptions a,
 IsSignature b) =>
a -> Maybe b -> m ()
diffFormatEmailOptionsSetAuthor a
options Maybe b
author = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFormatEmailOptions
options' <- a -> IO (Ptr DiffFormatEmailOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Ptr Signature
maybeAuthor <- case Maybe b
author of
        Maybe b
Nothing -> Ptr Signature -> IO (Ptr Signature)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Signature
forall a. Ptr a
nullPtr
        Just b
jAuthor -> do
            Ptr Signature
jAuthor' <- b -> IO (Ptr Signature)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jAuthor
            Ptr Signature -> IO (Ptr Signature)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Signature
jAuthor'
    Ptr DiffFormatEmailOptions -> Ptr Signature -> IO ()
ggit_diff_format_email_options_set_author Ptr DiffFormatEmailOptions
options' Ptr Signature
maybeAuthor
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
author b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DiffFormatEmailOptionsSetAuthorMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsDiffFormatEmailOptions a, Ggit.Signature.IsSignature b) => O.OverloadedMethod DiffFormatEmailOptionsSetAuthorMethodInfo a signature where
    overloadedMethod = diffFormatEmailOptionsSetAuthor

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


#endif

-- method DiffFormatEmailOptions::set_body
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface
--                 Name { namespace = "Ggit" , name = "DiffFormatEmailOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFormatEmailOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "body"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the body." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ggit_diff_format_email_options_set_body" ggit_diff_format_email_options_set_body :: 
    Ptr DiffFormatEmailOptions ->           -- options : TInterface (Name {namespace = "Ggit", name = "DiffFormatEmailOptions"})
    CString ->                              -- body : TBasicType TUTF8
    IO ()

-- | Set the body.
diffFormatEmailOptionsSetBody ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFormatEmailOptions.DiffFormatEmailOptions'.
    -> Maybe (T.Text)
    -- ^ /@body@/: the body.
    -> m ()
diffFormatEmailOptionsSetBody :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
a -> Maybe Text -> m ()
diffFormatEmailOptionsSetBody a
options Maybe Text
body = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFormatEmailOptions
options' <- a -> IO (Ptr DiffFormatEmailOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    CString
maybeBody <- case Maybe Text
body of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jBody -> do
            CString
jBody' <- Text -> IO CString
textToCString Text
jBody
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jBody'
    Ptr DiffFormatEmailOptions -> CString -> IO ()
ggit_diff_format_email_options_set_body Ptr DiffFormatEmailOptions
options' CString
maybeBody
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeBody
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method DiffFormatEmailOptions::set_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface
--                 Name { namespace = "Ggit" , name = "DiffFormatEmailOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFormatEmailOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Ggit" , name = "DiffFormatEmailFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFormatEmailFlags."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ggit_diff_format_email_options_set_flags" ggit_diff_format_email_options_set_flags :: 
    Ptr DiffFormatEmailOptions ->           -- options : TInterface (Name {namespace = "Ggit", name = "DiffFormatEmailOptions"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Ggit", name = "DiffFormatEmailFlags"})
    IO ()

-- | Set the flags.
diffFormatEmailOptionsSetFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFormatEmailOptions.DiffFormatEmailOptions'.
    -> [Ggit.Flags.DiffFormatEmailFlags]
    -- ^ /@flags@/: a t'GI.Ggit.Flags.DiffFormatEmailFlags'.
    -> m ()
diffFormatEmailOptionsSetFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
a -> [DiffFormatEmailFlags] -> m ()
diffFormatEmailOptionsSetFlags a
options [DiffFormatEmailFlags]
flags = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFormatEmailOptions
options' <- a -> IO (Ptr DiffFormatEmailOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    let flags' :: CUInt
flags' = [DiffFormatEmailFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [DiffFormatEmailFlags]
flags
    Ptr DiffFormatEmailOptions -> CUInt -> IO ()
ggit_diff_format_email_options_set_flags Ptr DiffFormatEmailOptions
options' CUInt
flags'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DiffFormatEmailOptionsSetFlagsMethodInfo
instance (signature ~ ([Ggit.Flags.DiffFormatEmailFlags] -> m ()), MonadIO m, IsDiffFormatEmailOptions a) => O.OverloadedMethod DiffFormatEmailOptionsSetFlagsMethodInfo a signature where
    overloadedMethod = diffFormatEmailOptionsSetFlags

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


#endif

-- method DiffFormatEmailOptions::set_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface
--                 Name { namespace = "Ggit" , name = "DiffFormatEmailOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFormatEmailOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TInterface Name { namespace = "Ggit" , name = "OId" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitOId." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ggit_diff_format_email_options_set_id" ggit_diff_format_email_options_set_id :: 
    Ptr DiffFormatEmailOptions ->           -- options : TInterface (Name {namespace = "Ggit", name = "DiffFormatEmailOptions"})
    Ptr Ggit.OId.OId ->                     -- id : TInterface (Name {namespace = "Ggit", name = "OId"})
    IO ()

-- | Set the object id.
diffFormatEmailOptionsSetId ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFormatEmailOptions.DiffFormatEmailOptions'.
    -> Maybe (Ggit.OId.OId)
    -- ^ /@id@/: a t'GI.Ggit.Structs.OId.OId'.
    -> m ()
diffFormatEmailOptionsSetId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
a -> Maybe OId -> m ()
diffFormatEmailOptionsSetId a
options Maybe OId
id = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFormatEmailOptions
options' <- a -> IO (Ptr DiffFormatEmailOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Ptr OId
maybeId <- case Maybe OId
id of
        Maybe OId
Nothing -> Ptr OId -> IO (Ptr OId)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr OId
forall a. Ptr a
nullPtr
        Just OId
jId -> do
            Ptr OId
jId' <- OId -> IO (Ptr OId)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr OId
jId
            Ptr OId -> IO (Ptr OId)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr OId
jId'
    Ptr DiffFormatEmailOptions -> Ptr OId -> IO ()
ggit_diff_format_email_options_set_id Ptr DiffFormatEmailOptions
options' Ptr OId
maybeId
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    Maybe OId -> (OId -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe OId
id OId -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DiffFormatEmailOptionsSetIdMethodInfo
instance (signature ~ (Maybe (Ggit.OId.OId) -> m ()), MonadIO m, IsDiffFormatEmailOptions a) => O.OverloadedMethod DiffFormatEmailOptionsSetIdMethodInfo a signature where
    overloadedMethod = diffFormatEmailOptionsSetId

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


#endif

-- method DiffFormatEmailOptions::set_patch_number
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface
--                 Name { namespace = "Ggit" , name = "DiffFormatEmailOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFormatEmailOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "number"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the patch number." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ggit_diff_format_email_options_set_patch_number" ggit_diff_format_email_options_set_patch_number :: 
    Ptr DiffFormatEmailOptions ->           -- options : TInterface (Name {namespace = "Ggit", name = "DiffFormatEmailOptions"})
    Word64 ->                               -- number : TBasicType TUInt64
    IO ()

-- | Set the patch number.
diffFormatEmailOptionsSetPatchNumber ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFormatEmailOptions.DiffFormatEmailOptions'.
    -> Word64
    -- ^ /@number@/: the patch number.
    -> m ()
diffFormatEmailOptionsSetPatchNumber :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
a -> Word64 -> m ()
diffFormatEmailOptionsSetPatchNumber a
options Word64
number = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFormatEmailOptions
options' <- a -> IO (Ptr DiffFormatEmailOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Ptr DiffFormatEmailOptions -> Word64 -> IO ()
ggit_diff_format_email_options_set_patch_number Ptr DiffFormatEmailOptions
options' Word64
number
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DiffFormatEmailOptionsSetPatchNumberMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m, IsDiffFormatEmailOptions a) => O.OverloadedMethod DiffFormatEmailOptionsSetPatchNumberMethodInfo a signature where
    overloadedMethod = diffFormatEmailOptionsSetPatchNumber

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


#endif

-- method DiffFormatEmailOptions::set_summary
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface
--                 Name { namespace = "Ggit" , name = "DiffFormatEmailOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFormatEmailOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "summary"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the summary." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ggit_diff_format_email_options_set_summary" ggit_diff_format_email_options_set_summary :: 
    Ptr DiffFormatEmailOptions ->           -- options : TInterface (Name {namespace = "Ggit", name = "DiffFormatEmailOptions"})
    CString ->                              -- summary : TBasicType TUTF8
    IO ()

-- | Set the summary.
diffFormatEmailOptionsSetSummary ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFormatEmailOptions.DiffFormatEmailOptions'.
    -> Maybe (T.Text)
    -- ^ /@summary@/: the summary.
    -> m ()
diffFormatEmailOptionsSetSummary :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
a -> Maybe Text -> m ()
diffFormatEmailOptionsSetSummary a
options Maybe Text
summary = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFormatEmailOptions
options' <- a -> IO (Ptr DiffFormatEmailOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    CString
maybeSummary <- case Maybe Text
summary of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jSummary -> do
            CString
jSummary' <- Text -> IO CString
textToCString Text
jSummary
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jSummary'
    Ptr DiffFormatEmailOptions -> CString -> IO ()
ggit_diff_format_email_options_set_summary Ptr DiffFormatEmailOptions
options' CString
maybeSummary
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeSummary
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method DiffFormatEmailOptions::set_total_patches
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface
--                 Name { namespace = "Ggit" , name = "DiffFormatEmailOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFormatEmailOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "patches"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the total number of patches."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ggit_diff_format_email_options_set_total_patches" ggit_diff_format_email_options_set_total_patches :: 
    Ptr DiffFormatEmailOptions ->           -- options : TInterface (Name {namespace = "Ggit", name = "DiffFormatEmailOptions"})
    Word64 ->                               -- patches : TBasicType TUInt64
    IO ()

-- | Set the total number of patches.
diffFormatEmailOptionsSetTotalPatches ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFormatEmailOptions.DiffFormatEmailOptions'.
    -> Word64
    -- ^ /@patches@/: the total number of patches.
    -> m ()
diffFormatEmailOptionsSetTotalPatches :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFormatEmailOptions a) =>
a -> Word64 -> m ()
diffFormatEmailOptionsSetTotalPatches a
options Word64
patches = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFormatEmailOptions
options' <- a -> IO (Ptr DiffFormatEmailOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Ptr DiffFormatEmailOptions -> Word64 -> IO ()
ggit_diff_format_email_options_set_total_patches Ptr DiffFormatEmailOptions
options' Word64
patches
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DiffFormatEmailOptionsSetTotalPatchesMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m, IsDiffFormatEmailOptions a) => O.OverloadedMethod DiffFormatEmailOptionsSetTotalPatchesMethodInfo a signature where
    overloadedMethod = diffFormatEmailOptionsSetTotalPatches

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


#endif