{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Represents options for finding diff similarity.

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

module GI.Ggit.Objects.DiffFindOptions
    ( 

-- * Exported types
    DiffFindOptions(..)                     ,
    IsDiffFindOptions                       ,
    toDiffFindOptions                       ,


 -- * 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
-- [getCopyThreshold]("GI.Ggit.Objects.DiffFindOptions#g:method:getCopyThreshold"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFlags]("GI.Ggit.Objects.DiffFindOptions#g:method:getFlags"), [getMetric]("GI.Ggit.Objects.DiffFindOptions#g:method:getMetric"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRenameFromRewriteThreshold]("GI.Ggit.Objects.DiffFindOptions#g:method:getRenameFromRewriteThreshold"), [getRenameLimit]("GI.Ggit.Objects.DiffFindOptions#g:method:getRenameLimit"), [getRenameThreshold]("GI.Ggit.Objects.DiffFindOptions#g:method:getRenameThreshold").
-- 
-- ==== Setters
-- [setCopyThreshold]("GI.Ggit.Objects.DiffFindOptions#g:method:setCopyThreshold"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setFlags]("GI.Ggit.Objects.DiffFindOptions#g:method:setFlags"), [setMetric]("GI.Ggit.Objects.DiffFindOptions#g:method:setMetric"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setRenameFromRewriteThreshold]("GI.Ggit.Objects.DiffFindOptions#g:method:setRenameFromRewriteThreshold"), [setRenameLimit]("GI.Ggit.Objects.DiffFindOptions#g:method:setRenameLimit"), [setRenameThreshold]("GI.Ggit.Objects.DiffFindOptions#g:method:setRenameThreshold").

#if defined(ENABLE_OVERLOADING)
    ResolveDiffFindOptionsMethod            ,
#endif

-- ** getCopyThreshold #method:getCopyThreshold#

#if defined(ENABLE_OVERLOADING)
    DiffFindOptionsGetCopyThresholdMethodInfo,
#endif
    diffFindOptionsGetCopyThreshold         ,


-- ** getFlags #method:getFlags#

#if defined(ENABLE_OVERLOADING)
    DiffFindOptionsGetFlagsMethodInfo       ,
#endif
    diffFindOptionsGetFlags                 ,


-- ** getMetric #method:getMetric#

#if defined(ENABLE_OVERLOADING)
    DiffFindOptionsGetMetricMethodInfo      ,
#endif
    diffFindOptionsGetMetric                ,


-- ** getRenameFromRewriteThreshold #method:getRenameFromRewriteThreshold#

#if defined(ENABLE_OVERLOADING)
    DiffFindOptionsGetRenameFromRewriteThresholdMethodInfo,
#endif
    diffFindOptionsGetRenameFromRewriteThreshold,


-- ** getRenameLimit #method:getRenameLimit#

#if defined(ENABLE_OVERLOADING)
    DiffFindOptionsGetRenameLimitMethodInfo ,
#endif
    diffFindOptionsGetRenameLimit           ,


-- ** getRenameThreshold #method:getRenameThreshold#

#if defined(ENABLE_OVERLOADING)
    DiffFindOptionsGetRenameThresholdMethodInfo,
#endif
    diffFindOptionsGetRenameThreshold       ,


-- ** new #method:new#

    diffFindOptionsNew                      ,


-- ** setCopyThreshold #method:setCopyThreshold#

#if defined(ENABLE_OVERLOADING)
    DiffFindOptionsSetCopyThresholdMethodInfo,
#endif
    diffFindOptionsSetCopyThreshold         ,


-- ** setFlags #method:setFlags#

#if defined(ENABLE_OVERLOADING)
    DiffFindOptionsSetFlagsMethodInfo       ,
#endif
    diffFindOptionsSetFlags                 ,


-- ** setMetric #method:setMetric#

#if defined(ENABLE_OVERLOADING)
    DiffFindOptionsSetMetricMethodInfo      ,
#endif
    diffFindOptionsSetMetric                ,


-- ** setRenameFromRewriteThreshold #method:setRenameFromRewriteThreshold#

#if defined(ENABLE_OVERLOADING)
    DiffFindOptionsSetRenameFromRewriteThresholdMethodInfo,
#endif
    diffFindOptionsSetRenameFromRewriteThreshold,


-- ** setRenameLimit #method:setRenameLimit#

#if defined(ENABLE_OVERLOADING)
    DiffFindOptionsSetRenameLimitMethodInfo ,
#endif
    diffFindOptionsSetRenameLimit           ,


-- ** setRenameThreshold #method:setRenameThreshold#

#if defined(ENABLE_OVERLOADING)
    DiffFindOptionsSetRenameThresholdMethodInfo,
#endif
    diffFindOptionsSetRenameThreshold       ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    DiffFindOptionsCopyThresholdPropertyInfo,
#endif
    constructDiffFindOptionsCopyThreshold   ,
#if defined(ENABLE_OVERLOADING)
    diffFindOptionsCopyThreshold            ,
#endif
    getDiffFindOptionsCopyThreshold         ,
    setDiffFindOptionsCopyThreshold         ,


-- ** flags #attr:flags#
-- | The diff option flags.

#if defined(ENABLE_OVERLOADING)
    DiffFindOptionsFlagsPropertyInfo        ,
#endif
    constructDiffFindOptionsFlags           ,
#if defined(ENABLE_OVERLOADING)
    diffFindOptionsFlags                    ,
#endif
    getDiffFindOptionsFlags                 ,
    setDiffFindOptionsFlags                 ,


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

#if defined(ENABLE_OVERLOADING)
    DiffFindOptionsMetricPropertyInfo       ,
#endif
    constructDiffFindOptionsMetric          ,
#if defined(ENABLE_OVERLOADING)
    diffFindOptionsMetric                   ,
#endif
    getDiffFindOptionsMetric                ,
    setDiffFindOptionsMetric                ,


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

#if defined(ENABLE_OVERLOADING)
    DiffFindOptionsRenameFromRewriteThresholdPropertyInfo,
#endif
    constructDiffFindOptionsRenameFromRewriteThreshold,
#if defined(ENABLE_OVERLOADING)
    diffFindOptionsRenameFromRewriteThreshold,
#endif
    getDiffFindOptionsRenameFromRewriteThreshold,
    setDiffFindOptionsRenameFromRewriteThreshold,


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

#if defined(ENABLE_OVERLOADING)
    DiffFindOptionsRenameLimitPropertyInfo  ,
#endif
    constructDiffFindOptionsRenameLimit     ,
#if defined(ENABLE_OVERLOADING)
    diffFindOptionsRenameLimit              ,
#endif
    getDiffFindOptionsRenameLimit           ,
    setDiffFindOptionsRenameLimit           ,


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

#if defined(ENABLE_OVERLOADING)
    DiffFindOptionsRenameThresholdPropertyInfo,
#endif
    constructDiffFindOptionsRenameThreshold ,
#if defined(ENABLE_OVERLOADING)
    diffFindOptionsRenameThreshold          ,
#endif
    getDiffFindOptionsRenameThreshold       ,
    setDiffFindOptionsRenameThreshold       ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Ggit.Flags as Ggit.Flags
import {-# SOURCE #-} qualified GI.Ggit.Structs.DiffSimilarityMetric as Ggit.DiffSimilarityMetric

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

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

foreign import ccall "ggit_diff_find_options_get_type"
    c_ggit_diff_find_options_get_type :: IO B.Types.GType

instance B.Types.TypedObject DiffFindOptions where
    glibType :: IO GType
glibType = IO GType
c_ggit_diff_find_options_get_type

instance B.Types.GObject DiffFindOptions

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveDiffFindOptionsMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveDiffFindOptionsMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDiffFindOptionsMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDiffFindOptionsMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDiffFindOptionsMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDiffFindOptionsMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDiffFindOptionsMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDiffFindOptionsMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDiffFindOptionsMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDiffFindOptionsMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDiffFindOptionsMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDiffFindOptionsMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDiffFindOptionsMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDiffFindOptionsMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDiffFindOptionsMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDiffFindOptionsMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDiffFindOptionsMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDiffFindOptionsMethod "getCopyThreshold" o = DiffFindOptionsGetCopyThresholdMethodInfo
    ResolveDiffFindOptionsMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDiffFindOptionsMethod "getFlags" o = DiffFindOptionsGetFlagsMethodInfo
    ResolveDiffFindOptionsMethod "getMetric" o = DiffFindOptionsGetMetricMethodInfo
    ResolveDiffFindOptionsMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDiffFindOptionsMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDiffFindOptionsMethod "getRenameFromRewriteThreshold" o = DiffFindOptionsGetRenameFromRewriteThresholdMethodInfo
    ResolveDiffFindOptionsMethod "getRenameLimit" o = DiffFindOptionsGetRenameLimitMethodInfo
    ResolveDiffFindOptionsMethod "getRenameThreshold" o = DiffFindOptionsGetRenameThresholdMethodInfo
    ResolveDiffFindOptionsMethod "setCopyThreshold" o = DiffFindOptionsSetCopyThresholdMethodInfo
    ResolveDiffFindOptionsMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDiffFindOptionsMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDiffFindOptionsMethod "setFlags" o = DiffFindOptionsSetFlagsMethodInfo
    ResolveDiffFindOptionsMethod "setMetric" o = DiffFindOptionsSetMetricMethodInfo
    ResolveDiffFindOptionsMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDiffFindOptionsMethod "setRenameFromRewriteThreshold" o = DiffFindOptionsSetRenameFromRewriteThresholdMethodInfo
    ResolveDiffFindOptionsMethod "setRenameLimit" o = DiffFindOptionsSetRenameLimitMethodInfo
    ResolveDiffFindOptionsMethod "setRenameThreshold" o = DiffFindOptionsSetRenameThresholdMethodInfo
    ResolveDiffFindOptionsMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "copy-threshold"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@copy-threshold@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' diffFindOptions [ #copyThreshold 'Data.GI.Base.Attributes.:=' value ]
-- @
setDiffFindOptionsCopyThreshold :: (MonadIO m, IsDiffFindOptions o) => o -> Word32 -> m ()
setDiffFindOptionsCopyThreshold :: forall (m :: * -> *) o.
(MonadIO m, IsDiffFindOptions o) =>
o -> Word32 -> m ()
setDiffFindOptionsCopyThreshold o
obj Word32
val = IO () -> m ()
forall a. IO a -> m a
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 -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"copy-threshold" Word32
val

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

#if defined(ENABLE_OVERLOADING)
data DiffFindOptionsCopyThresholdPropertyInfo
instance AttrInfo DiffFindOptionsCopyThresholdPropertyInfo where
    type AttrAllowedOps DiffFindOptionsCopyThresholdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DiffFindOptionsCopyThresholdPropertyInfo = IsDiffFindOptions
    type AttrSetTypeConstraint DiffFindOptionsCopyThresholdPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint DiffFindOptionsCopyThresholdPropertyInfo = (~) Word32
    type AttrTransferType DiffFindOptionsCopyThresholdPropertyInfo = Word32
    type AttrGetType DiffFindOptionsCopyThresholdPropertyInfo = Word32
    type AttrLabel DiffFindOptionsCopyThresholdPropertyInfo = "copy-threshold"
    type AttrOrigin DiffFindOptionsCopyThresholdPropertyInfo = DiffFindOptions
    attrGet = getDiffFindOptionsCopyThreshold
    attrSet = setDiffFindOptionsCopyThreshold
    attrTransfer _ v = do
        return v
    attrConstruct = constructDiffFindOptionsCopyThreshold
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Objects.DiffFindOptions.copyThreshold"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.14/docs/GI-Ggit-Objects-DiffFindOptions.html#g:attr:copyThreshold"
        })
#endif

-- VVV Prop "flags"
   -- Type: TInterface (Name {namespace = "Ggit", name = "DiffFindFlags"})
   -- 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' diffFindOptions #flags
-- @
getDiffFindOptionsFlags :: (MonadIO m, IsDiffFindOptions o) => o -> m [Ggit.Flags.DiffFindFlags]
getDiffFindOptionsFlags :: forall (m :: * -> *) o.
(MonadIO m, IsDiffFindOptions o) =>
o -> m [DiffFindFlags]
getDiffFindOptionsFlags o
obj = IO [DiffFindFlags] -> m [DiffFindFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO [DiffFindFlags] -> m [DiffFindFlags])
-> IO [DiffFindFlags] -> m [DiffFindFlags]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [DiffFindFlags]
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' diffFindOptions [ #flags 'Data.GI.Base.Attributes.:=' value ]
-- @
setDiffFindOptionsFlags :: (MonadIO m, IsDiffFindOptions o) => o -> [Ggit.Flags.DiffFindFlags] -> m ()
setDiffFindOptionsFlags :: forall (m :: * -> *) o.
(MonadIO m, IsDiffFindOptions o) =>
o -> [DiffFindFlags] -> m ()
setDiffFindOptionsFlags o
obj [DiffFindFlags]
val = IO () -> m ()
forall a. IO a -> m a
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 -> [DiffFindFlags] -> IO ()
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj String
"flags" [DiffFindFlags]
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`.
constructDiffFindOptionsFlags :: (IsDiffFindOptions o, MIO.MonadIO m) => [Ggit.Flags.DiffFindFlags] -> m (GValueConstruct o)
constructDiffFindOptionsFlags :: forall o (m :: * -> *).
(IsDiffFindOptions o, MonadIO m) =>
[DiffFindFlags] -> m (GValueConstruct o)
constructDiffFindOptionsFlags [DiffFindFlags]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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 -> [DiffFindFlags] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"flags" [DiffFindFlags]
val

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

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

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

-- | Set the value of the “@metric@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' diffFindOptions [ #metric 'Data.GI.Base.Attributes.:=' value ]
-- @
setDiffFindOptionsMetric :: (MonadIO m, IsDiffFindOptions o) => o -> Ggit.DiffSimilarityMetric.DiffSimilarityMetric -> m ()
setDiffFindOptionsMetric :: forall (m :: * -> *) o.
(MonadIO m, IsDiffFindOptions o) =>
o -> DiffSimilarityMetric -> m ()
setDiffFindOptionsMetric o
obj DiffSimilarityMetric
val = IO () -> m ()
forall a. IO a -> m a
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 DiffSimilarityMetric -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"metric" (DiffSimilarityMetric -> Maybe DiffSimilarityMetric
forall a. a -> Maybe a
Just DiffSimilarityMetric
val)

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

#if defined(ENABLE_OVERLOADING)
data DiffFindOptionsMetricPropertyInfo
instance AttrInfo DiffFindOptionsMetricPropertyInfo where
    type AttrAllowedOps DiffFindOptionsMetricPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DiffFindOptionsMetricPropertyInfo = IsDiffFindOptions
    type AttrSetTypeConstraint DiffFindOptionsMetricPropertyInfo = (~) Ggit.DiffSimilarityMetric.DiffSimilarityMetric
    type AttrTransferTypeConstraint DiffFindOptionsMetricPropertyInfo = (~) Ggit.DiffSimilarityMetric.DiffSimilarityMetric
    type AttrTransferType DiffFindOptionsMetricPropertyInfo = Ggit.DiffSimilarityMetric.DiffSimilarityMetric
    type AttrGetType DiffFindOptionsMetricPropertyInfo = (Maybe Ggit.DiffSimilarityMetric.DiffSimilarityMetric)
    type AttrLabel DiffFindOptionsMetricPropertyInfo = "metric"
    type AttrOrigin DiffFindOptionsMetricPropertyInfo = DiffFindOptions
    attrGet = getDiffFindOptionsMetric
    attrSet = setDiffFindOptionsMetric
    attrTransfer _ v = do
        return v
    attrConstruct = constructDiffFindOptionsMetric
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Objects.DiffFindOptions.metric"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.14/docs/GI-Ggit-Objects-DiffFindOptions.html#g:attr:metric"
        })
#endif

-- VVV Prop "rename-from-rewrite-threshold"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@rename-from-rewrite-threshold@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' diffFindOptions [ #renameFromRewriteThreshold 'Data.GI.Base.Attributes.:=' value ]
-- @
setDiffFindOptionsRenameFromRewriteThreshold :: (MonadIO m, IsDiffFindOptions o) => o -> Word32 -> m ()
setDiffFindOptionsRenameFromRewriteThreshold :: forall (m :: * -> *) o.
(MonadIO m, IsDiffFindOptions o) =>
o -> Word32 -> m ()
setDiffFindOptionsRenameFromRewriteThreshold o
obj Word32
val = IO () -> m ()
forall a. IO a -> m a
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 -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"rename-from-rewrite-threshold" Word32
val

-- | Construct a `GValueConstruct` with valid value for the “@rename-from-rewrite-threshold@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDiffFindOptionsRenameFromRewriteThreshold :: (IsDiffFindOptions o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructDiffFindOptionsRenameFromRewriteThreshold :: forall o (m :: * -> *).
(IsDiffFindOptions o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructDiffFindOptionsRenameFromRewriteThreshold Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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 -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"rename-from-rewrite-threshold" Word32
val

#if defined(ENABLE_OVERLOADING)
data DiffFindOptionsRenameFromRewriteThresholdPropertyInfo
instance AttrInfo DiffFindOptionsRenameFromRewriteThresholdPropertyInfo where
    type AttrAllowedOps DiffFindOptionsRenameFromRewriteThresholdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DiffFindOptionsRenameFromRewriteThresholdPropertyInfo = IsDiffFindOptions
    type AttrSetTypeConstraint DiffFindOptionsRenameFromRewriteThresholdPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint DiffFindOptionsRenameFromRewriteThresholdPropertyInfo = (~) Word32
    type AttrTransferType DiffFindOptionsRenameFromRewriteThresholdPropertyInfo = Word32
    type AttrGetType DiffFindOptionsRenameFromRewriteThresholdPropertyInfo = Word32
    type AttrLabel DiffFindOptionsRenameFromRewriteThresholdPropertyInfo = "rename-from-rewrite-threshold"
    type AttrOrigin DiffFindOptionsRenameFromRewriteThresholdPropertyInfo = DiffFindOptions
    attrGet = getDiffFindOptionsRenameFromRewriteThreshold
    attrSet = setDiffFindOptionsRenameFromRewriteThreshold
    attrTransfer _ v = do
        return v
    attrConstruct = constructDiffFindOptionsRenameFromRewriteThreshold
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Objects.DiffFindOptions.renameFromRewriteThreshold"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.14/docs/GI-Ggit-Objects-DiffFindOptions.html#g:attr:renameFromRewriteThreshold"
        })
#endif

-- VVV Prop "rename-limit"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

-- | Set the value of the “@rename-limit@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' diffFindOptions [ #renameLimit 'Data.GI.Base.Attributes.:=' value ]
-- @
setDiffFindOptionsRenameLimit :: (MonadIO m, IsDiffFindOptions o) => o -> Word32 -> m ()
setDiffFindOptionsRenameLimit :: forall (m :: * -> *) o.
(MonadIO m, IsDiffFindOptions o) =>
o -> Word32 -> m ()
setDiffFindOptionsRenameLimit o
obj Word32
val = IO () -> m ()
forall a. IO a -> m a
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 -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"rename-limit" Word32
val

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

#if defined(ENABLE_OVERLOADING)
data DiffFindOptionsRenameLimitPropertyInfo
instance AttrInfo DiffFindOptionsRenameLimitPropertyInfo where
    type AttrAllowedOps DiffFindOptionsRenameLimitPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DiffFindOptionsRenameLimitPropertyInfo = IsDiffFindOptions
    type AttrSetTypeConstraint DiffFindOptionsRenameLimitPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint DiffFindOptionsRenameLimitPropertyInfo = (~) Word32
    type AttrTransferType DiffFindOptionsRenameLimitPropertyInfo = Word32
    type AttrGetType DiffFindOptionsRenameLimitPropertyInfo = Word32
    type AttrLabel DiffFindOptionsRenameLimitPropertyInfo = "rename-limit"
    type AttrOrigin DiffFindOptionsRenameLimitPropertyInfo = DiffFindOptions
    attrGet = getDiffFindOptionsRenameLimit
    attrSet = setDiffFindOptionsRenameLimit
    attrTransfer _ v = do
        return v
    attrConstruct = constructDiffFindOptionsRenameLimit
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Objects.DiffFindOptions.renameLimit"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.14/docs/GI-Ggit-Objects-DiffFindOptions.html#g:attr:renameLimit"
        })
#endif

-- VVV Prop "rename-threshold"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@rename-threshold@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' diffFindOptions [ #renameThreshold 'Data.GI.Base.Attributes.:=' value ]
-- @
setDiffFindOptionsRenameThreshold :: (MonadIO m, IsDiffFindOptions o) => o -> Word32 -> m ()
setDiffFindOptionsRenameThreshold :: forall (m :: * -> *) o.
(MonadIO m, IsDiffFindOptions o) =>
o -> Word32 -> m ()
setDiffFindOptionsRenameThreshold o
obj Word32
val = IO () -> m ()
forall a. IO a -> m a
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 -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"rename-threshold" Word32
val

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

#if defined(ENABLE_OVERLOADING)
data DiffFindOptionsRenameThresholdPropertyInfo
instance AttrInfo DiffFindOptionsRenameThresholdPropertyInfo where
    type AttrAllowedOps DiffFindOptionsRenameThresholdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DiffFindOptionsRenameThresholdPropertyInfo = IsDiffFindOptions
    type AttrSetTypeConstraint DiffFindOptionsRenameThresholdPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint DiffFindOptionsRenameThresholdPropertyInfo = (~) Word32
    type AttrTransferType DiffFindOptionsRenameThresholdPropertyInfo = Word32
    type AttrGetType DiffFindOptionsRenameThresholdPropertyInfo = Word32
    type AttrLabel DiffFindOptionsRenameThresholdPropertyInfo = "rename-threshold"
    type AttrOrigin DiffFindOptionsRenameThresholdPropertyInfo = DiffFindOptions
    attrGet = getDiffFindOptionsRenameThreshold
    attrSet = setDiffFindOptionsRenameThreshold
    attrTransfer _ v = do
        return v
    attrConstruct = constructDiffFindOptionsRenameThreshold
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Objects.DiffFindOptions.renameThreshold"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.14/docs/GI-Ggit-Objects-DiffFindOptions.html#g:attr:renameThreshold"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DiffFindOptions
type instance O.AttributeList DiffFindOptions = DiffFindOptionsAttributeList
type DiffFindOptionsAttributeList = ('[ '("copyThreshold", DiffFindOptionsCopyThresholdPropertyInfo), '("flags", DiffFindOptionsFlagsPropertyInfo), '("metric", DiffFindOptionsMetricPropertyInfo), '("renameFromRewriteThreshold", DiffFindOptionsRenameFromRewriteThresholdPropertyInfo), '("renameLimit", DiffFindOptionsRenameLimitPropertyInfo), '("renameThreshold", DiffFindOptionsRenameThresholdPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
diffFindOptionsCopyThreshold :: AttrLabelProxy "copyThreshold"
diffFindOptionsCopyThreshold = AttrLabelProxy

diffFindOptionsFlags :: AttrLabelProxy "flags"
diffFindOptionsFlags = AttrLabelProxy

diffFindOptionsMetric :: AttrLabelProxy "metric"
diffFindOptionsMetric = AttrLabelProxy

diffFindOptionsRenameFromRewriteThreshold :: AttrLabelProxy "renameFromRewriteThreshold"
diffFindOptionsRenameFromRewriteThreshold = AttrLabelProxy

diffFindOptionsRenameLimit :: AttrLabelProxy "renameLimit"
diffFindOptionsRenameLimit = AttrLabelProxy

diffFindOptionsRenameThreshold :: AttrLabelProxy "renameThreshold"
diffFindOptionsRenameThreshold = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "ggit_diff_find_options_new" ggit_diff_find_options_new :: 
    IO (Ptr DiffFindOptions)

-- | Creates a new t'GI.Ggit.Objects.DiffFindOptions.DiffFindOptions'.
diffFindOptionsNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m (Maybe DiffFindOptions)
    -- ^ __Returns:__ a newly allocated t'GI.Ggit.Objects.DiffFindOptions.DiffFindOptions' or 'P.Nothing'.
diffFindOptionsNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m (Maybe DiffFindOptions)
diffFindOptionsNew  = IO (Maybe DiffFindOptions) -> m (Maybe DiffFindOptions)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DiffFindOptions) -> m (Maybe DiffFindOptions))
-> IO (Maybe DiffFindOptions) -> m (Maybe DiffFindOptions)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFindOptions
result <- IO (Ptr DiffFindOptions)
ggit_diff_find_options_new
    Maybe DiffFindOptions
maybeResult <- Ptr DiffFindOptions
-> (Ptr DiffFindOptions -> IO DiffFindOptions)
-> IO (Maybe DiffFindOptions)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr DiffFindOptions
result ((Ptr DiffFindOptions -> IO DiffFindOptions)
 -> IO (Maybe DiffFindOptions))
-> (Ptr DiffFindOptions -> IO DiffFindOptions)
-> IO (Maybe DiffFindOptions)
forall a b. (a -> b) -> a -> b
$ \Ptr DiffFindOptions
result' -> do
        DiffFindOptions
result'' <- ((ManagedPtr DiffFindOptions -> DiffFindOptions)
-> Ptr DiffFindOptions -> IO DiffFindOptions
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DiffFindOptions -> DiffFindOptions
DiffFindOptions) Ptr DiffFindOptions
result'
        DiffFindOptions -> IO DiffFindOptions
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DiffFindOptions
result''
    Maybe DiffFindOptions -> IO (Maybe DiffFindOptions)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DiffFindOptions
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "ggit_diff_find_options_get_copy_threshold" ggit_diff_find_options_get_copy_threshold :: 
    Ptr DiffFindOptions ->                  -- options : TInterface (Name {namespace = "Ggit", name = "DiffFindOptions"})
    IO Word32

-- | Get the find options copy threshold.
diffFindOptionsGetCopyThreshold ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFindOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFindOptions.DiffFindOptions'.
    -> m Word32
    -- ^ __Returns:__ the copy threshold.
diffFindOptionsGetCopyThreshold :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFindOptions a) =>
a -> m Word32
diffFindOptionsGetCopyThreshold a
options = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFindOptions
options' <- a -> IO (Ptr DiffFindOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Word32
result <- Ptr DiffFindOptions -> IO Word32
ggit_diff_find_options_get_copy_threshold Ptr DiffFindOptions
options'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data DiffFindOptionsGetCopyThresholdMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsDiffFindOptions a) => O.OverloadedMethod DiffFindOptionsGetCopyThresholdMethodInfo a signature where
    overloadedMethod = diffFindOptionsGetCopyThreshold

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


#endif

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

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

-- | Get the find options flags.
diffFindOptionsGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFindOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFindOptions.DiffFindOptions'.
    -> m [Ggit.Flags.DiffFindFlags]
    -- ^ __Returns:__ the find options flags.
diffFindOptionsGetFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFindOptions a) =>
a -> m [DiffFindFlags]
diffFindOptionsGetFlags a
options = IO [DiffFindFlags] -> m [DiffFindFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DiffFindFlags] -> m [DiffFindFlags])
-> IO [DiffFindFlags] -> m [DiffFindFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFindOptions
options' <- a -> IO (Ptr DiffFindOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    CUInt
result <- Ptr DiffFindOptions -> IO CUInt
ggit_diff_find_options_get_flags Ptr DiffFindOptions
options'
    let result' :: [DiffFindFlags]
result' = CUInt -> [DiffFindFlags]
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
    [DiffFindFlags] -> IO [DiffFindFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [DiffFindFlags]
result'

#if defined(ENABLE_OVERLOADING)
data DiffFindOptionsGetFlagsMethodInfo
instance (signature ~ (m [Ggit.Flags.DiffFindFlags]), MonadIO m, IsDiffFindOptions a) => O.OverloadedMethod DiffFindOptionsGetFlagsMethodInfo a signature where
    overloadedMethod = diffFindOptionsGetFlags

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


#endif

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

foreign import ccall "ggit_diff_find_options_get_metric" ggit_diff_find_options_get_metric :: 
    Ptr DiffFindOptions ->                  -- options : TInterface (Name {namespace = "Ggit", name = "DiffFindOptions"})
    IO (Ptr Ggit.DiffSimilarityMetric.DiffSimilarityMetric)

-- | Get the find options metric.
diffFindOptionsGetMetric ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFindOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFindOptions.DiffFindOptions'.
    -> m (Maybe Ggit.DiffSimilarityMetric.DiffSimilarityMetric)
    -- ^ __Returns:__ a t'GI.Ggit.Structs.DiffSimilarityMetric.DiffSimilarityMetric' or 'P.Nothing'.
diffFindOptionsGetMetric :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFindOptions a) =>
a -> m (Maybe DiffSimilarityMetric)
diffFindOptionsGetMetric a
options = IO (Maybe DiffSimilarityMetric) -> m (Maybe DiffSimilarityMetric)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DiffSimilarityMetric) -> m (Maybe DiffSimilarityMetric))
-> IO (Maybe DiffSimilarityMetric)
-> m (Maybe DiffSimilarityMetric)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFindOptions
options' <- a -> IO (Ptr DiffFindOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Ptr DiffSimilarityMetric
result <- Ptr DiffFindOptions -> IO (Ptr DiffSimilarityMetric)
ggit_diff_find_options_get_metric Ptr DiffFindOptions
options'
    Maybe DiffSimilarityMetric
maybeResult <- Ptr DiffSimilarityMetric
-> (Ptr DiffSimilarityMetric -> IO DiffSimilarityMetric)
-> IO (Maybe DiffSimilarityMetric)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr DiffSimilarityMetric
result ((Ptr DiffSimilarityMetric -> IO DiffSimilarityMetric)
 -> IO (Maybe DiffSimilarityMetric))
-> (Ptr DiffSimilarityMetric -> IO DiffSimilarityMetric)
-> IO (Maybe DiffSimilarityMetric)
forall a b. (a -> b) -> a -> b
$ \Ptr DiffSimilarityMetric
result' -> do
        DiffSimilarityMetric
result'' <- ((ManagedPtr DiffSimilarityMetric -> DiffSimilarityMetric)
-> Ptr DiffSimilarityMetric -> IO DiffSimilarityMetric
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr DiffSimilarityMetric -> DiffSimilarityMetric
Ggit.DiffSimilarityMetric.DiffSimilarityMetric) Ptr DiffSimilarityMetric
result'
        DiffSimilarityMetric -> IO DiffSimilarityMetric
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DiffSimilarityMetric
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    Maybe DiffSimilarityMetric -> IO (Maybe DiffSimilarityMetric)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DiffSimilarityMetric
maybeResult

#if defined(ENABLE_OVERLOADING)
data DiffFindOptionsGetMetricMethodInfo
instance (signature ~ (m (Maybe Ggit.DiffSimilarityMetric.DiffSimilarityMetric)), MonadIO m, IsDiffFindOptions a) => O.OverloadedMethod DiffFindOptionsGetMetricMethodInfo a signature where
    overloadedMethod = diffFindOptionsGetMetric

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


#endif

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

foreign import ccall "ggit_diff_find_options_get_rename_from_rewrite_threshold" ggit_diff_find_options_get_rename_from_rewrite_threshold :: 
    Ptr DiffFindOptions ->                  -- options : TInterface (Name {namespace = "Ggit", name = "DiffFindOptions"})
    IO Word32

-- | Get the find options rename from rewrite threshold.
diffFindOptionsGetRenameFromRewriteThreshold ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFindOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFindOptions.DiffFindOptions'.
    -> m Word32
    -- ^ __Returns:__ the rename from rewrite threshold.
diffFindOptionsGetRenameFromRewriteThreshold :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFindOptions a) =>
a -> m Word32
diffFindOptionsGetRenameFromRewriteThreshold a
options = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFindOptions
options' <- a -> IO (Ptr DiffFindOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Word32
result <- Ptr DiffFindOptions -> IO Word32
ggit_diff_find_options_get_rename_from_rewrite_threshold Ptr DiffFindOptions
options'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data DiffFindOptionsGetRenameFromRewriteThresholdMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsDiffFindOptions a) => O.OverloadedMethod DiffFindOptionsGetRenameFromRewriteThresholdMethodInfo a signature where
    overloadedMethod = diffFindOptionsGetRenameFromRewriteThreshold

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


#endif

-- method DiffFindOptions::get_rename_limit
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffFindOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFindOptions."
--                 , 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_find_options_get_rename_limit" ggit_diff_find_options_get_rename_limit :: 
    Ptr DiffFindOptions ->                  -- options : TInterface (Name {namespace = "Ggit", name = "DiffFindOptions"})
    IO Word64

-- | Get the find options rename limit.
diffFindOptionsGetRenameLimit ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFindOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFindOptions.DiffFindOptions'.
    -> m Word64
    -- ^ __Returns:__ the rename limit.
diffFindOptionsGetRenameLimit :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFindOptions a) =>
a -> m Word64
diffFindOptionsGetRenameLimit a
options = IO Word64 -> m Word64
forall a. IO a -> m a
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 DiffFindOptions
options' <- a -> IO (Ptr DiffFindOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Word64
result <- Ptr DiffFindOptions -> IO Word64
ggit_diff_find_options_get_rename_limit Ptr DiffFindOptions
options'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data DiffFindOptionsGetRenameLimitMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsDiffFindOptions a) => O.OverloadedMethod DiffFindOptionsGetRenameLimitMethodInfo a signature where
    overloadedMethod = diffFindOptionsGetRenameLimit

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


#endif

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

foreign import ccall "ggit_diff_find_options_get_rename_threshold" ggit_diff_find_options_get_rename_threshold :: 
    Ptr DiffFindOptions ->                  -- options : TInterface (Name {namespace = "Ggit", name = "DiffFindOptions"})
    IO Word32

-- | Get the find options rename threshold.
diffFindOptionsGetRenameThreshold ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFindOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFindOptions.DiffFindOptions'.
    -> m Word32
    -- ^ __Returns:__ the rename threshold.
diffFindOptionsGetRenameThreshold :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFindOptions a) =>
a -> m Word32
diffFindOptionsGetRenameThreshold a
options = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFindOptions
options' <- a -> IO (Ptr DiffFindOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Word32
result <- Ptr DiffFindOptions -> IO Word32
ggit_diff_find_options_get_rename_threshold Ptr DiffFindOptions
options'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data DiffFindOptionsGetRenameThresholdMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsDiffFindOptions a) => O.OverloadedMethod DiffFindOptionsGetRenameThresholdMethodInfo a signature where
    overloadedMethod = diffFindOptionsGetRenameThreshold

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


#endif

-- method DiffFindOptions::set_copy_threshold
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffFindOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFindOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "threshold"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the threshold." , 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_find_options_set_copy_threshold" ggit_diff_find_options_set_copy_threshold :: 
    Ptr DiffFindOptions ->                  -- options : TInterface (Name {namespace = "Ggit", name = "DiffFindOptions"})
    Word32 ->                               -- threshold : TBasicType TUInt
    IO ()

-- | Set the find options copy threshold.
diffFindOptionsSetCopyThreshold ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFindOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFindOptions.DiffFindOptions'.
    -> Word32
    -- ^ /@threshold@/: the threshold.
    -> m ()
diffFindOptionsSetCopyThreshold :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFindOptions a) =>
a -> Word32 -> m ()
diffFindOptionsSetCopyThreshold a
options Word32
threshold = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFindOptions
options' <- a -> IO (Ptr DiffFindOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Ptr DiffFindOptions -> Word32 -> IO ()
ggit_diff_find_options_set_copy_threshold Ptr DiffFindOptions
options' Word32
threshold
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DiffFindOptionsSetCopyThresholdMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsDiffFindOptions a) => O.OverloadedMethod DiffFindOptionsSetCopyThresholdMethodInfo a signature where
    overloadedMethod = diffFindOptionsSetCopyThreshold

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


#endif

-- method DiffFindOptions::set_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffFindOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFindOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffFindFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFindFlags."
--                 , 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_find_options_set_flags" ggit_diff_find_options_set_flags :: 
    Ptr DiffFindOptions ->                  -- options : TInterface (Name {namespace = "Ggit", name = "DiffFindOptions"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Ggit", name = "DiffFindFlags"})
    IO ()

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

#if defined(ENABLE_OVERLOADING)
data DiffFindOptionsSetFlagsMethodInfo
instance (signature ~ ([Ggit.Flags.DiffFindFlags] -> m ()), MonadIO m, IsDiffFindOptions a) => O.OverloadedMethod DiffFindOptionsSetFlagsMethodInfo a signature where
    overloadedMethod = diffFindOptionsSetFlags

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


#endif

-- method DiffFindOptions::set_metric
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffFindOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFindOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "metric"
--           , argType =
--               TInterface
--                 Name { namespace = "Ggit" , name = "DiffSimilarityMetric" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffSimilarityMetric."
--                 , 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_find_options_set_metric" ggit_diff_find_options_set_metric :: 
    Ptr DiffFindOptions ->                  -- options : TInterface (Name {namespace = "Ggit", name = "DiffFindOptions"})
    Ptr Ggit.DiffSimilarityMetric.DiffSimilarityMetric -> -- metric : TInterface (Name {namespace = "Ggit", name = "DiffSimilarityMetric"})
    IO ()

-- | Set the find options metric.
diffFindOptionsSetMetric ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFindOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFindOptions.DiffFindOptions'.
    -> Ggit.DiffSimilarityMetric.DiffSimilarityMetric
    -- ^ /@metric@/: a t'GI.Ggit.Structs.DiffSimilarityMetric.DiffSimilarityMetric'.
    -> m ()
diffFindOptionsSetMetric :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFindOptions a) =>
a -> DiffSimilarityMetric -> m ()
diffFindOptionsSetMetric a
options DiffSimilarityMetric
metric = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFindOptions
options' <- a -> IO (Ptr DiffFindOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Ptr DiffSimilarityMetric
metric' <- DiffSimilarityMetric -> IO (Ptr DiffSimilarityMetric)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffSimilarityMetric
metric
    Ptr DiffFindOptions -> Ptr DiffSimilarityMetric -> IO ()
ggit_diff_find_options_set_metric Ptr DiffFindOptions
options' Ptr DiffSimilarityMetric
metric'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    DiffSimilarityMetric -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffSimilarityMetric
metric
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DiffFindOptionsSetMetricMethodInfo
instance (signature ~ (Ggit.DiffSimilarityMetric.DiffSimilarityMetric -> m ()), MonadIO m, IsDiffFindOptions a) => O.OverloadedMethod DiffFindOptionsSetMetricMethodInfo a signature where
    overloadedMethod = diffFindOptionsSetMetric

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


#endif

-- method DiffFindOptions::set_rename_from_rewrite_threshold
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffFindOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFindOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "threshold"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the threshold." , 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_find_options_set_rename_from_rewrite_threshold" ggit_diff_find_options_set_rename_from_rewrite_threshold :: 
    Ptr DiffFindOptions ->                  -- options : TInterface (Name {namespace = "Ggit", name = "DiffFindOptions"})
    Word32 ->                               -- threshold : TBasicType TUInt
    IO ()

-- | Set the find options rename from rewrite threshold.
diffFindOptionsSetRenameFromRewriteThreshold ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFindOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFindOptions.DiffFindOptions'.
    -> Word32
    -- ^ /@threshold@/: the threshold.
    -> m ()
diffFindOptionsSetRenameFromRewriteThreshold :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFindOptions a) =>
a -> Word32 -> m ()
diffFindOptionsSetRenameFromRewriteThreshold a
options Word32
threshold = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFindOptions
options' <- a -> IO (Ptr DiffFindOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Ptr DiffFindOptions -> Word32 -> IO ()
ggit_diff_find_options_set_rename_from_rewrite_threshold Ptr DiffFindOptions
options' Word32
threshold
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DiffFindOptionsSetRenameFromRewriteThresholdMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsDiffFindOptions a) => O.OverloadedMethod DiffFindOptionsSetRenameFromRewriteThresholdMethodInfo a signature where
    overloadedMethod = diffFindOptionsSetRenameFromRewriteThreshold

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


#endif

-- method DiffFindOptions::set_rename_limit
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffFindOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFindOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "limit"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the limit." , 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_find_options_set_rename_limit" ggit_diff_find_options_set_rename_limit :: 
    Ptr DiffFindOptions ->                  -- options : TInterface (Name {namespace = "Ggit", name = "DiffFindOptions"})
    Word64 ->                               -- limit : TBasicType TUInt64
    IO ()

-- | Set the find options rename limit.
diffFindOptionsSetRenameLimit ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFindOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFindOptions.DiffFindOptions'.
    -> Word64
    -- ^ /@limit@/: the limit.
    -> m ()
diffFindOptionsSetRenameLimit :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFindOptions a) =>
a -> Word64 -> m ()
diffFindOptionsSetRenameLimit a
options Word64
limit = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFindOptions
options' <- a -> IO (Ptr DiffFindOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Ptr DiffFindOptions -> Word64 -> IO ()
ggit_diff_find_options_set_rename_limit Ptr DiffFindOptions
options' Word64
limit
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DiffFindOptionsSetRenameLimitMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m, IsDiffFindOptions a) => O.OverloadedMethod DiffFindOptionsSetRenameLimitMethodInfo a signature where
    overloadedMethod = diffFindOptionsSetRenameLimit

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


#endif

-- method DiffFindOptions::set_rename_threshold
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffFindOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffFindOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "threshold"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the threshold." , 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_find_options_set_rename_threshold" ggit_diff_find_options_set_rename_threshold :: 
    Ptr DiffFindOptions ->                  -- options : TInterface (Name {namespace = "Ggit", name = "DiffFindOptions"})
    Word32 ->                               -- threshold : TBasicType TUInt
    IO ()

-- | Set the find options rename threshold.
diffFindOptionsSetRenameThreshold ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffFindOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffFindOptions.DiffFindOptions'.
    -> Word32
    -- ^ /@threshold@/: the threshold.
    -> m ()
diffFindOptionsSetRenameThreshold :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiffFindOptions a) =>
a -> Word32 -> m ()
diffFindOptionsSetRenameThreshold a
options Word32
threshold = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffFindOptions
options' <- a -> IO (Ptr DiffFindOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Ptr DiffFindOptions -> Word32 -> IO ()
ggit_diff_find_options_set_rename_threshold Ptr DiffFindOptions
options' Word32
threshold
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DiffFindOptionsSetRenameThresholdMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsDiffFindOptions a) => O.OverloadedMethod DiffFindOptionsSetRenameThresholdMethodInfo a signature where
    overloadedMethod = diffFindOptionsSetRenameThreshold

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


#endif