{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.NM.Objects.DeviceWifi
(
DeviceWifi(..) ,
IsDeviceWifi ,
toDeviceWifi ,
#if defined(ENABLE_OVERLOADING)
ResolveDeviceWifiMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
DeviceWifiGetAccessPointByPathMethodInfo,
#endif
deviceWifiGetAccessPointByPath ,
#if defined(ENABLE_OVERLOADING)
DeviceWifiGetAccessPointsMethodInfo ,
#endif
deviceWifiGetAccessPoints ,
#if defined(ENABLE_OVERLOADING)
DeviceWifiGetActiveAccessPointMethodInfo,
#endif
deviceWifiGetActiveAccessPoint ,
#if defined(ENABLE_OVERLOADING)
DeviceWifiGetBitrateMethodInfo ,
#endif
deviceWifiGetBitrate ,
#if defined(ENABLE_OVERLOADING)
DeviceWifiGetCapabilitiesMethodInfo ,
#endif
deviceWifiGetCapabilities ,
#if defined(ENABLE_OVERLOADING)
DeviceWifiGetLastScanMethodInfo ,
#endif
deviceWifiGetLastScan ,
#if defined(ENABLE_OVERLOADING)
DeviceWifiGetModeMethodInfo ,
#endif
deviceWifiGetMode ,
#if defined(ENABLE_OVERLOADING)
DeviceWifiGetPermanentHwAddressMethodInfo,
#endif
deviceWifiGetPermanentHwAddress ,
#if defined(ENABLE_OVERLOADING)
DeviceWifiRequestScanMethodInfo ,
#endif
deviceWifiRequestScan ,
#if defined(ENABLE_OVERLOADING)
DeviceWifiRequestScanAsyncMethodInfo ,
#endif
deviceWifiRequestScanAsync ,
#if defined(ENABLE_OVERLOADING)
DeviceWifiRequestScanFinishMethodInfo ,
#endif
deviceWifiRequestScanFinish ,
#if defined(ENABLE_OVERLOADING)
DeviceWifiRequestScanOptionsMethodInfo ,
#endif
deviceWifiRequestScanOptions ,
#if defined(ENABLE_OVERLOADING)
DeviceWifiRequestScanOptionsAsyncMethodInfo,
#endif
deviceWifiRequestScanOptionsAsync ,
#if defined(ENABLE_OVERLOADING)
DeviceWifiAccessPointsPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceWifiAccessPoints ,
#endif
#if defined(ENABLE_OVERLOADING)
DeviceWifiActiveAccessPointPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceWifiActiveAccessPoint ,
#endif
getDeviceWifiActiveAccessPoint ,
#if defined(ENABLE_OVERLOADING)
DeviceWifiBitratePropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceWifiBitrate ,
#endif
getDeviceWifiBitrate ,
#if defined(ENABLE_OVERLOADING)
DeviceWifiLastScanPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceWifiLastScan ,
#endif
getDeviceWifiLastScan ,
#if defined(ENABLE_OVERLOADING)
DeviceWifiModePropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceWifiMode ,
#endif
getDeviceWifiMode ,
#if defined(ENABLE_OVERLOADING)
DeviceWifiPermHwAddressPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceWifiPermHwAddress ,
#endif
getDeviceWifiPermHwAddress ,
#if defined(ENABLE_OVERLOADING)
DeviceWifiWirelessCapabilitiesPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
deviceWifiWirelessCapabilities ,
#endif
getDeviceWifiWirelessCapabilities ,
DeviceWifiAccessPointAddedCallback ,
#if defined(ENABLE_OVERLOADING)
DeviceWifiAccessPointAddedSignalInfo ,
#endif
afterDeviceWifiAccessPointAdded ,
onDeviceWifiAccessPointAdded ,
DeviceWifiAccessPointRemovedCallback ,
#if defined(ENABLE_OVERLOADING)
DeviceWifiAccessPointRemovedSignalInfo ,
#endif
afterDeviceWifiAccessPointRemoved ,
onDeviceWifiAccessPointRemoved ,
) 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.MainContext as GLib.MainContext
import qualified GI.GLib.Structs.VariantType as GLib.VariantType
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncInitable as Gio.AsyncInitable
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.DBusConnection as Gio.DBusConnection
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.AccessPoint as NM.AccessPoint
import {-# SOURCE #-} qualified GI.NM.Objects.ActiveConnection as NM.ActiveConnection
import {-# SOURCE #-} qualified GI.NM.Objects.Checkpoint as NM.Checkpoint
import {-# SOURCE #-} qualified GI.NM.Objects.Client as NM.Client
import {-# SOURCE #-} qualified GI.NM.Objects.Device as NM.Device
import {-# SOURCE #-} qualified GI.NM.Objects.DhcpConfig as NM.DhcpConfig
import {-# SOURCE #-} qualified GI.NM.Objects.IPConfig as NM.IPConfig
import {-# SOURCE #-} qualified GI.NM.Objects.Object as NM.Object
import {-# SOURCE #-} qualified GI.NM.Objects.RemoteConnection as NM.RemoteConnection
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.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.DnsEntry as NM.DnsEntry
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.LldpNeighbor as NM.LldpNeighbor
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 qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.NM.Enums as NM.Enums
import {-# SOURCE #-} qualified GI.NM.Flags as NM.Flags
import {-# SOURCE #-} qualified GI.NM.Objects.AccessPoint as NM.AccessPoint
import {-# SOURCE #-} qualified GI.NM.Objects.Device as NM.Device
import {-# SOURCE #-} qualified GI.NM.Objects.Object as NM.Object
#endif
newtype DeviceWifi = DeviceWifi (SP.ManagedPtr DeviceWifi)
deriving (DeviceWifi -> DeviceWifi -> Bool
(DeviceWifi -> DeviceWifi -> Bool)
-> (DeviceWifi -> DeviceWifi -> Bool) -> Eq DeviceWifi
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeviceWifi -> DeviceWifi -> Bool
== :: DeviceWifi -> DeviceWifi -> Bool
$c/= :: DeviceWifi -> DeviceWifi -> Bool
/= :: DeviceWifi -> DeviceWifi -> Bool
Eq)
instance SP.ManagedPtrNewtype DeviceWifi where
toManagedPtr :: DeviceWifi -> ManagedPtr DeviceWifi
toManagedPtr (DeviceWifi ManagedPtr DeviceWifi
p) = ManagedPtr DeviceWifi
p
foreign import ccall "nm_device_wifi_get_type"
c_nm_device_wifi_get_type :: IO B.Types.GType
instance B.Types.TypedObject DeviceWifi where
glibType :: IO GType
glibType = IO GType
c_nm_device_wifi_get_type
instance B.Types.GObject DeviceWifi
class (SP.GObject o, O.IsDescendantOf DeviceWifi o) => IsDeviceWifi o
instance (SP.GObject o, O.IsDescendantOf DeviceWifi o) => IsDeviceWifi o
instance O.HasParentTypes DeviceWifi
type instance O.ParentTypes DeviceWifi = '[NM.Device.Device, NM.Object.Object, GObject.Object.Object]
toDeviceWifi :: (MIO.MonadIO m, IsDeviceWifi o) => o -> m DeviceWifi
toDeviceWifi :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceWifi o) =>
o -> m DeviceWifi
toDeviceWifi = IO DeviceWifi -> m DeviceWifi
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO DeviceWifi -> m DeviceWifi)
-> (o -> IO DeviceWifi) -> o -> m DeviceWifi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr DeviceWifi -> DeviceWifi) -> o -> IO DeviceWifi
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr DeviceWifi -> DeviceWifi
DeviceWifi
instance B.GValue.IsGValue (Maybe DeviceWifi) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_nm_device_wifi_get_type
gvalueSet_ :: Ptr GValue -> Maybe DeviceWifi -> IO ()
gvalueSet_ Ptr GValue
gv Maybe DeviceWifi
P.Nothing = Ptr GValue -> Ptr DeviceWifi -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr DeviceWifi
forall a. Ptr a
FP.nullPtr :: FP.Ptr DeviceWifi)
gvalueSet_ Ptr GValue
gv (P.Just DeviceWifi
obj) = DeviceWifi -> (Ptr DeviceWifi -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr DeviceWifi
obj (Ptr GValue -> Ptr DeviceWifi -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe DeviceWifi)
gvalueGet_ Ptr GValue
gv = do
Ptr DeviceWifi
ptr <- Ptr GValue -> IO (Ptr DeviceWifi)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr DeviceWifi)
if Ptr DeviceWifi
ptr Ptr DeviceWifi -> Ptr DeviceWifi -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr DeviceWifi
forall a. Ptr a
FP.nullPtr
then DeviceWifi -> Maybe DeviceWifi
forall a. a -> Maybe a
P.Just (DeviceWifi -> Maybe DeviceWifi)
-> IO DeviceWifi -> IO (Maybe DeviceWifi)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr DeviceWifi -> DeviceWifi)
-> Ptr DeviceWifi -> IO DeviceWifi
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr DeviceWifi -> DeviceWifi
DeviceWifi Ptr DeviceWifi
ptr
else Maybe DeviceWifi -> IO (Maybe DeviceWifi)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DeviceWifi
forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveDeviceWifiMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveDeviceWifiMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveDeviceWifiMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveDeviceWifiMethod "connectionCompatible" o = NM.Device.DeviceConnectionCompatibleMethodInfo
ResolveDeviceWifiMethod "connectionValid" o = NM.Device.DeviceConnectionValidMethodInfo
ResolveDeviceWifiMethod "delete" o = NM.Device.DeviceDeleteMethodInfo
ResolveDeviceWifiMethod "deleteAsync" o = NM.Device.DeviceDeleteAsyncMethodInfo
ResolveDeviceWifiMethod "deleteFinish" o = NM.Device.DeviceDeleteFinishMethodInfo
ResolveDeviceWifiMethod "disconnect" o = NM.Device.DeviceDisconnectMethodInfo
ResolveDeviceWifiMethod "disconnectAsync" o = NM.Device.DeviceDisconnectAsyncMethodInfo
ResolveDeviceWifiMethod "disconnectFinish" o = NM.Device.DeviceDisconnectFinishMethodInfo
ResolveDeviceWifiMethod "filterConnections" o = NM.Device.DeviceFilterConnectionsMethodInfo
ResolveDeviceWifiMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveDeviceWifiMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveDeviceWifiMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveDeviceWifiMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveDeviceWifiMethod "isReal" o = NM.Device.DeviceIsRealMethodInfo
ResolveDeviceWifiMethod "isSoftware" o = NM.Device.DeviceIsSoftwareMethodInfo
ResolveDeviceWifiMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveDeviceWifiMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveDeviceWifiMethod "reapply" o = NM.Device.DeviceReapplyMethodInfo
ResolveDeviceWifiMethod "reapplyAsync" o = NM.Device.DeviceReapplyAsyncMethodInfo
ResolveDeviceWifiMethod "reapplyFinish" o = NM.Device.DeviceReapplyFinishMethodInfo
ResolveDeviceWifiMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveDeviceWifiMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveDeviceWifiMethod "requestScan" o = DeviceWifiRequestScanMethodInfo
ResolveDeviceWifiMethod "requestScanAsync" o = DeviceWifiRequestScanAsyncMethodInfo
ResolveDeviceWifiMethod "requestScanFinish" o = DeviceWifiRequestScanFinishMethodInfo
ResolveDeviceWifiMethod "requestScanOptions" o = DeviceWifiRequestScanOptionsMethodInfo
ResolveDeviceWifiMethod "requestScanOptionsAsync" o = DeviceWifiRequestScanOptionsAsyncMethodInfo
ResolveDeviceWifiMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveDeviceWifiMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveDeviceWifiMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveDeviceWifiMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveDeviceWifiMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveDeviceWifiMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveDeviceWifiMethod "getAccessPointByPath" o = DeviceWifiGetAccessPointByPathMethodInfo
ResolveDeviceWifiMethod "getAccessPoints" o = DeviceWifiGetAccessPointsMethodInfo
ResolveDeviceWifiMethod "getActiveAccessPoint" o = DeviceWifiGetActiveAccessPointMethodInfo
ResolveDeviceWifiMethod "getActiveConnection" o = NM.Device.DeviceGetActiveConnectionMethodInfo
ResolveDeviceWifiMethod "getAppliedConnection" o = NM.Device.DeviceGetAppliedConnectionMethodInfo
ResolveDeviceWifiMethod "getAppliedConnectionAsync" o = NM.Device.DeviceGetAppliedConnectionAsyncMethodInfo
ResolveDeviceWifiMethod "getAppliedConnectionFinish" o = NM.Device.DeviceGetAppliedConnectionFinishMethodInfo
ResolveDeviceWifiMethod "getAutoconnect" o = NM.Device.DeviceGetAutoconnectMethodInfo
ResolveDeviceWifiMethod "getAvailableConnections" o = NM.Device.DeviceGetAvailableConnectionsMethodInfo
ResolveDeviceWifiMethod "getBitrate" o = DeviceWifiGetBitrateMethodInfo
ResolveDeviceWifiMethod "getCapabilities" o = DeviceWifiGetCapabilitiesMethodInfo
ResolveDeviceWifiMethod "getClient" o = NM.Object.ObjectGetClientMethodInfo
ResolveDeviceWifiMethod "getConnectivity" o = NM.Device.DeviceGetConnectivityMethodInfo
ResolveDeviceWifiMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveDeviceWifiMethod "getDescription" o = NM.Device.DeviceGetDescriptionMethodInfo
ResolveDeviceWifiMethod "getDeviceType" o = NM.Device.DeviceGetDeviceTypeMethodInfo
ResolveDeviceWifiMethod "getDhcp4Config" o = NM.Device.DeviceGetDhcp4ConfigMethodInfo
ResolveDeviceWifiMethod "getDhcp6Config" o = NM.Device.DeviceGetDhcp6ConfigMethodInfo
ResolveDeviceWifiMethod "getDriver" o = NM.Device.DeviceGetDriverMethodInfo
ResolveDeviceWifiMethod "getDriverVersion" o = NM.Device.DeviceGetDriverVersionMethodInfo
ResolveDeviceWifiMethod "getFirmwareMissing" o = NM.Device.DeviceGetFirmwareMissingMethodInfo
ResolveDeviceWifiMethod "getFirmwareVersion" o = NM.Device.DeviceGetFirmwareVersionMethodInfo
ResolveDeviceWifiMethod "getHwAddress" o = NM.Device.DeviceGetHwAddressMethodInfo
ResolveDeviceWifiMethod "getIface" o = NM.Device.DeviceGetIfaceMethodInfo
ResolveDeviceWifiMethod "getInterfaceFlags" o = NM.Device.DeviceGetInterfaceFlagsMethodInfo
ResolveDeviceWifiMethod "getIp4Config" o = NM.Device.DeviceGetIp4ConfigMethodInfo
ResolveDeviceWifiMethod "getIp6Config" o = NM.Device.DeviceGetIp6ConfigMethodInfo
ResolveDeviceWifiMethod "getIpIface" o = NM.Device.DeviceGetIpIfaceMethodInfo
ResolveDeviceWifiMethod "getLastScan" o = DeviceWifiGetLastScanMethodInfo
ResolveDeviceWifiMethod "getLldpNeighbors" o = NM.Device.DeviceGetLldpNeighborsMethodInfo
ResolveDeviceWifiMethod "getManaged" o = NM.Device.DeviceGetManagedMethodInfo
ResolveDeviceWifiMethod "getMetered" o = NM.Device.DeviceGetMeteredMethodInfo
ResolveDeviceWifiMethod "getMode" o = DeviceWifiGetModeMethodInfo
ResolveDeviceWifiMethod "getMtu" o = NM.Device.DeviceGetMtuMethodInfo
ResolveDeviceWifiMethod "getNmPluginMissing" o = NM.Device.DeviceGetNmPluginMissingMethodInfo
ResolveDeviceWifiMethod "getPath" o = NM.Device.DeviceGetPathMethodInfo
ResolveDeviceWifiMethod "getPermanentHwAddress" o = DeviceWifiGetPermanentHwAddressMethodInfo
ResolveDeviceWifiMethod "getPhysicalPortId" o = NM.Device.DeviceGetPhysicalPortIdMethodInfo
ResolveDeviceWifiMethod "getPorts" o = NM.Device.DeviceGetPortsMethodInfo
ResolveDeviceWifiMethod "getProduct" o = NM.Device.DeviceGetProductMethodInfo
ResolveDeviceWifiMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveDeviceWifiMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveDeviceWifiMethod "getSettingType" o = NM.Device.DeviceGetSettingTypeMethodInfo
ResolveDeviceWifiMethod "getState" o = NM.Device.DeviceGetStateMethodInfo
ResolveDeviceWifiMethod "getStateReason" o = NM.Device.DeviceGetStateReasonMethodInfo
ResolveDeviceWifiMethod "getTypeDescription" o = NM.Device.DeviceGetTypeDescriptionMethodInfo
ResolveDeviceWifiMethod "getUdi" o = NM.Device.DeviceGetUdiMethodInfo
ResolveDeviceWifiMethod "getVendor" o = NM.Device.DeviceGetVendorMethodInfo
ResolveDeviceWifiMethod "setAutoconnect" o = NM.Device.DeviceSetAutoconnectMethodInfo
ResolveDeviceWifiMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveDeviceWifiMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveDeviceWifiMethod "setManaged" o = NM.Device.DeviceSetManagedMethodInfo
ResolveDeviceWifiMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveDeviceWifiMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveDeviceWifiMethod t DeviceWifi, O.OverloadedMethod info DeviceWifi p) => OL.IsLabel t (DeviceWifi -> 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 ~ ResolveDeviceWifiMethod t DeviceWifi, O.OverloadedMethod info DeviceWifi p, R.HasField t DeviceWifi p) => R.HasField t DeviceWifi p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveDeviceWifiMethod t DeviceWifi, O.OverloadedMethodInfo info DeviceWifi) => OL.IsLabel t (O.MethodProxy info DeviceWifi) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
type DeviceWifiAccessPointAddedCallback =
GObject.Object.Object
-> IO ()
type C_DeviceWifiAccessPointAddedCallback =
Ptr DeviceWifi ->
Ptr GObject.Object.Object ->
Ptr () ->
IO ()
foreign import ccall "wrapper"
mk_DeviceWifiAccessPointAddedCallback :: C_DeviceWifiAccessPointAddedCallback -> IO (FunPtr C_DeviceWifiAccessPointAddedCallback)
wrap_DeviceWifiAccessPointAddedCallback ::
GObject a => (a -> DeviceWifiAccessPointAddedCallback) ->
C_DeviceWifiAccessPointAddedCallback
wrap_DeviceWifiAccessPointAddedCallback :: forall a.
GObject a =>
(a -> DeviceWifiAccessPointAddedCallback)
-> C_DeviceWifiAccessPointAddedCallback
wrap_DeviceWifiAccessPointAddedCallback a -> DeviceWifiAccessPointAddedCallback
gi'cb Ptr DeviceWifi
gi'selfPtr Ptr Object
ap Ptr ()
_ = do
Object
ap' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
GObject.Object.Object) Ptr Object
ap
Ptr DeviceWifi -> (DeviceWifi -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr DeviceWifi
gi'selfPtr ((DeviceWifi -> IO ()) -> IO ()) -> (DeviceWifi -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DeviceWifi
gi'self -> a -> DeviceWifiAccessPointAddedCallback
gi'cb (DeviceWifi -> a
forall a b. Coercible a b => a -> b
Coerce.coerce DeviceWifi
gi'self) Object
ap'
onDeviceWifiAccessPointAdded :: (IsDeviceWifi a, MonadIO m) => a -> ((?self :: a) => DeviceWifiAccessPointAddedCallback) -> m SignalHandlerId
onDeviceWifiAccessPointAdded :: forall a (m :: * -> *).
(IsDeviceWifi a, MonadIO m) =>
a
-> ((?self::a) => DeviceWifiAccessPointAddedCallback)
-> m SignalHandlerId
onDeviceWifiAccessPointAdded a
obj (?self::a) => DeviceWifiAccessPointAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
let wrapped :: a -> DeviceWifiAccessPointAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DeviceWifiAccessPointAddedCallback
DeviceWifiAccessPointAddedCallback
cb
let wrapped' :: C_DeviceWifiAccessPointAddedCallback
wrapped' = (a -> DeviceWifiAccessPointAddedCallback)
-> C_DeviceWifiAccessPointAddedCallback
forall a.
GObject a =>
(a -> DeviceWifiAccessPointAddedCallback)
-> C_DeviceWifiAccessPointAddedCallback
wrap_DeviceWifiAccessPointAddedCallback a -> DeviceWifiAccessPointAddedCallback
wrapped
FunPtr C_DeviceWifiAccessPointAddedCallback
wrapped'' <- C_DeviceWifiAccessPointAddedCallback
-> IO (FunPtr C_DeviceWifiAccessPointAddedCallback)
mk_DeviceWifiAccessPointAddedCallback C_DeviceWifiAccessPointAddedCallback
wrapped'
a
-> Text
-> FunPtr C_DeviceWifiAccessPointAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"access-point-added" FunPtr C_DeviceWifiAccessPointAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing
afterDeviceWifiAccessPointAdded :: (IsDeviceWifi a, MonadIO m) => a -> ((?self :: a) => DeviceWifiAccessPointAddedCallback) -> m SignalHandlerId
afterDeviceWifiAccessPointAdded :: forall a (m :: * -> *).
(IsDeviceWifi a, MonadIO m) =>
a
-> ((?self::a) => DeviceWifiAccessPointAddedCallback)
-> m SignalHandlerId
afterDeviceWifiAccessPointAdded a
obj (?self::a) => DeviceWifiAccessPointAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
let wrapped :: a -> DeviceWifiAccessPointAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DeviceWifiAccessPointAddedCallback
DeviceWifiAccessPointAddedCallback
cb
let wrapped' :: C_DeviceWifiAccessPointAddedCallback
wrapped' = (a -> DeviceWifiAccessPointAddedCallback)
-> C_DeviceWifiAccessPointAddedCallback
forall a.
GObject a =>
(a -> DeviceWifiAccessPointAddedCallback)
-> C_DeviceWifiAccessPointAddedCallback
wrap_DeviceWifiAccessPointAddedCallback a -> DeviceWifiAccessPointAddedCallback
wrapped
FunPtr C_DeviceWifiAccessPointAddedCallback
wrapped'' <- C_DeviceWifiAccessPointAddedCallback
-> IO (FunPtr C_DeviceWifiAccessPointAddedCallback)
mk_DeviceWifiAccessPointAddedCallback C_DeviceWifiAccessPointAddedCallback
wrapped'
a
-> Text
-> FunPtr C_DeviceWifiAccessPointAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"access-point-added" FunPtr C_DeviceWifiAccessPointAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing
#if defined(ENABLE_OVERLOADING)
data DeviceWifiAccessPointAddedSignalInfo
instance SignalInfo DeviceWifiAccessPointAddedSignalInfo where
type HaskellCallbackType DeviceWifiAccessPointAddedSignalInfo = DeviceWifiAccessPointAddedCallback
connectSignal obj cb connectMode detail = do
let cb' = wrap_DeviceWifiAccessPointAddedCallback cb
cb'' <- mk_DeviceWifiAccessPointAddedCallback cb'
connectSignalFunPtr obj "access-point-added" cb'' connectMode detail
dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceWifi::access-point-added"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceWifi.html#g:signal:accessPointAdded"})
#endif
type DeviceWifiAccessPointRemovedCallback =
GObject.Object.Object
-> IO ()
type C_DeviceWifiAccessPointRemovedCallback =
Ptr DeviceWifi ->
Ptr GObject.Object.Object ->
Ptr () ->
IO ()
foreign import ccall "wrapper"
mk_DeviceWifiAccessPointRemovedCallback :: C_DeviceWifiAccessPointRemovedCallback -> IO (FunPtr C_DeviceWifiAccessPointRemovedCallback)
wrap_DeviceWifiAccessPointRemovedCallback ::
GObject a => (a -> DeviceWifiAccessPointRemovedCallback) ->
C_DeviceWifiAccessPointRemovedCallback
wrap_DeviceWifiAccessPointRemovedCallback :: forall a.
GObject a =>
(a -> DeviceWifiAccessPointAddedCallback)
-> C_DeviceWifiAccessPointAddedCallback
wrap_DeviceWifiAccessPointRemovedCallback a -> DeviceWifiAccessPointAddedCallback
gi'cb Ptr DeviceWifi
gi'selfPtr Ptr Object
ap Ptr ()
_ = do
Object
ap' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
GObject.Object.Object) Ptr Object
ap
Ptr DeviceWifi -> (DeviceWifi -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr DeviceWifi
gi'selfPtr ((DeviceWifi -> IO ()) -> IO ()) -> (DeviceWifi -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DeviceWifi
gi'self -> a -> DeviceWifiAccessPointAddedCallback
gi'cb (DeviceWifi -> a
forall a b. Coercible a b => a -> b
Coerce.coerce DeviceWifi
gi'self) Object
ap'
onDeviceWifiAccessPointRemoved :: (IsDeviceWifi a, MonadIO m) => a -> ((?self :: a) => DeviceWifiAccessPointRemovedCallback) -> m SignalHandlerId
onDeviceWifiAccessPointRemoved :: forall a (m :: * -> *).
(IsDeviceWifi a, MonadIO m) =>
a
-> ((?self::a) => DeviceWifiAccessPointAddedCallback)
-> m SignalHandlerId
onDeviceWifiAccessPointRemoved a
obj (?self::a) => DeviceWifiAccessPointAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
let wrapped :: a -> DeviceWifiAccessPointAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DeviceWifiAccessPointAddedCallback
DeviceWifiAccessPointAddedCallback
cb
let wrapped' :: C_DeviceWifiAccessPointAddedCallback
wrapped' = (a -> DeviceWifiAccessPointAddedCallback)
-> C_DeviceWifiAccessPointAddedCallback
forall a.
GObject a =>
(a -> DeviceWifiAccessPointAddedCallback)
-> C_DeviceWifiAccessPointAddedCallback
wrap_DeviceWifiAccessPointRemovedCallback a -> DeviceWifiAccessPointAddedCallback
wrapped
FunPtr C_DeviceWifiAccessPointAddedCallback
wrapped'' <- C_DeviceWifiAccessPointAddedCallback
-> IO (FunPtr C_DeviceWifiAccessPointAddedCallback)
mk_DeviceWifiAccessPointRemovedCallback C_DeviceWifiAccessPointAddedCallback
wrapped'
a
-> Text
-> FunPtr C_DeviceWifiAccessPointAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"access-point-removed" FunPtr C_DeviceWifiAccessPointAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing
afterDeviceWifiAccessPointRemoved :: (IsDeviceWifi a, MonadIO m) => a -> ((?self :: a) => DeviceWifiAccessPointRemovedCallback) -> m SignalHandlerId
afterDeviceWifiAccessPointRemoved :: forall a (m :: * -> *).
(IsDeviceWifi a, MonadIO m) =>
a
-> ((?self::a) => DeviceWifiAccessPointAddedCallback)
-> m SignalHandlerId
afterDeviceWifiAccessPointRemoved a
obj (?self::a) => DeviceWifiAccessPointAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
let wrapped :: a -> DeviceWifiAccessPointAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DeviceWifiAccessPointAddedCallback
DeviceWifiAccessPointAddedCallback
cb
let wrapped' :: C_DeviceWifiAccessPointAddedCallback
wrapped' = (a -> DeviceWifiAccessPointAddedCallback)
-> C_DeviceWifiAccessPointAddedCallback
forall a.
GObject a =>
(a -> DeviceWifiAccessPointAddedCallback)
-> C_DeviceWifiAccessPointAddedCallback
wrap_DeviceWifiAccessPointRemovedCallback a -> DeviceWifiAccessPointAddedCallback
wrapped
FunPtr C_DeviceWifiAccessPointAddedCallback
wrapped'' <- C_DeviceWifiAccessPointAddedCallback
-> IO (FunPtr C_DeviceWifiAccessPointAddedCallback)
mk_DeviceWifiAccessPointRemovedCallback C_DeviceWifiAccessPointAddedCallback
wrapped'
a
-> Text
-> FunPtr C_DeviceWifiAccessPointAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"access-point-removed" FunPtr C_DeviceWifiAccessPointAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing
#if defined(ENABLE_OVERLOADING)
data DeviceWifiAccessPointRemovedSignalInfo
instance SignalInfo DeviceWifiAccessPointRemovedSignalInfo where
type HaskellCallbackType DeviceWifiAccessPointRemovedSignalInfo = DeviceWifiAccessPointRemovedCallback
connectSignal obj cb connectMode detail = do
let cb' = wrap_DeviceWifiAccessPointRemovedCallback cb
cb'' <- mk_DeviceWifiAccessPointRemovedCallback cb'
connectSignalFunPtr obj "access-point-removed" cb'' connectMode detail
dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceWifi::access-point-removed"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceWifi.html#g:signal:accessPointRemoved"})
#endif
#if defined(ENABLE_OVERLOADING)
data DeviceWifiAccessPointsPropertyInfo
instance AttrInfo DeviceWifiAccessPointsPropertyInfo where
type AttrAllowedOps DeviceWifiAccessPointsPropertyInfo = '[]
type AttrSetTypeConstraint DeviceWifiAccessPointsPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceWifiAccessPointsPropertyInfo = (~) ()
type AttrTransferType DeviceWifiAccessPointsPropertyInfo = ()
type AttrBaseTypeConstraint DeviceWifiAccessPointsPropertyInfo = (~) ()
type AttrGetType DeviceWifiAccessPointsPropertyInfo = ()
type AttrLabel DeviceWifiAccessPointsPropertyInfo = ""
type AttrOrigin DeviceWifiAccessPointsPropertyInfo = DeviceWifi
attrGet = undefined
attrSet = undefined
attrConstruct = undefined
attrClear = undefined
attrTransfer = undefined
#endif
getDeviceWifiActiveAccessPoint :: (MonadIO m, IsDeviceWifi o) => o -> m NM.AccessPoint.AccessPoint
getDeviceWifiActiveAccessPoint :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceWifi o) =>
o -> m AccessPoint
getDeviceWifiActiveAccessPoint o
obj = IO AccessPoint -> m AccessPoint
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO AccessPoint -> m AccessPoint)
-> IO AccessPoint -> m AccessPoint
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe AccessPoint) -> IO AccessPoint
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getDeviceWifiActiveAccessPoint" (IO (Maybe AccessPoint) -> IO AccessPoint)
-> IO (Maybe AccessPoint) -> IO AccessPoint
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr AccessPoint -> AccessPoint)
-> IO (Maybe AccessPoint)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"active-access-point" ManagedPtr AccessPoint -> AccessPoint
NM.AccessPoint.AccessPoint
#if defined(ENABLE_OVERLOADING)
data DeviceWifiActiveAccessPointPropertyInfo
instance AttrInfo DeviceWifiActiveAccessPointPropertyInfo where
type AttrAllowedOps DeviceWifiActiveAccessPointPropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint DeviceWifiActiveAccessPointPropertyInfo = IsDeviceWifi
type AttrSetTypeConstraint DeviceWifiActiveAccessPointPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceWifiActiveAccessPointPropertyInfo = (~) ()
type AttrTransferType DeviceWifiActiveAccessPointPropertyInfo = ()
type AttrGetType DeviceWifiActiveAccessPointPropertyInfo = NM.AccessPoint.AccessPoint
type AttrLabel DeviceWifiActiveAccessPointPropertyInfo = "active-access-point"
type AttrOrigin DeviceWifiActiveAccessPointPropertyInfo = DeviceWifi
attrGet = getDeviceWifiActiveAccessPoint
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceWifi.activeAccessPoint"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceWifi.html#g:attr:activeAccessPoint"
})
#endif
getDeviceWifiBitrate :: (MonadIO m, IsDeviceWifi o) => o -> m Word32
getDeviceWifiBitrate :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceWifi o) =>
o -> m Word32
getDeviceWifiBitrate 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
"bitrate"
#if defined(ENABLE_OVERLOADING)
data DeviceWifiBitratePropertyInfo
instance AttrInfo DeviceWifiBitratePropertyInfo where
type AttrAllowedOps DeviceWifiBitratePropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint DeviceWifiBitratePropertyInfo = IsDeviceWifi
type AttrSetTypeConstraint DeviceWifiBitratePropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceWifiBitratePropertyInfo = (~) ()
type AttrTransferType DeviceWifiBitratePropertyInfo = ()
type AttrGetType DeviceWifiBitratePropertyInfo = Word32
type AttrLabel DeviceWifiBitratePropertyInfo = "bitrate"
type AttrOrigin DeviceWifiBitratePropertyInfo = DeviceWifi
attrGet = getDeviceWifiBitrate
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceWifi.bitrate"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceWifi.html#g:attr:bitrate"
})
#endif
getDeviceWifiLastScan :: (MonadIO m, IsDeviceWifi o) => o -> m Int64
getDeviceWifiLastScan :: forall (m :: * -> *) o. (MonadIO m, IsDeviceWifi o) => o -> m Int64
getDeviceWifiLastScan o
obj = IO Int64 -> m Int64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int64
forall a. GObject a => a -> String -> IO Int64
B.Properties.getObjectPropertyInt64 o
obj String
"last-scan"
#if defined(ENABLE_OVERLOADING)
data DeviceWifiLastScanPropertyInfo
instance AttrInfo DeviceWifiLastScanPropertyInfo where
type AttrAllowedOps DeviceWifiLastScanPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint DeviceWifiLastScanPropertyInfo = IsDeviceWifi
type AttrSetTypeConstraint DeviceWifiLastScanPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceWifiLastScanPropertyInfo = (~) ()
type AttrTransferType DeviceWifiLastScanPropertyInfo = ()
type AttrGetType DeviceWifiLastScanPropertyInfo = Int64
type AttrLabel DeviceWifiLastScanPropertyInfo = "last-scan"
type AttrOrigin DeviceWifiLastScanPropertyInfo = DeviceWifi
attrGet = getDeviceWifiLastScan
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceWifi.lastScan"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceWifi.html#g:attr:lastScan"
})
#endif
getDeviceWifiMode :: (MonadIO m, IsDeviceWifi o) => o -> m NM.Enums.NM80211Mode
getDeviceWifiMode :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceWifi o) =>
o -> m NM80211Mode
getDeviceWifiMode o
obj = IO NM80211Mode -> m NM80211Mode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO NM80211Mode -> m NM80211Mode)
-> IO NM80211Mode -> m NM80211Mode
forall a b. (a -> b) -> a -> b
$ o -> String -> IO NM80211Mode
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"mode"
#if defined(ENABLE_OVERLOADING)
data DeviceWifiModePropertyInfo
instance AttrInfo DeviceWifiModePropertyInfo where
type AttrAllowedOps DeviceWifiModePropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint DeviceWifiModePropertyInfo = IsDeviceWifi
type AttrSetTypeConstraint DeviceWifiModePropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceWifiModePropertyInfo = (~) ()
type AttrTransferType DeviceWifiModePropertyInfo = ()
type AttrGetType DeviceWifiModePropertyInfo = NM.Enums.NM80211Mode
type AttrLabel DeviceWifiModePropertyInfo = "mode"
type AttrOrigin DeviceWifiModePropertyInfo = DeviceWifi
attrGet = getDeviceWifiMode
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceWifi.mode"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceWifi.html#g:attr:mode"
})
#endif
getDeviceWifiPermHwAddress :: (MonadIO m, IsDeviceWifi o) => o -> m (Maybe T.Text)
getDeviceWifiPermHwAddress :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceWifi o) =>
o -> m (Maybe Text)
getDeviceWifiPermHwAddress o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"perm-hw-address"
#if defined(ENABLE_OVERLOADING)
data DeviceWifiPermHwAddressPropertyInfo
instance AttrInfo DeviceWifiPermHwAddressPropertyInfo where
type AttrAllowedOps DeviceWifiPermHwAddressPropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint DeviceWifiPermHwAddressPropertyInfo = IsDeviceWifi
type AttrSetTypeConstraint DeviceWifiPermHwAddressPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceWifiPermHwAddressPropertyInfo = (~) ()
type AttrTransferType DeviceWifiPermHwAddressPropertyInfo = ()
type AttrGetType DeviceWifiPermHwAddressPropertyInfo = (Maybe T.Text)
type AttrLabel DeviceWifiPermHwAddressPropertyInfo = "perm-hw-address"
type AttrOrigin DeviceWifiPermHwAddressPropertyInfo = DeviceWifi
attrGet = getDeviceWifiPermHwAddress
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceWifi.permHwAddress"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceWifi.html#g:attr:permHwAddress"
})
#endif
getDeviceWifiWirelessCapabilities :: (MonadIO m, IsDeviceWifi o) => o -> m [NM.Flags.DeviceWifiCapabilities]
getDeviceWifiWirelessCapabilities :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceWifi o) =>
o -> m [DeviceWifiCapabilities]
getDeviceWifiWirelessCapabilities o
obj = IO [DeviceWifiCapabilities] -> m [DeviceWifiCapabilities]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO [DeviceWifiCapabilities] -> m [DeviceWifiCapabilities])
-> IO [DeviceWifiCapabilities] -> m [DeviceWifiCapabilities]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [DeviceWifiCapabilities]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"wireless-capabilities"
#if defined(ENABLE_OVERLOADING)
data DeviceWifiWirelessCapabilitiesPropertyInfo
instance AttrInfo DeviceWifiWirelessCapabilitiesPropertyInfo where
type AttrAllowedOps DeviceWifiWirelessCapabilitiesPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint DeviceWifiWirelessCapabilitiesPropertyInfo = IsDeviceWifi
type AttrSetTypeConstraint DeviceWifiWirelessCapabilitiesPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceWifiWirelessCapabilitiesPropertyInfo = (~) ()
type AttrTransferType DeviceWifiWirelessCapabilitiesPropertyInfo = ()
type AttrGetType DeviceWifiWirelessCapabilitiesPropertyInfo = [NM.Flags.DeviceWifiCapabilities]
type AttrLabel DeviceWifiWirelessCapabilitiesPropertyInfo = "wireless-capabilities"
type AttrOrigin DeviceWifiWirelessCapabilitiesPropertyInfo = DeviceWifi
attrGet = getDeviceWifiWirelessCapabilities
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceWifi.wirelessCapabilities"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceWifi.html#g:attr:wirelessCapabilities"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DeviceWifi
type instance O.AttributeList DeviceWifi = DeviceWifiAttributeList
type DeviceWifiAttributeList = ('[ '("accessPoints", DeviceWifiAccessPointsPropertyInfo), '("activeAccessPoint", DeviceWifiActiveAccessPointPropertyInfo), '("activeConnection", NM.Device.DeviceActiveConnectionPropertyInfo), '("autoconnect", NM.Device.DeviceAutoconnectPropertyInfo), '("availableConnections", NM.Device.DeviceAvailableConnectionsPropertyInfo), '("bitrate", DeviceWifiBitratePropertyInfo), '("capabilities", NM.Device.DeviceCapabilitiesPropertyInfo), '("client", NM.Object.ObjectClientPropertyInfo), '("deviceType", NM.Device.DeviceDeviceTypePropertyInfo), '("dhcp4Config", NM.Device.DeviceDhcp4ConfigPropertyInfo), '("dhcp6Config", NM.Device.DeviceDhcp6ConfigPropertyInfo), '("driver", NM.Device.DeviceDriverPropertyInfo), '("driverVersion", NM.Device.DeviceDriverVersionPropertyInfo), '("firmwareMissing", NM.Device.DeviceFirmwareMissingPropertyInfo), '("firmwareVersion", NM.Device.DeviceFirmwareVersionPropertyInfo), '("hwAddress", NM.Device.DeviceHwAddressPropertyInfo), '("interface", NM.Device.DeviceInterfacePropertyInfo), '("interfaceFlags", NM.Device.DeviceInterfaceFlagsPropertyInfo), '("ipInterface", NM.Device.DeviceIpInterfacePropertyInfo), '("ip4Config", NM.Device.DeviceIp4ConfigPropertyInfo), '("ip4Connectivity", NM.Device.DeviceIp4ConnectivityPropertyInfo), '("ip6Config", NM.Device.DeviceIp6ConfigPropertyInfo), '("ip6Connectivity", NM.Device.DeviceIp6ConnectivityPropertyInfo), '("lastScan", DeviceWifiLastScanPropertyInfo), '("lldpNeighbors", NM.Device.DeviceLldpNeighborsPropertyInfo), '("managed", NM.Device.DeviceManagedPropertyInfo), '("metered", NM.Device.DeviceMeteredPropertyInfo), '("mode", DeviceWifiModePropertyInfo), '("mtu", NM.Device.DeviceMtuPropertyInfo), '("nmPluginMissing", NM.Device.DeviceNmPluginMissingPropertyInfo), '("path", NM.Device.DevicePathPropertyInfo), '("permHwAddress", DeviceWifiPermHwAddressPropertyInfo), '("physicalPortId", NM.Device.DevicePhysicalPortIdPropertyInfo), '("ports", NM.Device.DevicePortsPropertyInfo), '("product", NM.Device.DeviceProductPropertyInfo), '("real", NM.Device.DeviceRealPropertyInfo), '("state", NM.Device.DeviceStatePropertyInfo), '("stateReason", NM.Device.DeviceStateReasonPropertyInfo), '("udi", NM.Device.DeviceUdiPropertyInfo), '("vendor", NM.Device.DeviceVendorPropertyInfo), '("wirelessCapabilities", DeviceWifiWirelessCapabilitiesPropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
deviceWifiAccessPoints :: AttrLabelProxy "accessPoints"
deviceWifiAccessPoints = AttrLabelProxy
deviceWifiActiveAccessPoint :: AttrLabelProxy "activeAccessPoint"
deviceWifiActiveAccessPoint = AttrLabelProxy
deviceWifiBitrate :: AttrLabelProxy "bitrate"
deviceWifiBitrate = AttrLabelProxy
deviceWifiLastScan :: AttrLabelProxy "lastScan"
deviceWifiLastScan = AttrLabelProxy
deviceWifiMode :: AttrLabelProxy "mode"
deviceWifiMode = AttrLabelProxy
deviceWifiPermHwAddress :: AttrLabelProxy "permHwAddress"
deviceWifiPermHwAddress = AttrLabelProxy
deviceWifiWirelessCapabilities :: AttrLabelProxy "wirelessCapabilities"
deviceWifiWirelessCapabilities = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList DeviceWifi = DeviceWifiSignalList
type DeviceWifiSignalList = ('[ '("accessPointAdded", DeviceWifiAccessPointAddedSignalInfo), '("accessPointRemoved", DeviceWifiAccessPointRemovedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("stateChanged", NM.Device.DeviceStateChangedSignalInfo)] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "nm_device_wifi_get_access_point_by_path" nm_device_wifi_get_access_point_by_path ::
Ptr DeviceWifi ->
CString ->
IO (Ptr NM.AccessPoint.AccessPoint)
deviceWifiGetAccessPointByPath ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceWifi a) =>
a
-> T.Text
-> m NM.AccessPoint.AccessPoint
deviceWifiGetAccessPointByPath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceWifi a) =>
a -> Text -> m AccessPoint
deviceWifiGetAccessPointByPath a
device Text
path = IO AccessPoint -> m AccessPoint
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AccessPoint -> m AccessPoint)
-> IO AccessPoint -> m AccessPoint
forall a b. (a -> b) -> a -> b
$ do
Ptr DeviceWifi
device' <- a -> IO (Ptr DeviceWifi)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
CString
path' <- Text -> IO CString
textToCString Text
path
Ptr AccessPoint
result <- Ptr DeviceWifi -> CString -> IO (Ptr AccessPoint)
nm_device_wifi_get_access_point_by_path Ptr DeviceWifi
device' CString
path'
Text -> Ptr AccessPoint -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"deviceWifiGetAccessPointByPath" Ptr AccessPoint
result
AccessPoint
result' <- ((ManagedPtr AccessPoint -> AccessPoint)
-> Ptr AccessPoint -> IO AccessPoint
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr AccessPoint -> AccessPoint
NM.AccessPoint.AccessPoint) Ptr AccessPoint
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
AccessPoint -> IO AccessPoint
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AccessPoint
result'
#if defined(ENABLE_OVERLOADING)
data DeviceWifiGetAccessPointByPathMethodInfo
instance (signature ~ (T.Text -> m NM.AccessPoint.AccessPoint), MonadIO m, IsDeviceWifi a) => O.OverloadedMethod DeviceWifiGetAccessPointByPathMethodInfo a signature where
overloadedMethod = deviceWifiGetAccessPointByPath
instance O.OverloadedMethodInfo DeviceWifiGetAccessPointByPathMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceWifi.deviceWifiGetAccessPointByPath",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceWifi.html#v:deviceWifiGetAccessPointByPath"
})
#endif
foreign import ccall "nm_device_wifi_get_access_points" nm_device_wifi_get_access_points ::
Ptr DeviceWifi ->
IO (Ptr (GPtrArray (Ptr NM.AccessPoint.AccessPoint)))
deviceWifiGetAccessPoints ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceWifi a) =>
a
-> m [NM.AccessPoint.AccessPoint]
deviceWifiGetAccessPoints :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceWifi a) =>
a -> m [AccessPoint]
deviceWifiGetAccessPoints a
device = IO [AccessPoint] -> m [AccessPoint]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [AccessPoint] -> m [AccessPoint])
-> IO [AccessPoint] -> m [AccessPoint]
forall a b. (a -> b) -> a -> b
$ do
Ptr DeviceWifi
device' <- a -> IO (Ptr DeviceWifi)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
Ptr (GPtrArray (Ptr AccessPoint))
result <- Ptr DeviceWifi -> IO (Ptr (GPtrArray (Ptr AccessPoint)))
nm_device_wifi_get_access_points Ptr DeviceWifi
device'
Text -> Ptr (GPtrArray (Ptr AccessPoint)) -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"deviceWifiGetAccessPoints" Ptr (GPtrArray (Ptr AccessPoint))
result
[Ptr AccessPoint]
result' <- Ptr (GPtrArray (Ptr AccessPoint)) -> IO [Ptr AccessPoint]
forall a. Ptr (GPtrArray (Ptr a)) -> IO [Ptr a]
unpackGPtrArray Ptr (GPtrArray (Ptr AccessPoint))
result
[AccessPoint]
result'' <- (Ptr AccessPoint -> IO AccessPoint)
-> [Ptr AccessPoint] -> IO [AccessPoint]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr AccessPoint -> AccessPoint)
-> Ptr AccessPoint -> IO AccessPoint
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr AccessPoint -> AccessPoint
NM.AccessPoint.AccessPoint) [Ptr AccessPoint]
result'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
[AccessPoint] -> IO [AccessPoint]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [AccessPoint]
result''
#if defined(ENABLE_OVERLOADING)
data DeviceWifiGetAccessPointsMethodInfo
instance (signature ~ (m [NM.AccessPoint.AccessPoint]), MonadIO m, IsDeviceWifi a) => O.OverloadedMethod DeviceWifiGetAccessPointsMethodInfo a signature where
overloadedMethod = deviceWifiGetAccessPoints
instance O.OverloadedMethodInfo DeviceWifiGetAccessPointsMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceWifi.deviceWifiGetAccessPoints",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceWifi.html#v:deviceWifiGetAccessPoints"
})
#endif
foreign import ccall "nm_device_wifi_get_active_access_point" nm_device_wifi_get_active_access_point ::
Ptr DeviceWifi ->
IO (Ptr NM.AccessPoint.AccessPoint)
deviceWifiGetActiveAccessPoint ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceWifi a) =>
a
-> m NM.AccessPoint.AccessPoint
deviceWifiGetActiveAccessPoint :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceWifi a) =>
a -> m AccessPoint
deviceWifiGetActiveAccessPoint a
device = IO AccessPoint -> m AccessPoint
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AccessPoint -> m AccessPoint)
-> IO AccessPoint -> m AccessPoint
forall a b. (a -> b) -> a -> b
$ do
Ptr DeviceWifi
device' <- a -> IO (Ptr DeviceWifi)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
Ptr AccessPoint
result <- Ptr DeviceWifi -> IO (Ptr AccessPoint)
nm_device_wifi_get_active_access_point Ptr DeviceWifi
device'
Text -> Ptr AccessPoint -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"deviceWifiGetActiveAccessPoint" Ptr AccessPoint
result
AccessPoint
result' <- ((ManagedPtr AccessPoint -> AccessPoint)
-> Ptr AccessPoint -> IO AccessPoint
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr AccessPoint -> AccessPoint
NM.AccessPoint.AccessPoint) Ptr AccessPoint
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
AccessPoint -> IO AccessPoint
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AccessPoint
result'
#if defined(ENABLE_OVERLOADING)
data DeviceWifiGetActiveAccessPointMethodInfo
instance (signature ~ (m NM.AccessPoint.AccessPoint), MonadIO m, IsDeviceWifi a) => O.OverloadedMethod DeviceWifiGetActiveAccessPointMethodInfo a signature where
overloadedMethod = deviceWifiGetActiveAccessPoint
instance O.OverloadedMethodInfo DeviceWifiGetActiveAccessPointMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceWifi.deviceWifiGetActiveAccessPoint",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceWifi.html#v:deviceWifiGetActiveAccessPoint"
})
#endif
foreign import ccall "nm_device_wifi_get_bitrate" nm_device_wifi_get_bitrate ::
Ptr DeviceWifi ->
IO Word32
deviceWifiGetBitrate ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceWifi a) =>
a
-> m Word32
deviceWifiGetBitrate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceWifi a) =>
a -> m Word32
deviceWifiGetBitrate a
device = 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 DeviceWifi
device' <- a -> IO (Ptr DeviceWifi)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
Word32
result <- Ptr DeviceWifi -> IO Word32
nm_device_wifi_get_bitrate Ptr DeviceWifi
device'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
#if defined(ENABLE_OVERLOADING)
data DeviceWifiGetBitrateMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsDeviceWifi a) => O.OverloadedMethod DeviceWifiGetBitrateMethodInfo a signature where
overloadedMethod = deviceWifiGetBitrate
instance O.OverloadedMethodInfo DeviceWifiGetBitrateMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceWifi.deviceWifiGetBitrate",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceWifi.html#v:deviceWifiGetBitrate"
})
#endif
foreign import ccall "nm_device_wifi_get_capabilities" nm_device_wifi_get_capabilities ::
Ptr DeviceWifi ->
IO CUInt
deviceWifiGetCapabilities ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceWifi a) =>
a
-> m [NM.Flags.DeviceWifiCapabilities]
deviceWifiGetCapabilities :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceWifi a) =>
a -> m [DeviceWifiCapabilities]
deviceWifiGetCapabilities a
device = IO [DeviceWifiCapabilities] -> m [DeviceWifiCapabilities]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DeviceWifiCapabilities] -> m [DeviceWifiCapabilities])
-> IO [DeviceWifiCapabilities] -> m [DeviceWifiCapabilities]
forall a b. (a -> b) -> a -> b
$ do
Ptr DeviceWifi
device' <- a -> IO (Ptr DeviceWifi)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
CUInt
result <- Ptr DeviceWifi -> IO CUInt
nm_device_wifi_get_capabilities Ptr DeviceWifi
device'
let result' :: [DeviceWifiCapabilities]
result' = CUInt -> [DeviceWifiCapabilities]
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
device
[DeviceWifiCapabilities] -> IO [DeviceWifiCapabilities]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [DeviceWifiCapabilities]
result'
#if defined(ENABLE_OVERLOADING)
data DeviceWifiGetCapabilitiesMethodInfo
instance (signature ~ (m [NM.Flags.DeviceWifiCapabilities]), MonadIO m, IsDeviceWifi a) => O.OverloadedMethod DeviceWifiGetCapabilitiesMethodInfo a signature where
overloadedMethod = deviceWifiGetCapabilities
instance O.OverloadedMethodInfo DeviceWifiGetCapabilitiesMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceWifi.deviceWifiGetCapabilities",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceWifi.html#v:deviceWifiGetCapabilities"
})
#endif
foreign import ccall "nm_device_wifi_get_last_scan" nm_device_wifi_get_last_scan ::
Ptr DeviceWifi ->
IO Int64
deviceWifiGetLastScan ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceWifi a) =>
a
-> m Int64
deviceWifiGetLastScan :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceWifi a) =>
a -> m Int64
deviceWifiGetLastScan a
device = IO Int64 -> m Int64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
Ptr DeviceWifi
device' <- a -> IO (Ptr DeviceWifi)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
Int64
result <- Ptr DeviceWifi -> IO Int64
nm_device_wifi_get_last_scan Ptr DeviceWifi
device'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
Int64 -> IO Int64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result
#if defined(ENABLE_OVERLOADING)
data DeviceWifiGetLastScanMethodInfo
instance (signature ~ (m Int64), MonadIO m, IsDeviceWifi a) => O.OverloadedMethod DeviceWifiGetLastScanMethodInfo a signature where
overloadedMethod = deviceWifiGetLastScan
instance O.OverloadedMethodInfo DeviceWifiGetLastScanMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceWifi.deviceWifiGetLastScan",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceWifi.html#v:deviceWifiGetLastScan"
})
#endif
foreign import ccall "nm_device_wifi_get_mode" nm_device_wifi_get_mode ::
Ptr DeviceWifi ->
IO CUInt
deviceWifiGetMode ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceWifi a) =>
a
-> m NM.Enums.NM80211Mode
deviceWifiGetMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceWifi a) =>
a -> m NM80211Mode
deviceWifiGetMode a
device = IO NM80211Mode -> m NM80211Mode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NM80211Mode -> m NM80211Mode)
-> IO NM80211Mode -> m NM80211Mode
forall a b. (a -> b) -> a -> b
$ do
Ptr DeviceWifi
device' <- a -> IO (Ptr DeviceWifi)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
CUInt
result <- Ptr DeviceWifi -> IO CUInt
nm_device_wifi_get_mode Ptr DeviceWifi
device'
let result' :: NM80211Mode
result' = (Int -> NM80211Mode
forall a. Enum a => Int -> a
toEnum (Int -> NM80211Mode) -> (CUInt -> Int) -> CUInt -> NM80211Mode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
NM80211Mode -> IO NM80211Mode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NM80211Mode
result'
#if defined(ENABLE_OVERLOADING)
data DeviceWifiGetModeMethodInfo
instance (signature ~ (m NM.Enums.NM80211Mode), MonadIO m, IsDeviceWifi a) => O.OverloadedMethod DeviceWifiGetModeMethodInfo a signature where
overloadedMethod = deviceWifiGetMode
instance O.OverloadedMethodInfo DeviceWifiGetModeMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceWifi.deviceWifiGetMode",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceWifi.html#v:deviceWifiGetMode"
})
#endif
foreign import ccall "nm_device_wifi_get_permanent_hw_address" nm_device_wifi_get_permanent_hw_address ::
Ptr DeviceWifi ->
IO CString
deviceWifiGetPermanentHwAddress ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceWifi a) =>
a
-> m T.Text
deviceWifiGetPermanentHwAddress :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceWifi a) =>
a -> m Text
deviceWifiGetPermanentHwAddress a
device = 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 DeviceWifi
device' <- a -> IO (Ptr DeviceWifi)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
CString
result <- Ptr DeviceWifi -> IO CString
nm_device_wifi_get_permanent_hw_address Ptr DeviceWifi
device'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"deviceWifiGetPermanentHwAddress" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data DeviceWifiGetPermanentHwAddressMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDeviceWifi a) => O.OverloadedMethod DeviceWifiGetPermanentHwAddressMethodInfo a signature where
overloadedMethod = deviceWifiGetPermanentHwAddress
instance O.OverloadedMethodInfo DeviceWifiGetPermanentHwAddressMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceWifi.deviceWifiGetPermanentHwAddress",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceWifi.html#v:deviceWifiGetPermanentHwAddress"
})
#endif
foreign import ccall "nm_device_wifi_request_scan" nm_device_wifi_request_scan ::
Ptr DeviceWifi ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO CInt
{-# DEPRECATED deviceWifiRequestScan ["(Since version 1.22)","Use 'GI.NM.Objects.DeviceWifi.deviceWifiRequestScanAsync' or GDBusConnection."] #-}
deviceWifiRequestScan ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceWifi a, Gio.Cancellable.IsCancellable b) =>
a
-> Maybe (b)
-> m ()
deviceWifiRequestScan :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDeviceWifi a, IsCancellable b) =>
a -> Maybe b -> m ()
deviceWifiRequestScan a
device Maybe b
cancellable = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr DeviceWifi
device' <- a -> IO (Ptr DeviceWifi)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
Just b
jCancellable -> do
Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr DeviceWifi -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
nm_device_wifi_request_scan Ptr DeviceWifi
device' Ptr Cancellable
maybeCancellable
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
) (do
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
)
#if defined(ENABLE_OVERLOADING)
data DeviceWifiRequestScanMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsDeviceWifi a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod DeviceWifiRequestScanMethodInfo a signature where
overloadedMethod = deviceWifiRequestScan
instance O.OverloadedMethodInfo DeviceWifiRequestScanMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceWifi.deviceWifiRequestScan",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceWifi.html#v:deviceWifiRequestScan"
})
#endif
foreign import ccall "nm_device_wifi_request_scan_async" nm_device_wifi_request_scan_async ::
Ptr DeviceWifi ->
Ptr Gio.Cancellable.Cancellable ->
FunPtr Gio.Callbacks.C_AsyncReadyCallback ->
Ptr () ->
IO ()
deviceWifiRequestScanAsync ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceWifi a, Gio.Cancellable.IsCancellable b) =>
a
-> Maybe (b)
-> Maybe (Gio.Callbacks.AsyncReadyCallback)
-> m ()
deviceWifiRequestScanAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDeviceWifi a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
deviceWifiRequestScanAsync a
device Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr DeviceWifi
device' <- a -> IO (Ptr DeviceWifi)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
Just b
jCancellable -> do
Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
Just AsyncReadyCallback
jCallback -> do
Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
Ptr DeviceWifi
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_device_wifi_request_scan_async Ptr DeviceWifi
device' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data DeviceWifiRequestScanAsyncMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsDeviceWifi a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod DeviceWifiRequestScanAsyncMethodInfo a signature where
overloadedMethod = deviceWifiRequestScanAsync
instance O.OverloadedMethodInfo DeviceWifiRequestScanAsyncMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceWifi.deviceWifiRequestScanAsync",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceWifi.html#v:deviceWifiRequestScanAsync"
})
#endif
foreign import ccall "nm_device_wifi_request_scan_finish" nm_device_wifi_request_scan_finish ::
Ptr DeviceWifi ->
Ptr Gio.AsyncResult.AsyncResult ->
Ptr (Ptr GError) ->
IO CInt
deviceWifiRequestScanFinish ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceWifi a, Gio.AsyncResult.IsAsyncResult b) =>
a
-> b
-> m ()
deviceWifiRequestScanFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDeviceWifi a, IsAsyncResult b) =>
a -> b -> m ()
deviceWifiRequestScanFinish a
device b
result_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr DeviceWifi
device' <- a -> IO (Ptr DeviceWifi)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr DeviceWifi -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
nm_device_wifi_request_scan_finish Ptr DeviceWifi
device' Ptr AsyncResult
result_'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
) (do
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
)
#if defined(ENABLE_OVERLOADING)
data DeviceWifiRequestScanFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsDeviceWifi a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod DeviceWifiRequestScanFinishMethodInfo a signature where
overloadedMethod = deviceWifiRequestScanFinish
instance O.OverloadedMethodInfo DeviceWifiRequestScanFinishMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceWifi.deviceWifiRequestScanFinish",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceWifi.html#v:deviceWifiRequestScanFinish"
})
#endif
foreign import ccall "nm_device_wifi_request_scan_options" nm_device_wifi_request_scan_options ::
Ptr DeviceWifi ->
Ptr GVariant ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO CInt
{-# DEPRECATED deviceWifiRequestScanOptions ["(Since version 1.22)","Use 'GI.NM.Objects.DeviceWifi.deviceWifiRequestScanOptionsAsync' or GDBusConnection."] #-}
deviceWifiRequestScanOptions ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceWifi a, Gio.Cancellable.IsCancellable b) =>
a
-> GVariant
-> Maybe (b)
-> m ()
deviceWifiRequestScanOptions :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDeviceWifi a, IsCancellable b) =>
a -> GVariant -> Maybe b -> m ()
deviceWifiRequestScanOptions a
device GVariant
options Maybe b
cancellable = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr DeviceWifi
device' <- a -> IO (Ptr DeviceWifi)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
Ptr GVariant
options' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
options
Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
Just b
jCancellable -> do
Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr DeviceWifi
-> Ptr GVariant -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
nm_device_wifi_request_scan_options Ptr DeviceWifi
device' Ptr GVariant
options' Ptr Cancellable
maybeCancellable
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
options
Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
) (do
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
)
#if defined(ENABLE_OVERLOADING)
data DeviceWifiRequestScanOptionsMethodInfo
instance (signature ~ (GVariant -> Maybe (b) -> m ()), MonadIO m, IsDeviceWifi a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod DeviceWifiRequestScanOptionsMethodInfo a signature where
overloadedMethod = deviceWifiRequestScanOptions
instance O.OverloadedMethodInfo DeviceWifiRequestScanOptionsMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceWifi.deviceWifiRequestScanOptions",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceWifi.html#v:deviceWifiRequestScanOptions"
})
#endif
foreign import ccall "nm_device_wifi_request_scan_options_async" nm_device_wifi_request_scan_options_async ::
Ptr DeviceWifi ->
Ptr GVariant ->
Ptr Gio.Cancellable.Cancellable ->
FunPtr Gio.Callbacks.C_AsyncReadyCallback ->
Ptr () ->
IO ()
deviceWifiRequestScanOptionsAsync ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceWifi a, Gio.Cancellable.IsCancellable b) =>
a
-> GVariant
-> Maybe (b)
-> Maybe (Gio.Callbacks.AsyncReadyCallback)
-> m ()
deviceWifiRequestScanOptionsAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDeviceWifi a, IsCancellable b) =>
a -> GVariant -> Maybe b -> Maybe AsyncReadyCallback -> m ()
deviceWifiRequestScanOptionsAsync a
device GVariant
options Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr DeviceWifi
device' <- a -> IO (Ptr DeviceWifi)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
Ptr GVariant
options' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
options
Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
Just b
jCancellable -> do
Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
Just AsyncReadyCallback
jCallback -> do
Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
Ptr DeviceWifi
-> Ptr GVariant
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_device_wifi_request_scan_options_async Ptr DeviceWifi
device' Ptr GVariant
options' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
options
Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data DeviceWifiRequestScanOptionsAsyncMethodInfo
instance (signature ~ (GVariant -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsDeviceWifi a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod DeviceWifiRequestScanOptionsAsyncMethodInfo a signature where
overloadedMethod = deviceWifiRequestScanOptionsAsync
instance O.OverloadedMethodInfo DeviceWifiRequestScanOptionsAsyncMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceWifi.deviceWifiRequestScanOptionsAsync",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceWifi.html#v:deviceWifiRequestScanOptionsAsync"
})
#endif