{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Bonding Settings

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

module GI.NM.Objects.SettingBond
    ( 

-- * Exported types
    SettingBond(..)                         ,
    IsSettingBond                           ,
    toSettingBond                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addOption]("GI.NM.Objects.SettingBond#g:method:addOption"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [compare]("GI.NM.Objects.Setting#g:method:compare"), [diff]("GI.NM.Objects.Setting#g:method:diff"), [duplicate]("GI.NM.Objects.Setting#g:method:duplicate"), [enumerateValues]("GI.NM.Objects.Setting#g:method:enumerateValues"), [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"), [optionClearByName]("GI.NM.Objects.Setting#g:method:optionClearByName"), [optionGet]("GI.NM.Objects.Setting#g:method:optionGet"), [optionGetAllNames]("GI.NM.Objects.Setting#g:method:optionGetAllNames"), [optionGetBoolean]("GI.NM.Objects.Setting#g:method:optionGetBoolean"), [optionGetUint32]("GI.NM.Objects.Setting#g:method:optionGetUint32"), [optionSet]("GI.NM.Objects.Setting#g:method:optionSet"), [optionSetBoolean]("GI.NM.Objects.Setting#g:method:optionSetBoolean"), [optionSetUint32]("GI.NM.Objects.Setting#g:method:optionSetUint32"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeOption]("GI.NM.Objects.SettingBond#g:method:removeOption"), [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"), [toString]("GI.NM.Objects.Setting#g:method:toString"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [verify]("GI.NM.Objects.Setting#g:method:verify"), [verifySecrets]("GI.NM.Objects.Setting#g:method:verifySecrets"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDbusPropertyType]("GI.NM.Objects.Setting#g:method:getDbusPropertyType"), [getName]("GI.NM.Objects.Setting#g:method:getName"), [getNumOptions]("GI.NM.Objects.SettingBond#g:method:getNumOptions"), [getOption]("GI.NM.Objects.SettingBond#g:method:getOption"), [getOptionByName]("GI.NM.Objects.SettingBond#g:method:getOptionByName"), [getOptionDefault]("GI.NM.Objects.SettingBond#g:method:getOptionDefault"), [getOptionNormalized]("GI.NM.Objects.SettingBond#g:method:getOptionNormalized"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSecretFlags]("GI.NM.Objects.Setting#g:method:getSecretFlags"), [getValidOptions]("GI.NM.Objects.SettingBond#g:method:getValidOptions").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSecretFlags]("GI.NM.Objects.Setting#g:method:setSecretFlags").

#if defined(ENABLE_OVERLOADING)
    ResolveSettingBondMethod                ,
#endif

-- ** addOption #method:addOption#

#if defined(ENABLE_OVERLOADING)
    SettingBondAddOptionMethodInfo          ,
#endif
    settingBondAddOption                    ,


-- ** getNumOptions #method:getNumOptions#

#if defined(ENABLE_OVERLOADING)
    SettingBondGetNumOptionsMethodInfo      ,
#endif
    settingBondGetNumOptions                ,


-- ** getOption #method:getOption#

#if defined(ENABLE_OVERLOADING)
    SettingBondGetOptionMethodInfo          ,
#endif
    settingBondGetOption                    ,


-- ** getOptionByName #method:getOptionByName#

#if defined(ENABLE_OVERLOADING)
    SettingBondGetOptionByNameMethodInfo    ,
#endif
    settingBondGetOptionByName              ,


-- ** getOptionDefault #method:getOptionDefault#

#if defined(ENABLE_OVERLOADING)
    SettingBondGetOptionDefaultMethodInfo   ,
#endif
    settingBondGetOptionDefault             ,


-- ** getOptionNormalized #method:getOptionNormalized#

#if defined(ENABLE_OVERLOADING)
    SettingBondGetOptionNormalizedMethodInfo,
#endif
    settingBondGetOptionNormalized          ,


-- ** getValidOptions #method:getValidOptions#

#if defined(ENABLE_OVERLOADING)
    SettingBondGetValidOptionsMethodInfo    ,
#endif
    settingBondGetValidOptions              ,


-- ** new #method:new#

    settingBondNew                          ,


-- ** removeOption #method:removeOption#

#if defined(ENABLE_OVERLOADING)
    SettingBondRemoveOptionMethodInfo       ,
#endif
    settingBondRemoveOption                 ,


-- ** validateOption #method:validateOption#

    settingBondValidateOption               ,




 -- * Properties


-- ** options #attr:options#
-- | Dictionary of key\/value pairs of bonding options.  Both keys and values
-- must be strings. Option names must contain only alphanumeric characters
-- (ie, [a-zA-Z0-9]).

#if defined(ENABLE_OVERLOADING)
    SettingBondOptionsPropertyInfo          ,
#endif
    clearSettingBondOptions                 ,
    constructSettingBondOptions             ,
    getSettingBondOptions                   ,
    setSettingBondOptions                   ,
#if defined(ENABLE_OVERLOADING)
    settingBondOptions                      ,
#endif




    ) where

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

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

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GLib.Structs.VariantType as GLib.VariantType
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.NM.Callbacks as NM.Callbacks
import {-# SOURCE #-} qualified GI.NM.Enums as NM.Enums
import {-# SOURCE #-} qualified GI.NM.Flags as NM.Flags
import {-# SOURCE #-} qualified GI.NM.Interfaces.Connection as NM.Connection
import {-# SOURCE #-} qualified GI.NM.Objects.Setting as NM.Setting
import {-# SOURCE #-} qualified GI.NM.Objects.Setting8021x as NM.Setting8021x
import {-# SOURCE #-} qualified GI.NM.Objects.SettingAdsl as NM.SettingAdsl
import {-# SOURCE #-} qualified GI.NM.Objects.SettingBluetooth as NM.SettingBluetooth
import {-# SOURCE #-} qualified GI.NM.Objects.SettingBridge as NM.SettingBridge
import {-# SOURCE #-} qualified GI.NM.Objects.SettingBridgePort as NM.SettingBridgePort
import {-# SOURCE #-} qualified GI.NM.Objects.SettingCdma as NM.SettingCdma
import {-# SOURCE #-} qualified GI.NM.Objects.SettingConnection as NM.SettingConnection
import {-# SOURCE #-} qualified GI.NM.Objects.SettingDcb as NM.SettingDcb
import {-# SOURCE #-} qualified GI.NM.Objects.SettingDummy as NM.SettingDummy
import {-# SOURCE #-} qualified GI.NM.Objects.SettingGeneric as NM.SettingGeneric
import {-# SOURCE #-} qualified GI.NM.Objects.SettingGsm as NM.SettingGsm
import {-# SOURCE #-} qualified GI.NM.Objects.SettingIP4Config as NM.SettingIP4Config
import {-# SOURCE #-} qualified GI.NM.Objects.SettingIP6Config as NM.SettingIP6Config
import {-# SOURCE #-} qualified GI.NM.Objects.SettingIPConfig as NM.SettingIPConfig
import {-# SOURCE #-} qualified GI.NM.Objects.SettingIPTunnel as NM.SettingIPTunnel
import {-# SOURCE #-} qualified GI.NM.Objects.SettingInfiniband as NM.SettingInfiniband
import {-# SOURCE #-} qualified GI.NM.Objects.SettingMacsec as NM.SettingMacsec
import {-# SOURCE #-} qualified GI.NM.Objects.SettingMacvlan as NM.SettingMacvlan
import {-# SOURCE #-} qualified GI.NM.Objects.SettingOlpcMesh as NM.SettingOlpcMesh
import {-# SOURCE #-} qualified GI.NM.Objects.SettingOvsBridge as NM.SettingOvsBridge
import {-# SOURCE #-} qualified GI.NM.Objects.SettingOvsInterface as NM.SettingOvsInterface
import {-# SOURCE #-} qualified GI.NM.Objects.SettingOvsPatch as NM.SettingOvsPatch
import {-# SOURCE #-} qualified GI.NM.Objects.SettingOvsPort as NM.SettingOvsPort
import {-# SOURCE #-} qualified GI.NM.Objects.SettingPpp as NM.SettingPpp
import {-# SOURCE #-} qualified GI.NM.Objects.SettingPppoe as NM.SettingPppoe
import {-# SOURCE #-} qualified GI.NM.Objects.SettingProxy as NM.SettingProxy
import {-# SOURCE #-} qualified GI.NM.Objects.SettingSerial as NM.SettingSerial
import {-# SOURCE #-} qualified GI.NM.Objects.SettingTCConfig as NM.SettingTCConfig
import {-# SOURCE #-} qualified GI.NM.Objects.SettingTeam as NM.SettingTeam
import {-# SOURCE #-} qualified GI.NM.Objects.SettingTeamPort as NM.SettingTeamPort
import {-# SOURCE #-} qualified GI.NM.Objects.SettingTun as NM.SettingTun
import {-# SOURCE #-} qualified GI.NM.Objects.SettingVlan as NM.SettingVlan
import {-# SOURCE #-} qualified GI.NM.Objects.SettingVpn as NM.SettingVpn
import {-# SOURCE #-} qualified GI.NM.Objects.SettingVxlan as NM.SettingVxlan
import {-# SOURCE #-} qualified GI.NM.Objects.SettingWimax as NM.SettingWimax
import {-# SOURCE #-} qualified GI.NM.Objects.SettingWired as NM.SettingWired
import {-# SOURCE #-} qualified GI.NM.Objects.SettingWireless as NM.SettingWireless
import {-# SOURCE #-} qualified GI.NM.Objects.SettingWirelessSecurity as NM.SettingWirelessSecurity
import {-# SOURCE #-} qualified GI.NM.Structs.BridgeVlan as NM.BridgeVlan
import {-# SOURCE #-} qualified GI.NM.Structs.IPAddress as NM.IPAddress
import {-# SOURCE #-} qualified GI.NM.Structs.IPRoute as NM.IPRoute
import {-# SOURCE #-} qualified GI.NM.Structs.IPRoutingRule as NM.IPRoutingRule
import {-# SOURCE #-} qualified GI.NM.Structs.Range as NM.Range
import {-# SOURCE #-} qualified GI.NM.Structs.TCAction as NM.TCAction
import {-# SOURCE #-} qualified GI.NM.Structs.TCQdisc as NM.TCQdisc
import {-# SOURCE #-} qualified GI.NM.Structs.TCTfilter as NM.TCTfilter
import {-# SOURCE #-} qualified GI.NM.Structs.TeamLinkWatcher as NM.TeamLinkWatcher
import {-# SOURCE #-} qualified GI.NM.Structs.VariantAttributeSpec as NM.VariantAttributeSpec

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.NM.Objects.Setting as NM.Setting

#endif

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

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

foreign import ccall "nm_setting_bond_get_type"
    c_nm_setting_bond_get_type :: IO B.Types.GType

instance B.Types.TypedObject SettingBond where
    glibType :: IO GType
glibType = IO GType
c_nm_setting_bond_get_type

instance B.Types.GObject SettingBond

-- | Type class for types which can be safely cast to t'SettingBond', for instance with `toSettingBond`.
class (SP.GObject o, O.IsDescendantOf SettingBond o) => IsSettingBond o
instance (SP.GObject o, O.IsDescendantOf SettingBond o) => IsSettingBond o

instance O.HasParentTypes SettingBond
type instance O.ParentTypes SettingBond = '[NM.Setting.Setting, GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveSettingBondMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveSettingBondMethod "addOption" o = SettingBondAddOptionMethodInfo
    ResolveSettingBondMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSettingBondMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSettingBondMethod "compare" o = NM.Setting.SettingCompareMethodInfo
    ResolveSettingBondMethod "diff" o = NM.Setting.SettingDiffMethodInfo
    ResolveSettingBondMethod "duplicate" o = NM.Setting.SettingDuplicateMethodInfo
    ResolveSettingBondMethod "enumerateValues" o = NM.Setting.SettingEnumerateValuesMethodInfo
    ResolveSettingBondMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSettingBondMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSettingBondMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSettingBondMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSettingBondMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSettingBondMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSettingBondMethod "optionClearByName" o = NM.Setting.SettingOptionClearByNameMethodInfo
    ResolveSettingBondMethod "optionGet" o = NM.Setting.SettingOptionGetMethodInfo
    ResolveSettingBondMethod "optionGetAllNames" o = NM.Setting.SettingOptionGetAllNamesMethodInfo
    ResolveSettingBondMethod "optionGetBoolean" o = NM.Setting.SettingOptionGetBooleanMethodInfo
    ResolveSettingBondMethod "optionGetUint32" o = NM.Setting.SettingOptionGetUint32MethodInfo
    ResolveSettingBondMethod "optionSet" o = NM.Setting.SettingOptionSetMethodInfo
    ResolveSettingBondMethod "optionSetBoolean" o = NM.Setting.SettingOptionSetBooleanMethodInfo
    ResolveSettingBondMethod "optionSetUint32" o = NM.Setting.SettingOptionSetUint32MethodInfo
    ResolveSettingBondMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSettingBondMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSettingBondMethod "removeOption" o = SettingBondRemoveOptionMethodInfo
    ResolveSettingBondMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSettingBondMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSettingBondMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSettingBondMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSettingBondMethod "toString" o = NM.Setting.SettingToStringMethodInfo
    ResolveSettingBondMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSettingBondMethod "verify" o = NM.Setting.SettingVerifyMethodInfo
    ResolveSettingBondMethod "verifySecrets" o = NM.Setting.SettingVerifySecretsMethodInfo
    ResolveSettingBondMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSettingBondMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSettingBondMethod "getDbusPropertyType" o = NM.Setting.SettingGetDbusPropertyTypeMethodInfo
    ResolveSettingBondMethod "getName" o = NM.Setting.SettingGetNameMethodInfo
    ResolveSettingBondMethod "getNumOptions" o = SettingBondGetNumOptionsMethodInfo
    ResolveSettingBondMethod "getOption" o = SettingBondGetOptionMethodInfo
    ResolveSettingBondMethod "getOptionByName" o = SettingBondGetOptionByNameMethodInfo
    ResolveSettingBondMethod "getOptionDefault" o = SettingBondGetOptionDefaultMethodInfo
    ResolveSettingBondMethod "getOptionNormalized" o = SettingBondGetOptionNormalizedMethodInfo
    ResolveSettingBondMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSettingBondMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSettingBondMethod "getSecretFlags" o = NM.Setting.SettingGetSecretFlagsMethodInfo
    ResolveSettingBondMethod "getValidOptions" o = SettingBondGetValidOptionsMethodInfo
    ResolveSettingBondMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSettingBondMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSettingBondMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSettingBondMethod "setSecretFlags" o = NM.Setting.SettingSetSecretFlagsMethodInfo
    ResolveSettingBondMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

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

-- | Set the value of the “@options@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' settingBond [ #options 'Data.GI.Base.Attributes.:=' value ]
-- @
setSettingBondOptions :: (MonadIO m, IsSettingBond o) => o -> Map.Map T.Text T.Text -> m ()
setSettingBondOptions :: forall (m :: * -> *) o.
(MonadIO m, IsSettingBond o) =>
o -> Map Text Text -> m ()
setSettingBondOptions o
obj Map Text Text
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 (Map Text Text) -> IO ()
forall a b. GObject a => a -> String -> b -> IO ()
B.Properties.setObjectPropertyHash o
obj String
"options" (Map Text Text -> Maybe (Map Text Text)
forall a. a -> Maybe a
Just Map Text Text
val)

-- | Construct a t'GValueConstruct' with valid value for the “@options@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSettingBondOptions :: (IsSettingBond o, MIO.MonadIO m) => Map.Map T.Text T.Text -> m (GValueConstruct o)
constructSettingBondOptions :: forall o (m :: * -> *).
(IsSettingBond o, MonadIO m) =>
Map Text Text -> m (GValueConstruct o)
constructSettingBondOptions Map Text Text
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 (Map Text Text) -> IO (GValueConstruct o)
forall b o. String -> b -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyHash String
"options" (Map Text Text -> Maybe (Map Text Text)
forall a. a -> Maybe a
P.Just Map Text Text
val)

-- | Set the value of the “@options@” 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' #options
-- @
clearSettingBondOptions :: (MonadIO m, IsSettingBond o) => o -> m ()
clearSettingBondOptions :: forall (m :: * -> *) o. (MonadIO m, IsSettingBond o) => o -> m ()
clearSettingBondOptions o
obj = 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
$ o -> String -> Maybe (Map Text Text) -> IO ()
forall a b. GObject a => a -> String -> b -> IO ()
B.Properties.setObjectPropertyHash o
obj String
"options" (Maybe (Map Text Text)
forall a. Maybe a
Nothing :: Maybe (Map.Map T.Text T.Text))

#if defined(ENABLE_OVERLOADING)
data SettingBondOptionsPropertyInfo
instance AttrInfo SettingBondOptionsPropertyInfo where
    type AttrAllowedOps SettingBondOptionsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SettingBondOptionsPropertyInfo = IsSettingBond
    type AttrSetTypeConstraint SettingBondOptionsPropertyInfo = (~) (Map.Map T.Text T.Text)
    type AttrTransferTypeConstraint SettingBondOptionsPropertyInfo = (~) (Map.Map T.Text T.Text)
    type AttrTransferType SettingBondOptionsPropertyInfo = Map.Map T.Text T.Text
    type AttrGetType SettingBondOptionsPropertyInfo = (Maybe (Map.Map T.Text T.Text))
    type AttrLabel SettingBondOptionsPropertyInfo = "options"
    type AttrOrigin SettingBondOptionsPropertyInfo = SettingBond
    attrGet = getSettingBondOptions
    attrSet = setSettingBondOptions
    attrTransfer _ v = do
        return v
    attrConstruct = constructSettingBondOptions
    attrClear = clearSettingBondOptions
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.SettingBond.options"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingBond.html#g:attr:options"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SettingBond
type instance O.AttributeList SettingBond = SettingBondAttributeList
type SettingBondAttributeList = ('[ '("name", NM.Setting.SettingNamePropertyInfo), '("options", SettingBondOptionsPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
settingBondOptions :: AttrLabelProxy "options"
settingBondOptions = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "nm_setting_bond_new" nm_setting_bond_new :: 
    IO (Ptr SettingBond)

-- | Creates a new t'GI.NM.Objects.SettingBond.SettingBond' object with default values.
settingBondNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m SettingBond
    -- ^ __Returns:__ the new empty t'GI.NM.Objects.SettingBond.SettingBond' object
settingBondNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m SettingBond
settingBondNew  = IO SettingBond -> m SettingBond
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SettingBond -> m SettingBond)
-> IO SettingBond -> m SettingBond
forall a b. (a -> b) -> a -> b
$ do
    Ptr SettingBond
result <- IO (Ptr SettingBond)
nm_setting_bond_new
    Text -> Ptr SettingBond -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"settingBondNew" Ptr SettingBond
result
    SettingBond
result' <- ((ManagedPtr SettingBond -> SettingBond)
-> Ptr SettingBond -> IO SettingBond
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SettingBond -> SettingBond
SettingBond) Ptr SettingBond
result
    SettingBond -> IO SettingBond
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SettingBond
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method SettingBond::add_option
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "setting"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SettingBond" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSettingBond" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name for the option"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "value for the option"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_setting_bond_add_option" nm_setting_bond_add_option :: 
    Ptr SettingBond ->                      -- setting : TInterface (Name {namespace = "NM", name = "SettingBond"})
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- value : TBasicType TUTF8
    IO CInt

-- | Add an option to the table. Adding a new name replaces any existing name\/value pair
-- that may already exist.
settingBondAddOption ::
    (B.CallStack.HasCallStack, MonadIO m, IsSettingBond a) =>
    a
    -- ^ /@setting@/: the t'GI.NM.Objects.SettingBond.SettingBond'
    -> T.Text
    -- ^ /@name@/: name for the option
    -> T.Text
    -- ^ /@value@/: value for the option
    -> m Bool
    -- ^ __Returns:__ returns 'P.False' if either /@name@/ or /@value@/ is 'P.Nothing', in that case
    -- the option is not set. Otherwise, the function does not fail and does not validate
    -- the arguments. All validation happens via 'GI.NM.Interfaces.Connection.connectionVerify' or do basic validation
    -- yourself with 'GI.NM.Objects.SettingBond.settingBondValidateOption'.
    -- 
    -- Note: Before 1.30, libnm would perform basic validation of the name and the value
    -- via 'GI.NM.Objects.SettingBond.settingBondValidateOption' and reject the request by returning FALSE.
    -- Since 1.30, libnm no longer rejects any values as the setter is not supposed
    -- to perform validation.
settingBondAddOption :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingBond a) =>
a -> Text -> Text -> m Bool
settingBondAddOption a
setting Text
name Text
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr SettingBond
setting' <- a -> IO (Ptr SettingBond)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
value' <- Text -> IO CString
textToCString Text
value
    CInt
result <- Ptr SettingBond -> CString -> CString -> IO CInt
nm_setting_bond_add_option Ptr SettingBond
setting' CString
name' CString
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SettingBondAddOptionMethodInfo
instance (signature ~ (T.Text -> T.Text -> m Bool), MonadIO m, IsSettingBond a) => O.OverloadedMethod SettingBondAddOptionMethodInfo a signature where
    overloadedMethod = settingBondAddOption

instance O.OverloadedMethodInfo SettingBondAddOptionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.SettingBond.settingBondAddOption",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingBond.html#v:settingBondAddOption"
        })


#endif

-- method SettingBond::get_num_options
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "setting"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SettingBond" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSettingBond" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt32)
-- throws : False
-- Skip return : False

foreign import ccall "nm_setting_bond_get_num_options" nm_setting_bond_get_num_options :: 
    Ptr SettingBond ->                      -- setting : TInterface (Name {namespace = "NM", name = "SettingBond"})
    IO Word32

-- | Returns the number of options that should be set for this bond when it
-- is activated. This can be used to retrieve each option individually
-- using 'GI.NM.Objects.SettingBond.settingBondGetOption'.
settingBondGetNumOptions ::
    (B.CallStack.HasCallStack, MonadIO m, IsSettingBond a) =>
    a
    -- ^ /@setting@/: the t'GI.NM.Objects.SettingBond.SettingBond'
    -> m Word32
    -- ^ __Returns:__ the number of bonding options
settingBondGetNumOptions :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingBond a) =>
a -> m Word32
settingBondGetNumOptions a
setting = 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 SettingBond
setting' <- a -> IO (Ptr SettingBond)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
    Word32
result <- Ptr SettingBond -> IO Word32
nm_setting_bond_get_num_options Ptr SettingBond
setting'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data SettingBondGetNumOptionsMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsSettingBond a) => O.OverloadedMethod SettingBondGetNumOptionsMethodInfo a signature where
    overloadedMethod = settingBondGetNumOptions

instance O.OverloadedMethodInfo SettingBondGetNumOptionsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.SettingBond.settingBondGetNumOptions",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingBond.html#v:settingBondGetNumOptions"
        })


#endif

-- method SettingBond::get_option
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "setting"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SettingBond" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSettingBond" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "idx"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "index of the desired option, from 0 to\nnm_setting_bond_get_num_options() - 1"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "on return, the name of the bonding option;\n  this value is owned by the setting and should not be modified"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "on return, the value of the name of the\n  bonding option; this value is owned by the setting and should not be\n  modified"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_setting_bond_get_option" nm_setting_bond_get_option :: 
    Ptr SettingBond ->                      -- setting : TInterface (Name {namespace = "NM", name = "SettingBond"})
    Word32 ->                               -- idx : TBasicType TUInt32
    Ptr CString ->                          -- out_name : TBasicType TUTF8
    Ptr CString ->                          -- out_value : TBasicType TUTF8
    IO CInt

-- | Given an index, return the value of the bonding option at that index.  Indexes
-- are *not* guaranteed to be static across modifications to options done by
-- 'GI.NM.Objects.SettingBond.settingBondAddOption' and 'GI.NM.Objects.SettingBond.settingBondRemoveOption',
-- and should not be used to refer to options except for short periods of time
-- such as during option iteration.
settingBondGetOption ::
    (B.CallStack.HasCallStack, MonadIO m, IsSettingBond a) =>
    a
    -- ^ /@setting@/: the t'GI.NM.Objects.SettingBond.SettingBond'
    -> Word32
    -- ^ /@idx@/: index of the desired option, from 0 to
    -- 'GI.NM.Objects.SettingBond.settingBondGetNumOptions' - 1
    -> m ((Bool, T.Text, T.Text))
    -- ^ __Returns:__ 'P.True' on success if the index was valid and an option was found,
    -- 'P.False' if the index was invalid (ie, greater than the number of options
    -- currently held by the setting)
settingBondGetOption :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingBond a) =>
a -> Word32 -> m (Bool, Text, Text)
settingBondGetOption a
setting Word32
idx = IO (Bool, Text, Text) -> m (Bool, Text, Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Text, Text) -> m (Bool, Text, Text))
-> IO (Bool, Text, Text) -> m (Bool, Text, Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr SettingBond
setting' <- a -> IO (Ptr SettingBond)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
    Ptr CString
outName <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Ptr CString
outValue <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    CInt
result <- Ptr SettingBond -> Word32 -> Ptr CString -> Ptr CString -> IO CInt
nm_setting_bond_get_option Ptr SettingBond
setting' Word32
idx Ptr CString
outName Ptr CString
outValue
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CString
outName' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
outName
    Text
outName'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
outName'
    CString
outValue' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
outValue
    Text
outValue'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
outValue'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outName
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outValue
    (Bool, Text, Text) -> IO (Bool, Text, Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Text
outName'', Text
outValue'')

#if defined(ENABLE_OVERLOADING)
data SettingBondGetOptionMethodInfo
instance (signature ~ (Word32 -> m ((Bool, T.Text, T.Text))), MonadIO m, IsSettingBond a) => O.OverloadedMethod SettingBondGetOptionMethodInfo a signature where
    overloadedMethod = settingBondGetOption

instance O.OverloadedMethodInfo SettingBondGetOptionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.SettingBond.settingBondGetOption",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingBond.html#v:settingBondGetOption"
        })


#endif

-- method SettingBond::get_option_by_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "setting"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SettingBond" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSettingBond" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the option name for which to retrieve the value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "nm_setting_bond_get_option_by_name" nm_setting_bond_get_option_by_name :: 
    Ptr SettingBond ->                      -- setting : TInterface (Name {namespace = "NM", name = "SettingBond"})
    CString ->                              -- name : TBasicType TUTF8
    IO CString

-- | Returns the value associated with the bonding option specified by
-- /@name@/, if it exists.
settingBondGetOptionByName ::
    (B.CallStack.HasCallStack, MonadIO m, IsSettingBond a) =>
    a
    -- ^ /@setting@/: the t'GI.NM.Objects.SettingBond.SettingBond'
    -> T.Text
    -- ^ /@name@/: the option name for which to retrieve the value
    -> m T.Text
    -- ^ __Returns:__ the value, or 'P.Nothing' if the key\/value pair was never added to the
    -- setting; the value is owned by the setting and must not be modified
settingBondGetOptionByName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingBond a) =>
a -> Text -> m Text
settingBondGetOptionByName a
setting Text
name = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr SettingBond
setting' <- a -> IO (Ptr SettingBond)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
result <- Ptr SettingBond -> CString -> IO CString
nm_setting_bond_get_option_by_name Ptr SettingBond
setting' CString
name'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"settingBondGetOptionByName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data SettingBondGetOptionByNameMethodInfo
instance (signature ~ (T.Text -> m T.Text), MonadIO m, IsSettingBond a) => O.OverloadedMethod SettingBondGetOptionByNameMethodInfo a signature where
    overloadedMethod = settingBondGetOptionByName

instance O.OverloadedMethodInfo SettingBondGetOptionByNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.SettingBond.settingBondGetOptionByName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingBond.html#v:settingBondGetOptionByName"
        })


#endif

-- method SettingBond::get_option_default
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "setting"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SettingBond" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSettingBond" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the option"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "nm_setting_bond_get_option_default" nm_setting_bond_get_option_default :: 
    Ptr SettingBond ->                      -- setting : TInterface (Name {namespace = "NM", name = "SettingBond"})
    CString ->                              -- name : TBasicType TUTF8
    IO CString

-- | /No description available in the introspection data./
settingBondGetOptionDefault ::
    (B.CallStack.HasCallStack, MonadIO m, IsSettingBond a) =>
    a
    -- ^ /@setting@/: the t'GI.NM.Objects.SettingBond.SettingBond'
    -> T.Text
    -- ^ /@name@/: the name of the option
    -> m T.Text
    -- ^ __Returns:__ the value of the bond option if not overridden by an entry in
    --   the [SettingBond:options]("GI.NM.Objects.SettingBond#g:attr:options") property.
settingBondGetOptionDefault :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingBond a) =>
a -> Text -> m Text
settingBondGetOptionDefault a
setting Text
name = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr SettingBond
setting' <- a -> IO (Ptr SettingBond)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
result <- Ptr SettingBond -> CString -> IO CString
nm_setting_bond_get_option_default Ptr SettingBond
setting' CString
name'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"settingBondGetOptionDefault" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data SettingBondGetOptionDefaultMethodInfo
instance (signature ~ (T.Text -> m T.Text), MonadIO m, IsSettingBond a) => O.OverloadedMethod SettingBondGetOptionDefaultMethodInfo a signature where
    overloadedMethod = settingBondGetOptionDefault

instance O.OverloadedMethodInfo SettingBondGetOptionDefaultMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.SettingBond.settingBondGetOptionDefault",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingBond.html#v:settingBondGetOptionDefault"
        })


#endif

-- method SettingBond::get_option_normalized
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "setting"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SettingBond" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSettingBond" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the option"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "nm_setting_bond_get_option_normalized" nm_setting_bond_get_option_normalized :: 
    Ptr SettingBond ->                      -- setting : TInterface (Name {namespace = "NM", name = "SettingBond"})
    CString ->                              -- name : TBasicType TUTF8
    IO CString

-- | /No description available in the introspection data./
-- 
-- /Since: 1.24/
settingBondGetOptionNormalized ::
    (B.CallStack.HasCallStack, MonadIO m, IsSettingBond a) =>
    a
    -- ^ /@setting@/: the t'GI.NM.Objects.SettingBond.SettingBond'
    -> T.Text
    -- ^ /@name@/: the name of the option
    -> m T.Text
    -- ^ __Returns:__ the value of the bond option after normalization, which is what NetworkManager
    --   will actually apply when activating the connection. 'P.Nothing' if the option won\'t be applied
    --   to the connection.
settingBondGetOptionNormalized :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingBond a) =>
a -> Text -> m Text
settingBondGetOptionNormalized a
setting Text
name = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr SettingBond
setting' <- a -> IO (Ptr SettingBond)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
result <- Ptr SettingBond -> CString -> IO CString
nm_setting_bond_get_option_normalized Ptr SettingBond
setting' CString
name'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"settingBondGetOptionNormalized" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data SettingBondGetOptionNormalizedMethodInfo
instance (signature ~ (T.Text -> m T.Text), MonadIO m, IsSettingBond a) => O.OverloadedMethod SettingBondGetOptionNormalizedMethodInfo a signature where
    overloadedMethod = settingBondGetOptionNormalized

instance O.OverloadedMethodInfo SettingBondGetOptionNormalizedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.SettingBond.settingBondGetOptionNormalized",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingBond.html#v:settingBondGetOptionNormalized"
        })


#endif

-- method SettingBond::get_valid_options
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "setting"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SettingBond" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSettingBond" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "nm_setting_bond_get_valid_options" nm_setting_bond_get_valid_options :: 
    Ptr SettingBond ->                      -- setting : TInterface (Name {namespace = "NM", name = "SettingBond"})
    IO (Ptr CString)

-- | Returns a list of valid bond options.
-- 
-- The /@setting@/ argument is unused and may be passed as 'P.Nothing'.
settingBondGetValidOptions ::
    (B.CallStack.HasCallStack, MonadIO m, IsSettingBond a) =>
    Maybe (a)
    -- ^ /@setting@/: the t'GI.NM.Objects.SettingBond.SettingBond'
    -> m (Maybe [T.Text])
    -- ^ __Returns:__ a 'P.Nothing'-terminated array of strings of valid bond options.
settingBondGetValidOptions :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingBond a) =>
Maybe a -> m (Maybe [Text])
settingBondGetValidOptions Maybe a
setting = IO (Maybe [Text]) -> m (Maybe [Text])
forall a. IO a -> m a
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 SettingBond
maybeSetting <- case Maybe a
setting of
        Maybe a
Nothing -> Ptr SettingBond -> IO (Ptr SettingBond)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SettingBond
forall a. Ptr a
FP.nullPtr
        Just a
jSetting -> do
            Ptr SettingBond
jSetting' <- a -> IO (Ptr SettingBond)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSetting
            Ptr SettingBond -> IO (Ptr SettingBond)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SettingBond
jSetting'
    Ptr CString
result <- Ptr SettingBond -> IO (Ptr CString)
nm_setting_bond_get_valid_options Ptr SettingBond
maybeSetting
    Maybe [Text]
maybeResult <- Ptr CString -> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CString
result ((Ptr CString -> IO [Text]) -> IO (Maybe [Text]))
-> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ \Ptr CString
result' -> do
        [Text]
result'' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result'
        [Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result''
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
setting a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe [Text] -> IO (Maybe [Text])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Text]
maybeResult

#if defined(ENABLE_OVERLOADING)
data SettingBondGetValidOptionsMethodInfo
instance (signature ~ (m (Maybe [T.Text])), MonadIO m, IsSettingBond a) => O.OverloadedMethod SettingBondGetValidOptionsMethodInfo a signature where
    overloadedMethod i = settingBondGetValidOptions (Just i)

instance O.OverloadedMethodInfo SettingBondGetValidOptionsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.SettingBond.settingBondGetValidOptions",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingBond.html#v:settingBondGetValidOptions"
        })


#endif

-- method SettingBond::remove_option
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "setting"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SettingBond" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSettingBond" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of the option to remove"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_setting_bond_remove_option" nm_setting_bond_remove_option :: 
    Ptr SettingBond ->                      -- setting : TInterface (Name {namespace = "NM", name = "SettingBond"})
    CString ->                              -- name : TBasicType TUTF8
    IO CInt

-- | Remove the bonding option referenced by /@name@/ from the internal option
-- list.
settingBondRemoveOption ::
    (B.CallStack.HasCallStack, MonadIO m, IsSettingBond a) =>
    a
    -- ^ /@setting@/: the t'GI.NM.Objects.SettingBond.SettingBond'
    -> T.Text
    -- ^ /@name@/: name of the option to remove
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the option was found and removed from the internal option
    -- list, 'P.False' if it was not.
settingBondRemoveOption :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingBond a) =>
a -> Text -> m Bool
settingBondRemoveOption a
setting Text
name = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr SettingBond
setting' <- a -> IO (Ptr SettingBond)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
    CString
name' <- Text -> IO CString
textToCString Text
name
    CInt
result <- Ptr SettingBond -> CString -> IO CInt
nm_setting_bond_remove_option Ptr SettingBond
setting' CString
name'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SettingBondRemoveOptionMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsSettingBond a) => O.OverloadedMethod SettingBondRemoveOptionMethodInfo a signature where
    overloadedMethod = settingBondRemoveOption

instance O.OverloadedMethodInfo SettingBondRemoveOptionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.SettingBond.settingBondRemoveOption",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingBond.html#v:settingBondRemoveOption"
        })


#endif

-- method SettingBond::validate_option
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the option to validate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value of the option to validate."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_setting_bond_validate_option" nm_setting_bond_validate_option :: 
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- value : TBasicType TUTF8
    IO CInt

-- | Checks whether /@name@/ is a valid bond option and /@value@/ is a valid value for
-- the /@name@/. If /@value@/ is 'P.Nothing', the function only validates the option name.
settingBondValidateOption ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@name@/: the name of the option to validate
    -> Maybe (T.Text)
    -- ^ /@value@/: the value of the option to validate.
    -> m Bool
    -- ^ __Returns:__ 'P.True', if the /@value@/ is valid for the given name.
    -- If the /@name@/ is not a valid option, 'P.False' will be returned.
settingBondValidateOption :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Maybe Text -> m Bool
settingBondValidateOption Text
name Maybe Text
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
maybeValue <- case Maybe Text
value of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
FP.nullPtr
        Just Text
jValue -> do
            CString
jValue' <- Text -> IO CString
textToCString Text
jValue
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jValue'
    CInt
result <- CString -> CString -> IO CInt
nm_setting_bond_validate_option CString
name' CString
maybeValue
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeValue
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif