{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.NM.Objects.SettingAdsl
(
SettingAdsl(..) ,
IsSettingAdsl ,
toSettingAdsl ,
#if defined(ENABLE_OVERLOADING)
ResolveSettingAdslMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingAdslGetEncapsulationMethodInfo ,
#endif
settingAdslGetEncapsulation ,
#if defined(ENABLE_OVERLOADING)
SettingAdslGetPasswordMethodInfo ,
#endif
settingAdslGetPassword ,
#if defined(ENABLE_OVERLOADING)
SettingAdslGetPasswordFlagsMethodInfo ,
#endif
settingAdslGetPasswordFlags ,
#if defined(ENABLE_OVERLOADING)
SettingAdslGetProtocolMethodInfo ,
#endif
settingAdslGetProtocol ,
#if defined(ENABLE_OVERLOADING)
SettingAdslGetUsernameMethodInfo ,
#endif
settingAdslGetUsername ,
#if defined(ENABLE_OVERLOADING)
SettingAdslGetVciMethodInfo ,
#endif
settingAdslGetVci ,
#if defined(ENABLE_OVERLOADING)
SettingAdslGetVpiMethodInfo ,
#endif
settingAdslGetVpi ,
settingAdslNew ,
#if defined(ENABLE_OVERLOADING)
SettingAdslEncapsulationPropertyInfo ,
#endif
clearSettingAdslEncapsulation ,
constructSettingAdslEncapsulation ,
getSettingAdslEncapsulation ,
setSettingAdslEncapsulation ,
#if defined(ENABLE_OVERLOADING)
settingAdslEncapsulation ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingAdslPasswordPropertyInfo ,
#endif
clearSettingAdslPassword ,
constructSettingAdslPassword ,
getSettingAdslPassword ,
setSettingAdslPassword ,
#if defined(ENABLE_OVERLOADING)
settingAdslPassword ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingAdslPasswordFlagsPropertyInfo ,
#endif
constructSettingAdslPasswordFlags ,
getSettingAdslPasswordFlags ,
setSettingAdslPasswordFlags ,
#if defined(ENABLE_OVERLOADING)
settingAdslPasswordFlags ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingAdslProtocolPropertyInfo ,
#endif
clearSettingAdslProtocol ,
constructSettingAdslProtocol ,
getSettingAdslProtocol ,
setSettingAdslProtocol ,
#if defined(ENABLE_OVERLOADING)
settingAdslProtocol ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingAdslUsernamePropertyInfo ,
#endif
clearSettingAdslUsername ,
constructSettingAdslUsername ,
getSettingAdslUsername ,
setSettingAdslUsername ,
#if defined(ENABLE_OVERLOADING)
settingAdslUsername ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingAdslVciPropertyInfo ,
#endif
constructSettingAdslVci ,
getSettingAdslVci ,
setSettingAdslVci ,
#if defined(ENABLE_OVERLOADING)
settingAdslVci ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingAdslVpiPropertyInfo ,
#endif
constructSettingAdslVpi ,
getSettingAdslVpi ,
setSettingAdslVpi ,
#if defined(ENABLE_OVERLOADING)
settingAdslVpi ,
#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
#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.SettingBluetooth as NM.SettingBluetooth
import {-# SOURCE #-} qualified GI.NM.Objects.SettingBond as NM.SettingBond
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.Flags as NM.Flags
import {-# SOURCE #-} qualified GI.NM.Objects.Setting as NM.Setting
#endif
newtype SettingAdsl = SettingAdsl (SP.ManagedPtr SettingAdsl)
deriving (SettingAdsl -> SettingAdsl -> Bool
(SettingAdsl -> SettingAdsl -> Bool)
-> (SettingAdsl -> SettingAdsl -> Bool) -> Eq SettingAdsl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SettingAdsl -> SettingAdsl -> Bool
== :: SettingAdsl -> SettingAdsl -> Bool
$c/= :: SettingAdsl -> SettingAdsl -> Bool
/= :: SettingAdsl -> SettingAdsl -> Bool
Eq)
instance SP.ManagedPtrNewtype SettingAdsl where
toManagedPtr :: SettingAdsl -> ManagedPtr SettingAdsl
toManagedPtr (SettingAdsl ManagedPtr SettingAdsl
p) = ManagedPtr SettingAdsl
p
foreign import ccall "nm_setting_adsl_get_type"
c_nm_setting_adsl_get_type :: IO B.Types.GType
instance B.Types.TypedObject SettingAdsl where
glibType :: IO GType
glibType = IO GType
c_nm_setting_adsl_get_type
instance B.Types.GObject SettingAdsl
class (SP.GObject o, O.IsDescendantOf SettingAdsl o) => IsSettingAdsl o
instance (SP.GObject o, O.IsDescendantOf SettingAdsl o) => IsSettingAdsl o
instance O.HasParentTypes SettingAdsl
type instance O.ParentTypes SettingAdsl = '[NM.Setting.Setting, GObject.Object.Object]
toSettingAdsl :: (MIO.MonadIO m, IsSettingAdsl o) => o -> m SettingAdsl
toSettingAdsl :: forall (m :: * -> *) o.
(MonadIO m, IsSettingAdsl o) =>
o -> m SettingAdsl
toSettingAdsl = IO SettingAdsl -> m SettingAdsl
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO SettingAdsl -> m SettingAdsl)
-> (o -> IO SettingAdsl) -> o -> m SettingAdsl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr SettingAdsl -> SettingAdsl) -> o -> IO SettingAdsl
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr SettingAdsl -> SettingAdsl
SettingAdsl
instance B.GValue.IsGValue (Maybe SettingAdsl) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_nm_setting_adsl_get_type
gvalueSet_ :: Ptr GValue -> Maybe SettingAdsl -> IO ()
gvalueSet_ Ptr GValue
gv Maybe SettingAdsl
P.Nothing = Ptr GValue -> Ptr SettingAdsl -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr SettingAdsl
forall a. Ptr a
FP.nullPtr :: FP.Ptr SettingAdsl)
gvalueSet_ Ptr GValue
gv (P.Just SettingAdsl
obj) = SettingAdsl -> (Ptr SettingAdsl -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr SettingAdsl
obj (Ptr GValue -> Ptr SettingAdsl -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe SettingAdsl)
gvalueGet_ Ptr GValue
gv = do
Ptr SettingAdsl
ptr <- Ptr GValue -> IO (Ptr SettingAdsl)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr SettingAdsl)
if Ptr SettingAdsl
ptr Ptr SettingAdsl -> Ptr SettingAdsl -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr SettingAdsl
forall a. Ptr a
FP.nullPtr
then SettingAdsl -> Maybe SettingAdsl
forall a. a -> Maybe a
P.Just (SettingAdsl -> Maybe SettingAdsl)
-> IO SettingAdsl -> IO (Maybe SettingAdsl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr SettingAdsl -> SettingAdsl)
-> Ptr SettingAdsl -> IO SettingAdsl
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr SettingAdsl -> SettingAdsl
SettingAdsl Ptr SettingAdsl
ptr
else Maybe SettingAdsl -> IO (Maybe SettingAdsl)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SettingAdsl
forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveSettingAdslMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveSettingAdslMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveSettingAdslMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveSettingAdslMethod "compare" o = NM.Setting.SettingCompareMethodInfo
ResolveSettingAdslMethod "diff" o = NM.Setting.SettingDiffMethodInfo
ResolveSettingAdslMethod "duplicate" o = NM.Setting.SettingDuplicateMethodInfo
ResolveSettingAdslMethod "enumerateValues" o = NM.Setting.SettingEnumerateValuesMethodInfo
ResolveSettingAdslMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveSettingAdslMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveSettingAdslMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveSettingAdslMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveSettingAdslMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveSettingAdslMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveSettingAdslMethod "optionClearByName" o = NM.Setting.SettingOptionClearByNameMethodInfo
ResolveSettingAdslMethod "optionGet" o = NM.Setting.SettingOptionGetMethodInfo
ResolveSettingAdslMethod "optionGetAllNames" o = NM.Setting.SettingOptionGetAllNamesMethodInfo
ResolveSettingAdslMethod "optionGetBoolean" o = NM.Setting.SettingOptionGetBooleanMethodInfo
ResolveSettingAdslMethod "optionGetUint32" o = NM.Setting.SettingOptionGetUint32MethodInfo
ResolveSettingAdslMethod "optionSet" o = NM.Setting.SettingOptionSetMethodInfo
ResolveSettingAdslMethod "optionSetBoolean" o = NM.Setting.SettingOptionSetBooleanMethodInfo
ResolveSettingAdslMethod "optionSetUint32" o = NM.Setting.SettingOptionSetUint32MethodInfo
ResolveSettingAdslMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveSettingAdslMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveSettingAdslMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveSettingAdslMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveSettingAdslMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveSettingAdslMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveSettingAdslMethod "toString" o = NM.Setting.SettingToStringMethodInfo
ResolveSettingAdslMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveSettingAdslMethod "verify" o = NM.Setting.SettingVerifyMethodInfo
ResolveSettingAdslMethod "verifySecrets" o = NM.Setting.SettingVerifySecretsMethodInfo
ResolveSettingAdslMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveSettingAdslMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveSettingAdslMethod "getDbusPropertyType" o = NM.Setting.SettingGetDbusPropertyTypeMethodInfo
ResolveSettingAdslMethod "getEncapsulation" o = SettingAdslGetEncapsulationMethodInfo
ResolveSettingAdslMethod "getName" o = NM.Setting.SettingGetNameMethodInfo
ResolveSettingAdslMethod "getPassword" o = SettingAdslGetPasswordMethodInfo
ResolveSettingAdslMethod "getPasswordFlags" o = SettingAdslGetPasswordFlagsMethodInfo
ResolveSettingAdslMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveSettingAdslMethod "getProtocol" o = SettingAdslGetProtocolMethodInfo
ResolveSettingAdslMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveSettingAdslMethod "getSecretFlags" o = NM.Setting.SettingGetSecretFlagsMethodInfo
ResolveSettingAdslMethod "getUsername" o = SettingAdslGetUsernameMethodInfo
ResolveSettingAdslMethod "getVci" o = SettingAdslGetVciMethodInfo
ResolveSettingAdslMethod "getVpi" o = SettingAdslGetVpiMethodInfo
ResolveSettingAdslMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveSettingAdslMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveSettingAdslMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveSettingAdslMethod "setSecretFlags" o = NM.Setting.SettingSetSecretFlagsMethodInfo
ResolveSettingAdslMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveSettingAdslMethod t SettingAdsl, O.OverloadedMethod info SettingAdsl p) => OL.IsLabel t (SettingAdsl -> 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 ~ ResolveSettingAdslMethod t SettingAdsl, O.OverloadedMethod info SettingAdsl p, R.HasField t SettingAdsl p) => R.HasField t SettingAdsl p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveSettingAdslMethod t SettingAdsl, O.OverloadedMethodInfo info SettingAdsl) => OL.IsLabel t (O.MethodProxy info SettingAdsl) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
getSettingAdslEncapsulation :: (MonadIO m, IsSettingAdsl o) => o -> m T.Text
getSettingAdslEncapsulation :: forall (m :: * -> *) o. (MonadIO m, IsSettingAdsl o) => o -> m Text
getSettingAdslEncapsulation o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getSettingAdslEncapsulation" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"encapsulation"
setSettingAdslEncapsulation :: (MonadIO m, IsSettingAdsl o) => o -> T.Text -> m ()
setSettingAdslEncapsulation :: forall (m :: * -> *) o.
(MonadIO m, IsSettingAdsl o) =>
o -> Text -> m ()
setSettingAdslEncapsulation o
obj 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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"encapsulation" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructSettingAdslEncapsulation :: (IsSettingAdsl o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructSettingAdslEncapsulation :: forall o (m :: * -> *).
(IsSettingAdsl o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructSettingAdslEncapsulation 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 Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"encapsulation" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
clearSettingAdslEncapsulation :: (MonadIO m, IsSettingAdsl o) => o -> m ()
clearSettingAdslEncapsulation :: forall (m :: * -> *) o. (MonadIO m, IsSettingAdsl o) => o -> m ()
clearSettingAdslEncapsulation 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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"encapsulation" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)
#if defined(ENABLE_OVERLOADING)
data SettingAdslEncapsulationPropertyInfo
instance AttrInfo SettingAdslEncapsulationPropertyInfo where
type AttrAllowedOps SettingAdslEncapsulationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint SettingAdslEncapsulationPropertyInfo = IsSettingAdsl
type AttrSetTypeConstraint SettingAdslEncapsulationPropertyInfo = (~) T.Text
type AttrTransferTypeConstraint SettingAdslEncapsulationPropertyInfo = (~) T.Text
type AttrTransferType SettingAdslEncapsulationPropertyInfo = T.Text
type AttrGetType SettingAdslEncapsulationPropertyInfo = T.Text
type AttrLabel SettingAdslEncapsulationPropertyInfo = "encapsulation"
type AttrOrigin SettingAdslEncapsulationPropertyInfo = SettingAdsl
attrGet = getSettingAdslEncapsulation
attrSet = setSettingAdslEncapsulation
attrTransfer _ v = do
return v
attrConstruct = constructSettingAdslEncapsulation
attrClear = clearSettingAdslEncapsulation
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingAdsl.encapsulation"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingAdsl.html#g:attr:encapsulation"
})
#endif
getSettingAdslPassword :: (MonadIO m, IsSettingAdsl o) => o -> m T.Text
getSettingAdslPassword :: forall (m :: * -> *) o. (MonadIO m, IsSettingAdsl o) => o -> m Text
getSettingAdslPassword o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getSettingAdslPassword" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"password"
setSettingAdslPassword :: (MonadIO m, IsSettingAdsl o) => o -> T.Text -> m ()
setSettingAdslPassword :: forall (m :: * -> *) o.
(MonadIO m, IsSettingAdsl o) =>
o -> Text -> m ()
setSettingAdslPassword o
obj 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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"password" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructSettingAdslPassword :: (IsSettingAdsl o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructSettingAdslPassword :: forall o (m :: * -> *).
(IsSettingAdsl o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructSettingAdslPassword 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 Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"password" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
clearSettingAdslPassword :: (MonadIO m, IsSettingAdsl o) => o -> m ()
clearSettingAdslPassword :: forall (m :: * -> *) o. (MonadIO m, IsSettingAdsl o) => o -> m ()
clearSettingAdslPassword 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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"password" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)
#if defined(ENABLE_OVERLOADING)
data SettingAdslPasswordPropertyInfo
instance AttrInfo SettingAdslPasswordPropertyInfo where
type AttrAllowedOps SettingAdslPasswordPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint SettingAdslPasswordPropertyInfo = IsSettingAdsl
type AttrSetTypeConstraint SettingAdslPasswordPropertyInfo = (~) T.Text
type AttrTransferTypeConstraint SettingAdslPasswordPropertyInfo = (~) T.Text
type AttrTransferType SettingAdslPasswordPropertyInfo = T.Text
type AttrGetType SettingAdslPasswordPropertyInfo = T.Text
type AttrLabel SettingAdslPasswordPropertyInfo = "password"
type AttrOrigin SettingAdslPasswordPropertyInfo = SettingAdsl
attrGet = getSettingAdslPassword
attrSet = setSettingAdslPassword
attrTransfer _ v = do
return v
attrConstruct = constructSettingAdslPassword
attrClear = clearSettingAdslPassword
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingAdsl.password"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingAdsl.html#g:attr:password"
})
#endif
getSettingAdslPasswordFlags :: (MonadIO m, IsSettingAdsl o) => o -> m [NM.Flags.SettingSecretFlags]
getSettingAdslPasswordFlags :: forall (m :: * -> *) o.
(MonadIO m, IsSettingAdsl o) =>
o -> m [SettingSecretFlags]
getSettingAdslPasswordFlags o
obj = IO [SettingSecretFlags] -> m [SettingSecretFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO [SettingSecretFlags] -> m [SettingSecretFlags])
-> IO [SettingSecretFlags] -> m [SettingSecretFlags]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [SettingSecretFlags]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"password-flags"
setSettingAdslPasswordFlags :: (MonadIO m, IsSettingAdsl o) => o -> [NM.Flags.SettingSecretFlags] -> m ()
setSettingAdslPasswordFlags :: forall (m :: * -> *) o.
(MonadIO m, IsSettingAdsl o) =>
o -> [SettingSecretFlags] -> m ()
setSettingAdslPasswordFlags o
obj [SettingSecretFlags]
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 -> [SettingSecretFlags] -> IO ()
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj String
"password-flags" [SettingSecretFlags]
val
constructSettingAdslPasswordFlags :: (IsSettingAdsl o, MIO.MonadIO m) => [NM.Flags.SettingSecretFlags] -> m (GValueConstruct o)
constructSettingAdslPasswordFlags :: forall o (m :: * -> *).
(IsSettingAdsl o, MonadIO m) =>
[SettingSecretFlags] -> m (GValueConstruct o)
constructSettingAdslPasswordFlags [SettingSecretFlags]
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 -> [SettingSecretFlags] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"password-flags" [SettingSecretFlags]
val
#if defined(ENABLE_OVERLOADING)
data SettingAdslPasswordFlagsPropertyInfo
instance AttrInfo SettingAdslPasswordFlagsPropertyInfo where
type AttrAllowedOps SettingAdslPasswordFlagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint SettingAdslPasswordFlagsPropertyInfo = IsSettingAdsl
type AttrSetTypeConstraint SettingAdslPasswordFlagsPropertyInfo = (~) [NM.Flags.SettingSecretFlags]
type AttrTransferTypeConstraint SettingAdslPasswordFlagsPropertyInfo = (~) [NM.Flags.SettingSecretFlags]
type AttrTransferType SettingAdslPasswordFlagsPropertyInfo = [NM.Flags.SettingSecretFlags]
type AttrGetType SettingAdslPasswordFlagsPropertyInfo = [NM.Flags.SettingSecretFlags]
type AttrLabel SettingAdslPasswordFlagsPropertyInfo = "password-flags"
type AttrOrigin SettingAdslPasswordFlagsPropertyInfo = SettingAdsl
attrGet = getSettingAdslPasswordFlags
attrSet = setSettingAdslPasswordFlags
attrTransfer _ v = do
return v
attrConstruct = constructSettingAdslPasswordFlags
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingAdsl.passwordFlags"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingAdsl.html#g:attr:passwordFlags"
})
#endif
getSettingAdslProtocol :: (MonadIO m, IsSettingAdsl o) => o -> m T.Text
getSettingAdslProtocol :: forall (m :: * -> *) o. (MonadIO m, IsSettingAdsl o) => o -> m Text
getSettingAdslProtocol o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getSettingAdslProtocol" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"protocol"
setSettingAdslProtocol :: (MonadIO m, IsSettingAdsl o) => o -> T.Text -> m ()
setSettingAdslProtocol :: forall (m :: * -> *) o.
(MonadIO m, IsSettingAdsl o) =>
o -> Text -> m ()
setSettingAdslProtocol o
obj 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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"protocol" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructSettingAdslProtocol :: (IsSettingAdsl o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructSettingAdslProtocol :: forall o (m :: * -> *).
(IsSettingAdsl o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructSettingAdslProtocol 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 Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"protocol" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
clearSettingAdslProtocol :: (MonadIO m, IsSettingAdsl o) => o -> m ()
clearSettingAdslProtocol :: forall (m :: * -> *) o. (MonadIO m, IsSettingAdsl o) => o -> m ()
clearSettingAdslProtocol 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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"protocol" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)
#if defined(ENABLE_OVERLOADING)
data SettingAdslProtocolPropertyInfo
instance AttrInfo SettingAdslProtocolPropertyInfo where
type AttrAllowedOps SettingAdslProtocolPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint SettingAdslProtocolPropertyInfo = IsSettingAdsl
type AttrSetTypeConstraint SettingAdslProtocolPropertyInfo = (~) T.Text
type AttrTransferTypeConstraint SettingAdslProtocolPropertyInfo = (~) T.Text
type AttrTransferType SettingAdslProtocolPropertyInfo = T.Text
type AttrGetType SettingAdslProtocolPropertyInfo = T.Text
type AttrLabel SettingAdslProtocolPropertyInfo = "protocol"
type AttrOrigin SettingAdslProtocolPropertyInfo = SettingAdsl
attrGet = getSettingAdslProtocol
attrSet = setSettingAdslProtocol
attrTransfer _ v = do
return v
attrConstruct = constructSettingAdslProtocol
attrClear = clearSettingAdslProtocol
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingAdsl.protocol"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingAdsl.html#g:attr:protocol"
})
#endif
getSettingAdslUsername :: (MonadIO m, IsSettingAdsl o) => o -> m T.Text
getSettingAdslUsername :: forall (m :: * -> *) o. (MonadIO m, IsSettingAdsl o) => o -> m Text
getSettingAdslUsername o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getSettingAdslUsername" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"username"
setSettingAdslUsername :: (MonadIO m, IsSettingAdsl o) => o -> T.Text -> m ()
setSettingAdslUsername :: forall (m :: * -> *) o.
(MonadIO m, IsSettingAdsl o) =>
o -> Text -> m ()
setSettingAdslUsername o
obj 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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"username" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructSettingAdslUsername :: (IsSettingAdsl o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructSettingAdslUsername :: forall o (m :: * -> *).
(IsSettingAdsl o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructSettingAdslUsername 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 Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"username" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
clearSettingAdslUsername :: (MonadIO m, IsSettingAdsl o) => o -> m ()
clearSettingAdslUsername :: forall (m :: * -> *) o. (MonadIO m, IsSettingAdsl o) => o -> m ()
clearSettingAdslUsername 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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"username" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)
#if defined(ENABLE_OVERLOADING)
data SettingAdslUsernamePropertyInfo
instance AttrInfo SettingAdslUsernamePropertyInfo where
type AttrAllowedOps SettingAdslUsernamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint SettingAdslUsernamePropertyInfo = IsSettingAdsl
type AttrSetTypeConstraint SettingAdslUsernamePropertyInfo = (~) T.Text
type AttrTransferTypeConstraint SettingAdslUsernamePropertyInfo = (~) T.Text
type AttrTransferType SettingAdslUsernamePropertyInfo = T.Text
type AttrGetType SettingAdslUsernamePropertyInfo = T.Text
type AttrLabel SettingAdslUsernamePropertyInfo = "username"
type AttrOrigin SettingAdslUsernamePropertyInfo = SettingAdsl
attrGet = getSettingAdslUsername
attrSet = setSettingAdslUsername
attrTransfer _ v = do
return v
attrConstruct = constructSettingAdslUsername
attrClear = clearSettingAdslUsername
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingAdsl.username"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingAdsl.html#g:attr:username"
})
#endif
getSettingAdslVci :: (MonadIO m, IsSettingAdsl o) => o -> m Word32
getSettingAdslVci :: forall (m :: * -> *) o.
(MonadIO m, IsSettingAdsl o) =>
o -> m Word32
getSettingAdslVci 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
"vci"
setSettingAdslVci :: (MonadIO m, IsSettingAdsl o) => o -> Word32 -> m ()
setSettingAdslVci :: forall (m :: * -> *) o.
(MonadIO m, IsSettingAdsl o) =>
o -> Word32 -> m ()
setSettingAdslVci 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
"vci" Word32
val
constructSettingAdslVci :: (IsSettingAdsl o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructSettingAdslVci :: forall o (m :: * -> *).
(IsSettingAdsl o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructSettingAdslVci 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
"vci" Word32
val
#if defined(ENABLE_OVERLOADING)
data SettingAdslVciPropertyInfo
instance AttrInfo SettingAdslVciPropertyInfo where
type AttrAllowedOps SettingAdslVciPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint SettingAdslVciPropertyInfo = IsSettingAdsl
type AttrSetTypeConstraint SettingAdslVciPropertyInfo = (~) Word32
type AttrTransferTypeConstraint SettingAdslVciPropertyInfo = (~) Word32
type AttrTransferType SettingAdslVciPropertyInfo = Word32
type AttrGetType SettingAdslVciPropertyInfo = Word32
type AttrLabel SettingAdslVciPropertyInfo = "vci"
type AttrOrigin SettingAdslVciPropertyInfo = SettingAdsl
attrGet = getSettingAdslVci
attrSet = setSettingAdslVci
attrTransfer _ v = do
return v
attrConstruct = constructSettingAdslVci
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingAdsl.vci"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingAdsl.html#g:attr:vci"
})
#endif
getSettingAdslVpi :: (MonadIO m, IsSettingAdsl o) => o -> m Word32
getSettingAdslVpi :: forall (m :: * -> *) o.
(MonadIO m, IsSettingAdsl o) =>
o -> m Word32
getSettingAdslVpi 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
"vpi"
setSettingAdslVpi :: (MonadIO m, IsSettingAdsl o) => o -> Word32 -> m ()
setSettingAdslVpi :: forall (m :: * -> *) o.
(MonadIO m, IsSettingAdsl o) =>
o -> Word32 -> m ()
setSettingAdslVpi 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
"vpi" Word32
val
constructSettingAdslVpi :: (IsSettingAdsl o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructSettingAdslVpi :: forall o (m :: * -> *).
(IsSettingAdsl o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructSettingAdslVpi 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
"vpi" Word32
val
#if defined(ENABLE_OVERLOADING)
data SettingAdslVpiPropertyInfo
instance AttrInfo SettingAdslVpiPropertyInfo where
type AttrAllowedOps SettingAdslVpiPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint SettingAdslVpiPropertyInfo = IsSettingAdsl
type AttrSetTypeConstraint SettingAdslVpiPropertyInfo = (~) Word32
type AttrTransferTypeConstraint SettingAdslVpiPropertyInfo = (~) Word32
type AttrTransferType SettingAdslVpiPropertyInfo = Word32
type AttrGetType SettingAdslVpiPropertyInfo = Word32
type AttrLabel SettingAdslVpiPropertyInfo = "vpi"
type AttrOrigin SettingAdslVpiPropertyInfo = SettingAdsl
attrGet = getSettingAdslVpi
attrSet = setSettingAdslVpi
attrTransfer _ v = do
return v
attrConstruct = constructSettingAdslVpi
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingAdsl.vpi"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingAdsl.html#g:attr:vpi"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SettingAdsl
type instance O.AttributeList SettingAdsl = SettingAdslAttributeList
type SettingAdslAttributeList = ('[ '("encapsulation", SettingAdslEncapsulationPropertyInfo), '("name", NM.Setting.SettingNamePropertyInfo), '("password", SettingAdslPasswordPropertyInfo), '("passwordFlags", SettingAdslPasswordFlagsPropertyInfo), '("protocol", SettingAdslProtocolPropertyInfo), '("username", SettingAdslUsernamePropertyInfo), '("vci", SettingAdslVciPropertyInfo), '("vpi", SettingAdslVpiPropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
settingAdslEncapsulation :: AttrLabelProxy "encapsulation"
settingAdslEncapsulation = AttrLabelProxy
settingAdslPassword :: AttrLabelProxy "password"
settingAdslPassword = AttrLabelProxy
settingAdslPasswordFlags :: AttrLabelProxy "passwordFlags"
settingAdslPasswordFlags = AttrLabelProxy
settingAdslProtocol :: AttrLabelProxy "protocol"
settingAdslProtocol = AttrLabelProxy
settingAdslUsername :: AttrLabelProxy "username"
settingAdslUsername = AttrLabelProxy
settingAdslVci :: AttrLabelProxy "vci"
settingAdslVci = AttrLabelProxy
settingAdslVpi :: AttrLabelProxy "vpi"
settingAdslVpi = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList SettingAdsl = SettingAdslSignalList
type SettingAdslSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "nm_setting_adsl_new" nm_setting_adsl_new ::
IO (Ptr SettingAdsl)
settingAdslNew ::
(B.CallStack.HasCallStack, MonadIO m) =>
m SettingAdsl
settingAdslNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m SettingAdsl
settingAdslNew = IO SettingAdsl -> m SettingAdsl
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SettingAdsl -> m SettingAdsl)
-> IO SettingAdsl -> m SettingAdsl
forall a b. (a -> b) -> a -> b
$ do
Ptr SettingAdsl
result <- IO (Ptr SettingAdsl)
nm_setting_adsl_new
Text -> Ptr SettingAdsl -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"settingAdslNew" Ptr SettingAdsl
result
SettingAdsl
result' <- ((ManagedPtr SettingAdsl -> SettingAdsl)
-> Ptr SettingAdsl -> IO SettingAdsl
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SettingAdsl -> SettingAdsl
SettingAdsl) Ptr SettingAdsl
result
SettingAdsl -> IO SettingAdsl
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SettingAdsl
result'
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "nm_setting_adsl_get_encapsulation" nm_setting_adsl_get_encapsulation ::
Ptr SettingAdsl ->
IO CString
settingAdslGetEncapsulation ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingAdsl a) =>
a
-> m T.Text
settingAdslGetEncapsulation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingAdsl a) =>
a -> m Text
settingAdslGetEncapsulation a
setting = 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 SettingAdsl
setting' <- a -> IO (Ptr SettingAdsl)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
CString
result <- Ptr SettingAdsl -> IO CString
nm_setting_adsl_get_encapsulation Ptr SettingAdsl
setting'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"settingAdslGetEncapsulation" 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
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data SettingAdslGetEncapsulationMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsSettingAdsl a) => O.OverloadedMethod SettingAdslGetEncapsulationMethodInfo a signature where
overloadedMethod = settingAdslGetEncapsulation
instance O.OverloadedMethodInfo SettingAdslGetEncapsulationMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingAdsl.settingAdslGetEncapsulation",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingAdsl.html#v:settingAdslGetEncapsulation"
})
#endif
foreign import ccall "nm_setting_adsl_get_password" nm_setting_adsl_get_password ::
Ptr SettingAdsl ->
IO CString
settingAdslGetPassword ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingAdsl a) =>
a
-> m T.Text
settingAdslGetPassword :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingAdsl a) =>
a -> m Text
settingAdslGetPassword a
setting = 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 SettingAdsl
setting' <- a -> IO (Ptr SettingAdsl)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
CString
result <- Ptr SettingAdsl -> IO CString
nm_setting_adsl_get_password Ptr SettingAdsl
setting'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"settingAdslGetPassword" 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
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data SettingAdslGetPasswordMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsSettingAdsl a) => O.OverloadedMethod SettingAdslGetPasswordMethodInfo a signature where
overloadedMethod = settingAdslGetPassword
instance O.OverloadedMethodInfo SettingAdslGetPasswordMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingAdsl.settingAdslGetPassword",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingAdsl.html#v:settingAdslGetPassword"
})
#endif
foreign import ccall "nm_setting_adsl_get_password_flags" nm_setting_adsl_get_password_flags ::
Ptr SettingAdsl ->
IO CUInt
settingAdslGetPasswordFlags ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingAdsl a) =>
a
-> m [NM.Flags.SettingSecretFlags]
settingAdslGetPasswordFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingAdsl a) =>
a -> m [SettingSecretFlags]
settingAdslGetPasswordFlags a
setting = IO [SettingSecretFlags] -> m [SettingSecretFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SettingSecretFlags] -> m [SettingSecretFlags])
-> IO [SettingSecretFlags] -> m [SettingSecretFlags]
forall a b. (a -> b) -> a -> b
$ do
Ptr SettingAdsl
setting' <- a -> IO (Ptr SettingAdsl)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
CUInt
result <- Ptr SettingAdsl -> IO CUInt
nm_setting_adsl_get_password_flags Ptr SettingAdsl
setting'
let result' :: [SettingSecretFlags]
result' = CUInt -> [SettingSecretFlags]
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
setting
[SettingSecretFlags] -> IO [SettingSecretFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [SettingSecretFlags]
result'
#if defined(ENABLE_OVERLOADING)
data SettingAdslGetPasswordFlagsMethodInfo
instance (signature ~ (m [NM.Flags.SettingSecretFlags]), MonadIO m, IsSettingAdsl a) => O.OverloadedMethod SettingAdslGetPasswordFlagsMethodInfo a signature where
overloadedMethod = settingAdslGetPasswordFlags
instance O.OverloadedMethodInfo SettingAdslGetPasswordFlagsMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingAdsl.settingAdslGetPasswordFlags",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingAdsl.html#v:settingAdslGetPasswordFlags"
})
#endif
foreign import ccall "nm_setting_adsl_get_protocol" nm_setting_adsl_get_protocol ::
Ptr SettingAdsl ->
IO CString
settingAdslGetProtocol ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingAdsl a) =>
a
-> m T.Text
settingAdslGetProtocol :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingAdsl a) =>
a -> m Text
settingAdslGetProtocol a
setting = 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 SettingAdsl
setting' <- a -> IO (Ptr SettingAdsl)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
CString
result <- Ptr SettingAdsl -> IO CString
nm_setting_adsl_get_protocol Ptr SettingAdsl
setting'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"settingAdslGetProtocol" 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
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data SettingAdslGetProtocolMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsSettingAdsl a) => O.OverloadedMethod SettingAdslGetProtocolMethodInfo a signature where
overloadedMethod = settingAdslGetProtocol
instance O.OverloadedMethodInfo SettingAdslGetProtocolMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingAdsl.settingAdslGetProtocol",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingAdsl.html#v:settingAdslGetProtocol"
})
#endif
foreign import ccall "nm_setting_adsl_get_username" nm_setting_adsl_get_username ::
Ptr SettingAdsl ->
IO CString
settingAdslGetUsername ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingAdsl a) =>
a
-> m T.Text
settingAdslGetUsername :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingAdsl a) =>
a -> m Text
settingAdslGetUsername a
setting = 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 SettingAdsl
setting' <- a -> IO (Ptr SettingAdsl)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
CString
result <- Ptr SettingAdsl -> IO CString
nm_setting_adsl_get_username Ptr SettingAdsl
setting'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"settingAdslGetUsername" 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
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data SettingAdslGetUsernameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsSettingAdsl a) => O.OverloadedMethod SettingAdslGetUsernameMethodInfo a signature where
overloadedMethod = settingAdslGetUsername
instance O.OverloadedMethodInfo SettingAdslGetUsernameMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingAdsl.settingAdslGetUsername",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingAdsl.html#v:settingAdslGetUsername"
})
#endif
foreign import ccall "nm_setting_adsl_get_vci" nm_setting_adsl_get_vci ::
Ptr SettingAdsl ->
IO Word32
settingAdslGetVci ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingAdsl a) =>
a
-> m Word32
settingAdslGetVci :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingAdsl a) =>
a -> m Word32
settingAdslGetVci 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 SettingAdsl
setting' <- a -> IO (Ptr SettingAdsl)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
Word32
result <- Ptr SettingAdsl -> IO Word32
nm_setting_adsl_get_vci Ptr SettingAdsl
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 SettingAdslGetVciMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsSettingAdsl a) => O.OverloadedMethod SettingAdslGetVciMethodInfo a signature where
overloadedMethod = settingAdslGetVci
instance O.OverloadedMethodInfo SettingAdslGetVciMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingAdsl.settingAdslGetVci",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingAdsl.html#v:settingAdslGetVci"
})
#endif
foreign import ccall "nm_setting_adsl_get_vpi" nm_setting_adsl_get_vpi ::
Ptr SettingAdsl ->
IO Word32
settingAdslGetVpi ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingAdsl a) =>
a
-> m Word32
settingAdslGetVpi :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingAdsl a) =>
a -> m Word32
settingAdslGetVpi 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 SettingAdsl
setting' <- a -> IO (Ptr SettingAdsl)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
Word32
result <- Ptr SettingAdsl -> IO Word32
nm_setting_adsl_get_vpi Ptr SettingAdsl
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 SettingAdslGetVpiMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsSettingAdsl a) => O.OverloadedMethod SettingAdslGetVpiMethodInfo a signature where
overloadedMethod = settingAdslGetVpi
instance O.OverloadedMethodInfo SettingAdslGetVpiMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingAdsl.settingAdslGetVpi",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingAdsl.html#v:settingAdslGetVpi"
})
#endif