{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.NM.Objects.RemoteConnection
(
RemoteConnection(..) ,
IsRemoteConnection ,
toRemoteConnection ,
#if defined(ENABLE_OVERLOADING)
ResolveRemoteConnectionMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
RemoteConnectionCommitChangesMethodInfo ,
#endif
remoteConnectionCommitChanges ,
#if defined(ENABLE_OVERLOADING)
RemoteConnectionCommitChangesAsyncMethodInfo,
#endif
remoteConnectionCommitChangesAsync ,
#if defined(ENABLE_OVERLOADING)
RemoteConnectionCommitChangesFinishMethodInfo,
#endif
remoteConnectionCommitChangesFinish ,
#if defined(ENABLE_OVERLOADING)
RemoteConnectionDeleteMethodInfo ,
#endif
remoteConnectionDelete ,
#if defined(ENABLE_OVERLOADING)
RemoteConnectionDeleteAsyncMethodInfo ,
#endif
remoteConnectionDeleteAsync ,
#if defined(ENABLE_OVERLOADING)
RemoteConnectionDeleteFinishMethodInfo ,
#endif
remoteConnectionDeleteFinish ,
#if defined(ENABLE_OVERLOADING)
RemoteConnectionGetFilenameMethodInfo ,
#endif
remoteConnectionGetFilename ,
#if defined(ENABLE_OVERLOADING)
RemoteConnectionGetFlagsMethodInfo ,
#endif
remoteConnectionGetFlags ,
#if defined(ENABLE_OVERLOADING)
RemoteConnectionGetSecretsMethodInfo ,
#endif
remoteConnectionGetSecrets ,
#if defined(ENABLE_OVERLOADING)
RemoteConnectionGetSecretsAsyncMethodInfo,
#endif
remoteConnectionGetSecretsAsync ,
#if defined(ENABLE_OVERLOADING)
RemoteConnectionGetSecretsFinishMethodInfo,
#endif
remoteConnectionGetSecretsFinish ,
#if defined(ENABLE_OVERLOADING)
RemoteConnectionGetUnsavedMethodInfo ,
#endif
remoteConnectionGetUnsaved ,
#if defined(ENABLE_OVERLOADING)
RemoteConnectionGetVersionIdMethodInfo ,
#endif
remoteConnectionGetVersionId ,
#if defined(ENABLE_OVERLOADING)
RemoteConnectionGetVisibleMethodInfo ,
#endif
remoteConnectionGetVisible ,
#if defined(ENABLE_OVERLOADING)
RemoteConnectionSaveMethodInfo ,
#endif
remoteConnectionSave ,
#if defined(ENABLE_OVERLOADING)
RemoteConnectionSaveAsyncMethodInfo ,
#endif
remoteConnectionSaveAsync ,
#if defined(ENABLE_OVERLOADING)
RemoteConnectionSaveFinishMethodInfo ,
#endif
remoteConnectionSaveFinish ,
#if defined(ENABLE_OVERLOADING)
RemoteConnectionUpdate2MethodInfo ,
#endif
remoteConnectionUpdate2 ,
#if defined(ENABLE_OVERLOADING)
RemoteConnectionUpdate2FinishMethodInfo ,
#endif
remoteConnectionUpdate2Finish ,
#if defined(ENABLE_OVERLOADING)
RemoteConnectionFilenamePropertyInfo ,
#endif
getRemoteConnectionFilename ,
#if defined(ENABLE_OVERLOADING)
remoteConnectionFilename ,
#endif
#if defined(ENABLE_OVERLOADING)
RemoteConnectionFlagsPropertyInfo ,
#endif
getRemoteConnectionFlags ,
#if defined(ENABLE_OVERLOADING)
remoteConnectionFlags ,
#endif
#if defined(ENABLE_OVERLOADING)
RemoteConnectionUnsavedPropertyInfo ,
#endif
getRemoteConnectionUnsaved ,
#if defined(ENABLE_OVERLOADING)
remoteConnectionUnsaved ,
#endif
#if defined(ENABLE_OVERLOADING)
RemoteConnectionVersionIdPropertyInfo ,
#endif
getRemoteConnectionVersionId ,
#if defined(ENABLE_OVERLOADING)
remoteConnectionVersionId ,
#endif
#if defined(ENABLE_OVERLOADING)
RemoteConnectionVisiblePropertyInfo ,
#endif
getRemoteConnectionVisible ,
#if defined(ENABLE_OVERLOADING)
remoteConnectionVisible ,
#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.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.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.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.Flags as NM.Flags
import {-# SOURCE #-} qualified GI.NM.Interfaces.Connection as NM.Connection
import {-# SOURCE #-} qualified GI.NM.Objects.Object as NM.Object
#endif
newtype RemoteConnection = RemoteConnection (SP.ManagedPtr RemoteConnection)
deriving (RemoteConnection -> RemoteConnection -> Bool
(RemoteConnection -> RemoteConnection -> Bool)
-> (RemoteConnection -> RemoteConnection -> Bool)
-> Eq RemoteConnection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoteConnection -> RemoteConnection -> Bool
== :: RemoteConnection -> RemoteConnection -> Bool
$c/= :: RemoteConnection -> RemoteConnection -> Bool
/= :: RemoteConnection -> RemoteConnection -> Bool
Eq)
instance SP.ManagedPtrNewtype RemoteConnection where
toManagedPtr :: RemoteConnection -> ManagedPtr RemoteConnection
toManagedPtr (RemoteConnection ManagedPtr RemoteConnection
p) = ManagedPtr RemoteConnection
p
foreign import ccall "nm_remote_connection_get_type"
c_nm_remote_connection_get_type :: IO B.Types.GType
instance B.Types.TypedObject RemoteConnection where
glibType :: IO GType
glibType = IO GType
c_nm_remote_connection_get_type
instance B.Types.GObject RemoteConnection
class (SP.GObject o, O.IsDescendantOf RemoteConnection o) => IsRemoteConnection o
instance (SP.GObject o, O.IsDescendantOf RemoteConnection o) => IsRemoteConnection o
instance O.HasParentTypes RemoteConnection
type instance O.ParentTypes RemoteConnection = '[NM.Object.Object, GObject.Object.Object, NM.Connection.Connection]
toRemoteConnection :: (MIO.MonadIO m, IsRemoteConnection o) => o -> m RemoteConnection
toRemoteConnection :: forall (m :: * -> *) o.
(MonadIO m, IsRemoteConnection o) =>
o -> m RemoteConnection
toRemoteConnection = IO RemoteConnection -> m RemoteConnection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO RemoteConnection -> m RemoteConnection)
-> (o -> IO RemoteConnection) -> o -> m RemoteConnection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr RemoteConnection -> RemoteConnection)
-> o -> IO RemoteConnection
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr RemoteConnection -> RemoteConnection
RemoteConnection
instance B.GValue.IsGValue (Maybe RemoteConnection) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_nm_remote_connection_get_type
gvalueSet_ :: Ptr GValue -> Maybe RemoteConnection -> IO ()
gvalueSet_ Ptr GValue
gv Maybe RemoteConnection
P.Nothing = Ptr GValue -> Ptr RemoteConnection -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr RemoteConnection
forall a. Ptr a
FP.nullPtr :: FP.Ptr RemoteConnection)
gvalueSet_ Ptr GValue
gv (P.Just RemoteConnection
obj) = RemoteConnection -> (Ptr RemoteConnection -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr RemoteConnection
obj (Ptr GValue -> Ptr RemoteConnection -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe RemoteConnection)
gvalueGet_ Ptr GValue
gv = do
Ptr RemoteConnection
ptr <- Ptr GValue -> IO (Ptr RemoteConnection)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr RemoteConnection)
if Ptr RemoteConnection
ptr Ptr RemoteConnection -> Ptr RemoteConnection -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr RemoteConnection
forall a. Ptr a
FP.nullPtr
then RemoteConnection -> Maybe RemoteConnection
forall a. a -> Maybe a
P.Just (RemoteConnection -> Maybe RemoteConnection)
-> IO RemoteConnection -> IO (Maybe RemoteConnection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr RemoteConnection -> RemoteConnection)
-> Ptr RemoteConnection -> IO RemoteConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr RemoteConnection -> RemoteConnection
RemoteConnection Ptr RemoteConnection
ptr
else Maybe RemoteConnection -> IO (Maybe RemoteConnection)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RemoteConnection
forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveRemoteConnectionMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveRemoteConnectionMethod "addSetting" o = NM.Connection.ConnectionAddSettingMethodInfo
ResolveRemoteConnectionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveRemoteConnectionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveRemoteConnectionMethod "clearSecrets" o = NM.Connection.ConnectionClearSecretsMethodInfo
ResolveRemoteConnectionMethod "clearSecretsWithFlags" o = NM.Connection.ConnectionClearSecretsWithFlagsMethodInfo
ResolveRemoteConnectionMethod "clearSettings" o = NM.Connection.ConnectionClearSettingsMethodInfo
ResolveRemoteConnectionMethod "commitChanges" o = RemoteConnectionCommitChangesMethodInfo
ResolveRemoteConnectionMethod "commitChangesAsync" o = RemoteConnectionCommitChangesAsyncMethodInfo
ResolveRemoteConnectionMethod "commitChangesFinish" o = RemoteConnectionCommitChangesFinishMethodInfo
ResolveRemoteConnectionMethod "compare" o = NM.Connection.ConnectionCompareMethodInfo
ResolveRemoteConnectionMethod "delete" o = RemoteConnectionDeleteMethodInfo
ResolveRemoteConnectionMethod "deleteAsync" o = RemoteConnectionDeleteAsyncMethodInfo
ResolveRemoteConnectionMethod "deleteFinish" o = RemoteConnectionDeleteFinishMethodInfo
ResolveRemoteConnectionMethod "dump" o = NM.Connection.ConnectionDumpMethodInfo
ResolveRemoteConnectionMethod "forEachSettingValue" o = NM.Connection.ConnectionForEachSettingValueMethodInfo
ResolveRemoteConnectionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveRemoteConnectionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveRemoteConnectionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveRemoteConnectionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveRemoteConnectionMethod "isType" o = NM.Connection.ConnectionIsTypeMethodInfo
ResolveRemoteConnectionMethod "isVirtual" o = NM.Connection.ConnectionIsVirtualMethodInfo
ResolveRemoteConnectionMethod "needSecrets" o = NM.Connection.ConnectionNeedSecretsMethodInfo
ResolveRemoteConnectionMethod "normalize" o = NM.Connection.ConnectionNormalizeMethodInfo
ResolveRemoteConnectionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveRemoteConnectionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveRemoteConnectionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveRemoteConnectionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveRemoteConnectionMethod "removeSetting" o = NM.Connection.ConnectionRemoveSettingMethodInfo
ResolveRemoteConnectionMethod "replaceSettings" o = NM.Connection.ConnectionReplaceSettingsMethodInfo
ResolveRemoteConnectionMethod "replaceSettingsFromConnection" o = NM.Connection.ConnectionReplaceSettingsFromConnectionMethodInfo
ResolveRemoteConnectionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveRemoteConnectionMethod "save" o = RemoteConnectionSaveMethodInfo
ResolveRemoteConnectionMethod "saveAsync" o = RemoteConnectionSaveAsyncMethodInfo
ResolveRemoteConnectionMethod "saveFinish" o = RemoteConnectionSaveFinishMethodInfo
ResolveRemoteConnectionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveRemoteConnectionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveRemoteConnectionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveRemoteConnectionMethod "toDbus" o = NM.Connection.ConnectionToDbusMethodInfo
ResolveRemoteConnectionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveRemoteConnectionMethod "update2" o = RemoteConnectionUpdate2MethodInfo
ResolveRemoteConnectionMethod "update2Finish" o = RemoteConnectionUpdate2FinishMethodInfo
ResolveRemoteConnectionMethod "updateSecrets" o = NM.Connection.ConnectionUpdateSecretsMethodInfo
ResolveRemoteConnectionMethod "verify" o = NM.Connection.ConnectionVerifyMethodInfo
ResolveRemoteConnectionMethod "verifySecrets" o = NM.Connection.ConnectionVerifySecretsMethodInfo
ResolveRemoteConnectionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveRemoteConnectionMethod "getClient" o = NM.Object.ObjectGetClientMethodInfo
ResolveRemoteConnectionMethod "getConnectionType" o = NM.Connection.ConnectionGetConnectionTypeMethodInfo
ResolveRemoteConnectionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveRemoteConnectionMethod "getFilename" o = RemoteConnectionGetFilenameMethodInfo
ResolveRemoteConnectionMethod "getFlags" o = RemoteConnectionGetFlagsMethodInfo
ResolveRemoteConnectionMethod "getId" o = NM.Connection.ConnectionGetIdMethodInfo
ResolveRemoteConnectionMethod "getInterfaceName" o = NM.Connection.ConnectionGetInterfaceNameMethodInfo
ResolveRemoteConnectionMethod "getPath" o = NM.Object.ObjectGetPathMethodInfo
ResolveRemoteConnectionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveRemoteConnectionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveRemoteConnectionMethod "getSecrets" o = RemoteConnectionGetSecretsMethodInfo
ResolveRemoteConnectionMethod "getSecretsAsync" o = RemoteConnectionGetSecretsAsyncMethodInfo
ResolveRemoteConnectionMethod "getSecretsFinish" o = RemoteConnectionGetSecretsFinishMethodInfo
ResolveRemoteConnectionMethod "getSetting" o = NM.Connection.ConnectionGetSettingMethodInfo
ResolveRemoteConnectionMethod "getSetting8021x" o = NM.Connection.ConnectionGetSetting8021xMethodInfo
ResolveRemoteConnectionMethod "getSettingAdsl" o = NM.Connection.ConnectionGetSettingAdslMethodInfo
ResolveRemoteConnectionMethod "getSettingBluetooth" o = NM.Connection.ConnectionGetSettingBluetoothMethodInfo
ResolveRemoteConnectionMethod "getSettingBond" o = NM.Connection.ConnectionGetSettingBondMethodInfo
ResolveRemoteConnectionMethod "getSettingBridge" o = NM.Connection.ConnectionGetSettingBridgeMethodInfo
ResolveRemoteConnectionMethod "getSettingBridgePort" o = NM.Connection.ConnectionGetSettingBridgePortMethodInfo
ResolveRemoteConnectionMethod "getSettingByName" o = NM.Connection.ConnectionGetSettingByNameMethodInfo
ResolveRemoteConnectionMethod "getSettingCdma" o = NM.Connection.ConnectionGetSettingCdmaMethodInfo
ResolveRemoteConnectionMethod "getSettingConnection" o = NM.Connection.ConnectionGetSettingConnectionMethodInfo
ResolveRemoteConnectionMethod "getSettingDcb" o = NM.Connection.ConnectionGetSettingDcbMethodInfo
ResolveRemoteConnectionMethod "getSettingDummy" o = NM.Connection.ConnectionGetSettingDummyMethodInfo
ResolveRemoteConnectionMethod "getSettingGeneric" o = NM.Connection.ConnectionGetSettingGenericMethodInfo
ResolveRemoteConnectionMethod "getSettingGsm" o = NM.Connection.ConnectionGetSettingGsmMethodInfo
ResolveRemoteConnectionMethod "getSettingInfiniband" o = NM.Connection.ConnectionGetSettingInfinibandMethodInfo
ResolveRemoteConnectionMethod "getSettingIp4Config" o = NM.Connection.ConnectionGetSettingIp4ConfigMethodInfo
ResolveRemoteConnectionMethod "getSettingIp6Config" o = NM.Connection.ConnectionGetSettingIp6ConfigMethodInfo
ResolveRemoteConnectionMethod "getSettingIpTunnel" o = NM.Connection.ConnectionGetSettingIpTunnelMethodInfo
ResolveRemoteConnectionMethod "getSettingMacsec" o = NM.Connection.ConnectionGetSettingMacsecMethodInfo
ResolveRemoteConnectionMethod "getSettingMacvlan" o = NM.Connection.ConnectionGetSettingMacvlanMethodInfo
ResolveRemoteConnectionMethod "getSettingOlpcMesh" o = NM.Connection.ConnectionGetSettingOlpcMeshMethodInfo
ResolveRemoteConnectionMethod "getSettingOvsBridge" o = NM.Connection.ConnectionGetSettingOvsBridgeMethodInfo
ResolveRemoteConnectionMethod "getSettingOvsInterface" o = NM.Connection.ConnectionGetSettingOvsInterfaceMethodInfo
ResolveRemoteConnectionMethod "getSettingOvsPatch" o = NM.Connection.ConnectionGetSettingOvsPatchMethodInfo
ResolveRemoteConnectionMethod "getSettingOvsPort" o = NM.Connection.ConnectionGetSettingOvsPortMethodInfo
ResolveRemoteConnectionMethod "getSettingPpp" o = NM.Connection.ConnectionGetSettingPppMethodInfo
ResolveRemoteConnectionMethod "getSettingPppoe" o = NM.Connection.ConnectionGetSettingPppoeMethodInfo
ResolveRemoteConnectionMethod "getSettingProxy" o = NM.Connection.ConnectionGetSettingProxyMethodInfo
ResolveRemoteConnectionMethod "getSettingSerial" o = NM.Connection.ConnectionGetSettingSerialMethodInfo
ResolveRemoteConnectionMethod "getSettingTcConfig" o = NM.Connection.ConnectionGetSettingTcConfigMethodInfo
ResolveRemoteConnectionMethod "getSettingTeam" o = NM.Connection.ConnectionGetSettingTeamMethodInfo
ResolveRemoteConnectionMethod "getSettingTeamPort" o = NM.Connection.ConnectionGetSettingTeamPortMethodInfo
ResolveRemoteConnectionMethod "getSettingTun" o = NM.Connection.ConnectionGetSettingTunMethodInfo
ResolveRemoteConnectionMethod "getSettingVlan" o = NM.Connection.ConnectionGetSettingVlanMethodInfo
ResolveRemoteConnectionMethod "getSettingVpn" o = NM.Connection.ConnectionGetSettingVpnMethodInfo
ResolveRemoteConnectionMethod "getSettingVxlan" o = NM.Connection.ConnectionGetSettingVxlanMethodInfo
ResolveRemoteConnectionMethod "getSettingWimax" o = NM.Connection.ConnectionGetSettingWimaxMethodInfo
ResolveRemoteConnectionMethod "getSettingWired" o = NM.Connection.ConnectionGetSettingWiredMethodInfo
ResolveRemoteConnectionMethod "getSettingWireless" o = NM.Connection.ConnectionGetSettingWirelessMethodInfo
ResolveRemoteConnectionMethod "getSettingWirelessSecurity" o = NM.Connection.ConnectionGetSettingWirelessSecurityMethodInfo
ResolveRemoteConnectionMethod "getSettings" o = NM.Connection.ConnectionGetSettingsMethodInfo
ResolveRemoteConnectionMethod "getUnsaved" o = RemoteConnectionGetUnsavedMethodInfo
ResolveRemoteConnectionMethod "getUuid" o = NM.Connection.ConnectionGetUuidMethodInfo
ResolveRemoteConnectionMethod "getVersionId" o = RemoteConnectionGetVersionIdMethodInfo
ResolveRemoteConnectionMethod "getVirtualDeviceDescription" o = NM.Connection.ConnectionGetVirtualDeviceDescriptionMethodInfo
ResolveRemoteConnectionMethod "getVisible" o = RemoteConnectionGetVisibleMethodInfo
ResolveRemoteConnectionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveRemoteConnectionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveRemoteConnectionMethod "setPath" o = NM.Connection.ConnectionSetPathMethodInfo
ResolveRemoteConnectionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveRemoteConnectionMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveRemoteConnectionMethod t RemoteConnection, O.OverloadedMethod info RemoteConnection p) => OL.IsLabel t (RemoteConnection -> 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 ~ ResolveRemoteConnectionMethod t RemoteConnection, O.OverloadedMethod info RemoteConnection p, R.HasField t RemoteConnection p) => R.HasField t RemoteConnection p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveRemoteConnectionMethod t RemoteConnection, O.OverloadedMethodInfo info RemoteConnection) => OL.IsLabel t (O.MethodProxy info RemoteConnection) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
getRemoteConnectionFilename :: (MonadIO m, IsRemoteConnection o) => o -> m T.Text
getRemoteConnectionFilename :: forall (m :: * -> *) o.
(MonadIO m, IsRemoteConnection o) =>
o -> m Text
getRemoteConnectionFilename 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
"getRemoteConnectionFilename" (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
"filename"
#if defined(ENABLE_OVERLOADING)
data RemoteConnectionFilenamePropertyInfo
instance AttrInfo RemoteConnectionFilenamePropertyInfo where
type AttrAllowedOps RemoteConnectionFilenamePropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint RemoteConnectionFilenamePropertyInfo = IsRemoteConnection
type AttrSetTypeConstraint RemoteConnectionFilenamePropertyInfo = (~) ()
type AttrTransferTypeConstraint RemoteConnectionFilenamePropertyInfo = (~) ()
type AttrTransferType RemoteConnectionFilenamePropertyInfo = ()
type AttrGetType RemoteConnectionFilenamePropertyInfo = T.Text
type AttrLabel RemoteConnectionFilenamePropertyInfo = "filename"
type AttrOrigin RemoteConnectionFilenamePropertyInfo = RemoteConnection
attrGet = getRemoteConnectionFilename
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.filename"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#g:attr:filename"
})
#endif
getRemoteConnectionFlags :: (MonadIO m, IsRemoteConnection o) => o -> m Word32
getRemoteConnectionFlags :: forall (m :: * -> *) o.
(MonadIO m, IsRemoteConnection o) =>
o -> m Word32
getRemoteConnectionFlags 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
"flags"
#if defined(ENABLE_OVERLOADING)
data RemoteConnectionFlagsPropertyInfo
instance AttrInfo RemoteConnectionFlagsPropertyInfo where
type AttrAllowedOps RemoteConnectionFlagsPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint RemoteConnectionFlagsPropertyInfo = IsRemoteConnection
type AttrSetTypeConstraint RemoteConnectionFlagsPropertyInfo = (~) ()
type AttrTransferTypeConstraint RemoteConnectionFlagsPropertyInfo = (~) ()
type AttrTransferType RemoteConnectionFlagsPropertyInfo = ()
type AttrGetType RemoteConnectionFlagsPropertyInfo = Word32
type AttrLabel RemoteConnectionFlagsPropertyInfo = "flags"
type AttrOrigin RemoteConnectionFlagsPropertyInfo = RemoteConnection
attrGet = getRemoteConnectionFlags
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.flags"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#g:attr:flags"
})
#endif
getRemoteConnectionUnsaved :: (MonadIO m, IsRemoteConnection o) => o -> m Bool
getRemoteConnectionUnsaved :: forall (m :: * -> *) o.
(MonadIO m, IsRemoteConnection o) =>
o -> m Bool
getRemoteConnectionUnsaved o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"unsaved"
#if defined(ENABLE_OVERLOADING)
data RemoteConnectionUnsavedPropertyInfo
instance AttrInfo RemoteConnectionUnsavedPropertyInfo where
type AttrAllowedOps RemoteConnectionUnsavedPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint RemoteConnectionUnsavedPropertyInfo = IsRemoteConnection
type AttrSetTypeConstraint RemoteConnectionUnsavedPropertyInfo = (~) ()
type AttrTransferTypeConstraint RemoteConnectionUnsavedPropertyInfo = (~) ()
type AttrTransferType RemoteConnectionUnsavedPropertyInfo = ()
type AttrGetType RemoteConnectionUnsavedPropertyInfo = Bool
type AttrLabel RemoteConnectionUnsavedPropertyInfo = "unsaved"
type AttrOrigin RemoteConnectionUnsavedPropertyInfo = RemoteConnection
attrGet = getRemoteConnectionUnsaved
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.unsaved"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#g:attr:unsaved"
})
#endif
getRemoteConnectionVersionId :: (MonadIO m, IsRemoteConnection o) => o -> m Word64
getRemoteConnectionVersionId :: forall (m :: * -> *) o.
(MonadIO m, IsRemoteConnection o) =>
o -> m Word64
getRemoteConnectionVersionId o
obj = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word64
forall a. GObject a => a -> String -> IO Word64
B.Properties.getObjectPropertyUInt64 o
obj String
"version-id"
#if defined(ENABLE_OVERLOADING)
data RemoteConnectionVersionIdPropertyInfo
instance AttrInfo RemoteConnectionVersionIdPropertyInfo where
type AttrAllowedOps RemoteConnectionVersionIdPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint RemoteConnectionVersionIdPropertyInfo = IsRemoteConnection
type AttrSetTypeConstraint RemoteConnectionVersionIdPropertyInfo = (~) ()
type AttrTransferTypeConstraint RemoteConnectionVersionIdPropertyInfo = (~) ()
type AttrTransferType RemoteConnectionVersionIdPropertyInfo = ()
type AttrGetType RemoteConnectionVersionIdPropertyInfo = Word64
type AttrLabel RemoteConnectionVersionIdPropertyInfo = "version-id"
type AttrOrigin RemoteConnectionVersionIdPropertyInfo = RemoteConnection
attrGet = getRemoteConnectionVersionId
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.versionId"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#g:attr:versionId"
})
#endif
getRemoteConnectionVisible :: (MonadIO m, IsRemoteConnection o) => o -> m Bool
getRemoteConnectionVisible :: forall (m :: * -> *) o.
(MonadIO m, IsRemoteConnection o) =>
o -> m Bool
getRemoteConnectionVisible o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"visible"
#if defined(ENABLE_OVERLOADING)
data RemoteConnectionVisiblePropertyInfo
instance AttrInfo RemoteConnectionVisiblePropertyInfo where
type AttrAllowedOps RemoteConnectionVisiblePropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint RemoteConnectionVisiblePropertyInfo = IsRemoteConnection
type AttrSetTypeConstraint RemoteConnectionVisiblePropertyInfo = (~) ()
type AttrTransferTypeConstraint RemoteConnectionVisiblePropertyInfo = (~) ()
type AttrTransferType RemoteConnectionVisiblePropertyInfo = ()
type AttrGetType RemoteConnectionVisiblePropertyInfo = Bool
type AttrLabel RemoteConnectionVisiblePropertyInfo = "visible"
type AttrOrigin RemoteConnectionVisiblePropertyInfo = RemoteConnection
attrGet = getRemoteConnectionVisible
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.visible"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#g:attr:visible"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList RemoteConnection
type instance O.AttributeList RemoteConnection = RemoteConnectionAttributeList
type RemoteConnectionAttributeList = ('[ '("client", NM.Object.ObjectClientPropertyInfo), '("filename", RemoteConnectionFilenamePropertyInfo), '("flags", RemoteConnectionFlagsPropertyInfo), '("path", NM.Object.ObjectPathPropertyInfo), '("unsaved", RemoteConnectionUnsavedPropertyInfo), '("versionId", RemoteConnectionVersionIdPropertyInfo), '("visible", RemoteConnectionVisiblePropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
remoteConnectionFilename :: AttrLabelProxy "filename"
remoteConnectionFilename = AttrLabelProxy
remoteConnectionFlags :: AttrLabelProxy "flags"
remoteConnectionFlags = AttrLabelProxy
remoteConnectionUnsaved :: AttrLabelProxy "unsaved"
remoteConnectionUnsaved = AttrLabelProxy
remoteConnectionVersionId :: AttrLabelProxy "versionId"
remoteConnectionVersionId = AttrLabelProxy
remoteConnectionVisible :: AttrLabelProxy "visible"
remoteConnectionVisible = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList RemoteConnection = RemoteConnectionSignalList
type RemoteConnectionSignalList = ('[ '("changed", NM.Connection.ConnectionChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("secretsCleared", NM.Connection.ConnectionSecretsClearedSignalInfo), '("secretsUpdated", NM.Connection.ConnectionSecretsUpdatedSignalInfo)] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "nm_remote_connection_commit_changes" nm_remote_connection_commit_changes ::
Ptr RemoteConnection ->
CInt ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO CInt
{-# DEPRECATED remoteConnectionCommitChanges ["(Since version 1.22)","Use 'GI.NM.Objects.RemoteConnection.remoteConnectionCommitChangesAsync' or GDBusConnection."] #-}
remoteConnectionCommitChanges ::
(B.CallStack.HasCallStack, MonadIO m, IsRemoteConnection a, Gio.Cancellable.IsCancellable b) =>
a
-> Bool
-> Maybe (b)
-> m ()
remoteConnectionCommitChanges :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsRemoteConnection a, IsCancellable b) =>
a -> Bool -> Maybe b -> m ()
remoteConnectionCommitChanges a
connection Bool
saveToDisk 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 RemoteConnection
connection' <- a -> IO (Ptr RemoteConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
let saveToDisk' :: CInt
saveToDisk' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
saveToDisk
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 RemoteConnection
-> CInt -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
nm_remote_connection_commit_changes Ptr RemoteConnection
connection' CInt
saveToDisk' Ptr Cancellable
maybeCancellable
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
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 RemoteConnectionCommitChangesMethodInfo
instance (signature ~ (Bool -> Maybe (b) -> m ()), MonadIO m, IsRemoteConnection a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod RemoteConnectionCommitChangesMethodInfo a signature where
overloadedMethod = remoteConnectionCommitChanges
instance O.OverloadedMethodInfo RemoteConnectionCommitChangesMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.remoteConnectionCommitChanges",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#v:remoteConnectionCommitChanges"
})
#endif
foreign import ccall "nm_remote_connection_commit_changes_async" nm_remote_connection_commit_changes_async ::
Ptr RemoteConnection ->
CInt ->
Ptr Gio.Cancellable.Cancellable ->
FunPtr Gio.Callbacks.C_AsyncReadyCallback ->
Ptr () ->
IO ()
remoteConnectionCommitChangesAsync ::
(B.CallStack.HasCallStack, MonadIO m, IsRemoteConnection a, Gio.Cancellable.IsCancellable b) =>
a
-> Bool
-> Maybe (b)
-> Maybe (Gio.Callbacks.AsyncReadyCallback)
-> m ()
remoteConnectionCommitChangesAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsRemoteConnection a, IsCancellable b) =>
a -> Bool -> Maybe b -> Maybe AsyncReadyCallback -> m ()
remoteConnectionCommitChangesAsync a
connection Bool
saveToDisk 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 RemoteConnection
connection' <- a -> IO (Ptr RemoteConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
let saveToDisk' :: CInt
saveToDisk' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
saveToDisk
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 RemoteConnection
-> CInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_remote_connection_commit_changes_async Ptr RemoteConnection
connection' CInt
saveToDisk' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
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 RemoteConnectionCommitChangesAsyncMethodInfo
instance (signature ~ (Bool -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsRemoteConnection a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod RemoteConnectionCommitChangesAsyncMethodInfo a signature where
overloadedMethod = remoteConnectionCommitChangesAsync
instance O.OverloadedMethodInfo RemoteConnectionCommitChangesAsyncMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.remoteConnectionCommitChangesAsync",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#v:remoteConnectionCommitChangesAsync"
})
#endif
foreign import ccall "nm_remote_connection_commit_changes_finish" nm_remote_connection_commit_changes_finish ::
Ptr RemoteConnection ->
Ptr Gio.AsyncResult.AsyncResult ->
Ptr (Ptr GError) ->
IO CInt
remoteConnectionCommitChangesFinish ::
(B.CallStack.HasCallStack, MonadIO m, IsRemoteConnection a, Gio.AsyncResult.IsAsyncResult b) =>
a
-> b
-> m ()
remoteConnectionCommitChangesFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsRemoteConnection a, IsAsyncResult b) =>
a -> b -> m ()
remoteConnectionCommitChangesFinish a
connection 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 RemoteConnection
connection' <- a -> IO (Ptr RemoteConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
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 RemoteConnection
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
nm_remote_connection_commit_changes_finish Ptr RemoteConnection
connection' Ptr AsyncResult
result_'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
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 RemoteConnectionCommitChangesFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsRemoteConnection a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod RemoteConnectionCommitChangesFinishMethodInfo a signature where
overloadedMethod = remoteConnectionCommitChangesFinish
instance O.OverloadedMethodInfo RemoteConnectionCommitChangesFinishMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.remoteConnectionCommitChangesFinish",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#v:remoteConnectionCommitChangesFinish"
})
#endif
foreign import ccall "nm_remote_connection_delete" nm_remote_connection_delete ::
Ptr RemoteConnection ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO CInt
{-# DEPRECATED remoteConnectionDelete ["(Since version 1.22)","Use 'GI.NM.Objects.RemoteConnection.remoteConnectionDeleteAsync' or GDBusConnection."] #-}
remoteConnectionDelete ::
(B.CallStack.HasCallStack, MonadIO m, IsRemoteConnection a, Gio.Cancellable.IsCancellable b) =>
a
-> Maybe (b)
-> m ()
remoteConnectionDelete :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsRemoteConnection a, IsCancellable b) =>
a -> Maybe b -> m ()
remoteConnectionDelete a
connection 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 RemoteConnection
connection' <- a -> IO (Ptr RemoteConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
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 RemoteConnection
-> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
nm_remote_connection_delete Ptr RemoteConnection
connection' Ptr Cancellable
maybeCancellable
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
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 RemoteConnectionDeleteMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsRemoteConnection a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod RemoteConnectionDeleteMethodInfo a signature where
overloadedMethod = remoteConnectionDelete
instance O.OverloadedMethodInfo RemoteConnectionDeleteMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.remoteConnectionDelete",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#v:remoteConnectionDelete"
})
#endif
foreign import ccall "nm_remote_connection_delete_async" nm_remote_connection_delete_async ::
Ptr RemoteConnection ->
Ptr Gio.Cancellable.Cancellable ->
FunPtr Gio.Callbacks.C_AsyncReadyCallback ->
Ptr () ->
IO ()
remoteConnectionDeleteAsync ::
(B.CallStack.HasCallStack, MonadIO m, IsRemoteConnection a, Gio.Cancellable.IsCancellable b) =>
a
-> Maybe (b)
-> Maybe (Gio.Callbacks.AsyncReadyCallback)
-> m ()
remoteConnectionDeleteAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsRemoteConnection a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
remoteConnectionDeleteAsync a
connection 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 RemoteConnection
connection' <- a -> IO (Ptr RemoteConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
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 RemoteConnection
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_remote_connection_delete_async Ptr RemoteConnection
connection' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
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 RemoteConnectionDeleteAsyncMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsRemoteConnection a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod RemoteConnectionDeleteAsyncMethodInfo a signature where
overloadedMethod = remoteConnectionDeleteAsync
instance O.OverloadedMethodInfo RemoteConnectionDeleteAsyncMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.remoteConnectionDeleteAsync",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#v:remoteConnectionDeleteAsync"
})
#endif
foreign import ccall "nm_remote_connection_delete_finish" nm_remote_connection_delete_finish ::
Ptr RemoteConnection ->
Ptr Gio.AsyncResult.AsyncResult ->
Ptr (Ptr GError) ->
IO CInt
remoteConnectionDeleteFinish ::
(B.CallStack.HasCallStack, MonadIO m, IsRemoteConnection a, Gio.AsyncResult.IsAsyncResult b) =>
a
-> b
-> m ()
remoteConnectionDeleteFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsRemoteConnection a, IsAsyncResult b) =>
a -> b -> m ()
remoteConnectionDeleteFinish a
connection 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 RemoteConnection
connection' <- a -> IO (Ptr RemoteConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
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 RemoteConnection
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
nm_remote_connection_delete_finish Ptr RemoteConnection
connection' Ptr AsyncResult
result_'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
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 RemoteConnectionDeleteFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsRemoteConnection a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod RemoteConnectionDeleteFinishMethodInfo a signature where
overloadedMethod = remoteConnectionDeleteFinish
instance O.OverloadedMethodInfo RemoteConnectionDeleteFinishMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.remoteConnectionDeleteFinish",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#v:remoteConnectionDeleteFinish"
})
#endif
foreign import ccall "nm_remote_connection_get_filename" nm_remote_connection_get_filename ::
Ptr RemoteConnection ->
IO CString
remoteConnectionGetFilename ::
(B.CallStack.HasCallStack, MonadIO m, IsRemoteConnection a) =>
a
-> m T.Text
remoteConnectionGetFilename :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRemoteConnection a) =>
a -> m Text
remoteConnectionGetFilename a
connection = 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 RemoteConnection
connection' <- a -> IO (Ptr RemoteConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
CString
result <- Ptr RemoteConnection -> IO CString
nm_remote_connection_get_filename Ptr RemoteConnection
connection'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"remoteConnectionGetFilename" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data RemoteConnectionGetFilenameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsRemoteConnection a) => O.OverloadedMethod RemoteConnectionGetFilenameMethodInfo a signature where
overloadedMethod = remoteConnectionGetFilename
instance O.OverloadedMethodInfo RemoteConnectionGetFilenameMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.remoteConnectionGetFilename",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#v:remoteConnectionGetFilename"
})
#endif
foreign import ccall "nm_remote_connection_get_flags" nm_remote_connection_get_flags ::
Ptr RemoteConnection ->
IO CUInt
remoteConnectionGetFlags ::
(B.CallStack.HasCallStack, MonadIO m, IsRemoteConnection a) =>
a
-> m [NM.Flags.SettingsConnectionFlags]
remoteConnectionGetFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRemoteConnection a) =>
a -> m [SettingsConnectionFlags]
remoteConnectionGetFlags a
connection = IO [SettingsConnectionFlags] -> m [SettingsConnectionFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SettingsConnectionFlags] -> m [SettingsConnectionFlags])
-> IO [SettingsConnectionFlags] -> m [SettingsConnectionFlags]
forall a b. (a -> b) -> a -> b
$ do
Ptr RemoteConnection
connection' <- a -> IO (Ptr RemoteConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
CUInt
result <- Ptr RemoteConnection -> IO CUInt
nm_remote_connection_get_flags Ptr RemoteConnection
connection'
let result' :: [SettingsConnectionFlags]
result' = CUInt -> [SettingsConnectionFlags]
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
connection
[SettingsConnectionFlags] -> IO [SettingsConnectionFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [SettingsConnectionFlags]
result'
#if defined(ENABLE_OVERLOADING)
data RemoteConnectionGetFlagsMethodInfo
instance (signature ~ (m [NM.Flags.SettingsConnectionFlags]), MonadIO m, IsRemoteConnection a) => O.OverloadedMethod RemoteConnectionGetFlagsMethodInfo a signature where
overloadedMethod = remoteConnectionGetFlags
instance O.OverloadedMethodInfo RemoteConnectionGetFlagsMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.remoteConnectionGetFlags",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#v:remoteConnectionGetFlags"
})
#endif
foreign import ccall "nm_remote_connection_get_secrets" nm_remote_connection_get_secrets ::
Ptr RemoteConnection ->
CString ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO (Ptr GVariant)
remoteConnectionGetSecrets ::
(B.CallStack.HasCallStack, MonadIO m, IsRemoteConnection a, Gio.Cancellable.IsCancellable b) =>
a
-> T.Text
-> Maybe (b)
-> m GVariant
remoteConnectionGetSecrets :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsRemoteConnection a, IsCancellable b) =>
a -> Text -> Maybe b -> m GVariant
remoteConnectionGetSecrets a
connection Text
settingName Maybe b
cancellable = IO GVariant -> m GVariant
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
Ptr RemoteConnection
connection' <- a -> IO (Ptr RemoteConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
CString
settingName' <- Text -> IO CString
textToCString Text
settingName
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 GVariant -> IO () -> IO GVariant
forall a b. IO a -> IO b -> IO a
onException (do
Ptr GVariant
result <- (Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant))
-> (Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant)
forall a b. (a -> b) -> a -> b
$ Ptr RemoteConnection
-> CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr GVariant)
nm_remote_connection_get_secrets Ptr RemoteConnection
connection' CString
settingName' Ptr Cancellable
maybeCancellable
Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"remoteConnectionGetSecrets" Ptr GVariant
result
GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
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
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
settingName'
GVariant -> IO GVariant
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result'
) (do
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
settingName'
)
#if defined(ENABLE_OVERLOADING)
data RemoteConnectionGetSecretsMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> m GVariant), MonadIO m, IsRemoteConnection a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod RemoteConnectionGetSecretsMethodInfo a signature where
overloadedMethod = remoteConnectionGetSecrets
instance O.OverloadedMethodInfo RemoteConnectionGetSecretsMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.remoteConnectionGetSecrets",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#v:remoteConnectionGetSecrets"
})
#endif
foreign import ccall "nm_remote_connection_get_secrets_async" nm_remote_connection_get_secrets_async ::
Ptr RemoteConnection ->
CString ->
Ptr Gio.Cancellable.Cancellable ->
FunPtr Gio.Callbacks.C_AsyncReadyCallback ->
Ptr () ->
IO ()
remoteConnectionGetSecretsAsync ::
(B.CallStack.HasCallStack, MonadIO m, IsRemoteConnection a, Gio.Cancellable.IsCancellable b) =>
a
-> T.Text
-> Maybe (b)
-> Maybe (Gio.Callbacks.AsyncReadyCallback)
-> m ()
remoteConnectionGetSecretsAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsRemoteConnection a, IsCancellable b) =>
a -> Text -> Maybe b -> Maybe AsyncReadyCallback -> m ()
remoteConnectionGetSecretsAsync a
connection Text
settingName 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 RemoteConnection
connection' <- a -> IO (Ptr RemoteConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
CString
settingName' <- Text -> IO CString
textToCString Text
settingName
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 RemoteConnection
-> CString
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_remote_connection_get_secrets_async Ptr RemoteConnection
connection' CString
settingName' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
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
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
settingName'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data RemoteConnectionGetSecretsAsyncMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsRemoteConnection a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod RemoteConnectionGetSecretsAsyncMethodInfo a signature where
overloadedMethod = remoteConnectionGetSecretsAsync
instance O.OverloadedMethodInfo RemoteConnectionGetSecretsAsyncMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.remoteConnectionGetSecretsAsync",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#v:remoteConnectionGetSecretsAsync"
})
#endif
foreign import ccall "nm_remote_connection_get_secrets_finish" nm_remote_connection_get_secrets_finish ::
Ptr RemoteConnection ->
Ptr Gio.AsyncResult.AsyncResult ->
Ptr (Ptr GError) ->
IO (Ptr GVariant)
remoteConnectionGetSecretsFinish ::
(B.CallStack.HasCallStack, MonadIO m, IsRemoteConnection a, Gio.AsyncResult.IsAsyncResult b) =>
a
-> b
-> m GVariant
remoteConnectionGetSecretsFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsRemoteConnection a, IsAsyncResult b) =>
a -> b -> m GVariant
remoteConnectionGetSecretsFinish a
connection b
result_ = IO GVariant -> m GVariant
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
Ptr RemoteConnection
connection' <- a -> IO (Ptr RemoteConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
IO GVariant -> IO () -> IO GVariant
forall a b. IO a -> IO b -> IO a
onException (do
Ptr GVariant
result <- (Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant))
-> (Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant)
forall a b. (a -> b) -> a -> b
$ Ptr RemoteConnection
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr GVariant)
nm_remote_connection_get_secrets_finish Ptr RemoteConnection
connection' Ptr AsyncResult
result_'
Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"remoteConnectionGetSecretsFinish" Ptr GVariant
result
GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
GVariant -> IO GVariant
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result'
) (do
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
)
#if defined(ENABLE_OVERLOADING)
data RemoteConnectionGetSecretsFinishMethodInfo
instance (signature ~ (b -> m GVariant), MonadIO m, IsRemoteConnection a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod RemoteConnectionGetSecretsFinishMethodInfo a signature where
overloadedMethod = remoteConnectionGetSecretsFinish
instance O.OverloadedMethodInfo RemoteConnectionGetSecretsFinishMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.remoteConnectionGetSecretsFinish",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#v:remoteConnectionGetSecretsFinish"
})
#endif
foreign import ccall "nm_remote_connection_get_unsaved" nm_remote_connection_get_unsaved ::
Ptr RemoteConnection ->
IO CInt
remoteConnectionGetUnsaved ::
(B.CallStack.HasCallStack, MonadIO m, IsRemoteConnection a) =>
a
-> m Bool
remoteConnectionGetUnsaved :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRemoteConnection a) =>
a -> m Bool
remoteConnectionGetUnsaved a
connection = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
Ptr RemoteConnection
connection' <- a -> IO (Ptr RemoteConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
CInt
result <- Ptr RemoteConnection -> IO CInt
nm_remote_connection_get_unsaved Ptr RemoteConnection
connection'
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data RemoteConnectionGetUnsavedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsRemoteConnection a) => O.OverloadedMethod RemoteConnectionGetUnsavedMethodInfo a signature where
overloadedMethod = remoteConnectionGetUnsaved
instance O.OverloadedMethodInfo RemoteConnectionGetUnsavedMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.remoteConnectionGetUnsaved",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#v:remoteConnectionGetUnsaved"
})
#endif
foreign import ccall "nm_remote_connection_get_version_id" nm_remote_connection_get_version_id ::
Ptr RemoteConnection ->
IO Word64
remoteConnectionGetVersionId ::
(B.CallStack.HasCallStack, MonadIO m, IsRemoteConnection a) =>
a
-> m Word64
remoteConnectionGetVersionId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRemoteConnection a) =>
a -> m Word64
remoteConnectionGetVersionId a
connection = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
Ptr RemoteConnection
connection' <- a -> IO (Ptr RemoteConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
Word64
result <- Ptr RemoteConnection -> IO Word64
nm_remote_connection_get_version_id Ptr RemoteConnection
connection'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result
#if defined(ENABLE_OVERLOADING)
data RemoteConnectionGetVersionIdMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsRemoteConnection a) => O.OverloadedMethod RemoteConnectionGetVersionIdMethodInfo a signature where
overloadedMethod = remoteConnectionGetVersionId
instance O.OverloadedMethodInfo RemoteConnectionGetVersionIdMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.remoteConnectionGetVersionId",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#v:remoteConnectionGetVersionId"
})
#endif
foreign import ccall "nm_remote_connection_get_visible" nm_remote_connection_get_visible ::
Ptr RemoteConnection ->
IO CInt
remoteConnectionGetVisible ::
(B.CallStack.HasCallStack, MonadIO m, IsRemoteConnection a) =>
a
-> m Bool
remoteConnectionGetVisible :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRemoteConnection a) =>
a -> m Bool
remoteConnectionGetVisible a
connection = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
Ptr RemoteConnection
connection' <- a -> IO (Ptr RemoteConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
CInt
result <- Ptr RemoteConnection -> IO CInt
nm_remote_connection_get_visible Ptr RemoteConnection
connection'
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data RemoteConnectionGetVisibleMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsRemoteConnection a) => O.OverloadedMethod RemoteConnectionGetVisibleMethodInfo a signature where
overloadedMethod = remoteConnectionGetVisible
instance O.OverloadedMethodInfo RemoteConnectionGetVisibleMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.remoteConnectionGetVisible",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#v:remoteConnectionGetVisible"
})
#endif
foreign import ccall "nm_remote_connection_save" nm_remote_connection_save ::
Ptr RemoteConnection ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO CInt
{-# DEPRECATED remoteConnectionSave ["(Since version 1.22)","Use 'GI.NM.Objects.RemoteConnection.remoteConnectionSaveAsync' or GDBusConnection."] #-}
remoteConnectionSave ::
(B.CallStack.HasCallStack, MonadIO m, IsRemoteConnection a, Gio.Cancellable.IsCancellable b) =>
a
-> Maybe (b)
-> m ()
remoteConnectionSave :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsRemoteConnection a, IsCancellable b) =>
a -> Maybe b -> m ()
remoteConnectionSave a
connection 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 RemoteConnection
connection' <- a -> IO (Ptr RemoteConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
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 RemoteConnection
-> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
nm_remote_connection_save Ptr RemoteConnection
connection' Ptr Cancellable
maybeCancellable
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
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 RemoteConnectionSaveMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsRemoteConnection a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod RemoteConnectionSaveMethodInfo a signature where
overloadedMethod = remoteConnectionSave
instance O.OverloadedMethodInfo RemoteConnectionSaveMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.remoteConnectionSave",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#v:remoteConnectionSave"
})
#endif
foreign import ccall "nm_remote_connection_save_async" nm_remote_connection_save_async ::
Ptr RemoteConnection ->
Ptr Gio.Cancellable.Cancellable ->
FunPtr Gio.Callbacks.C_AsyncReadyCallback ->
Ptr () ->
IO ()
remoteConnectionSaveAsync ::
(B.CallStack.HasCallStack, MonadIO m, IsRemoteConnection a, Gio.Cancellable.IsCancellable b) =>
a
-> Maybe (b)
-> Maybe (Gio.Callbacks.AsyncReadyCallback)
-> m ()
remoteConnectionSaveAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsRemoteConnection a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
remoteConnectionSaveAsync a
connection 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 RemoteConnection
connection' <- a -> IO (Ptr RemoteConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
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 RemoteConnection
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_remote_connection_save_async Ptr RemoteConnection
connection' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
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 RemoteConnectionSaveAsyncMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsRemoteConnection a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod RemoteConnectionSaveAsyncMethodInfo a signature where
overloadedMethod = remoteConnectionSaveAsync
instance O.OverloadedMethodInfo RemoteConnectionSaveAsyncMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.remoteConnectionSaveAsync",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#v:remoteConnectionSaveAsync"
})
#endif
foreign import ccall "nm_remote_connection_save_finish" nm_remote_connection_save_finish ::
Ptr RemoteConnection ->
Ptr Gio.AsyncResult.AsyncResult ->
Ptr (Ptr GError) ->
IO CInt
remoteConnectionSaveFinish ::
(B.CallStack.HasCallStack, MonadIO m, IsRemoteConnection a, Gio.AsyncResult.IsAsyncResult b) =>
a
-> b
-> m ()
remoteConnectionSaveFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsRemoteConnection a, IsAsyncResult b) =>
a -> b -> m ()
remoteConnectionSaveFinish a
connection 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 RemoteConnection
connection' <- a -> IO (Ptr RemoteConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
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 RemoteConnection
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
nm_remote_connection_save_finish Ptr RemoteConnection
connection' Ptr AsyncResult
result_'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
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 RemoteConnectionSaveFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsRemoteConnection a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod RemoteConnectionSaveFinishMethodInfo a signature where
overloadedMethod = remoteConnectionSaveFinish
instance O.OverloadedMethodInfo RemoteConnectionSaveFinishMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.remoteConnectionSaveFinish",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#v:remoteConnectionSaveFinish"
})
#endif
foreign import ccall "nm_remote_connection_update2" nm_remote_connection_update2 ::
Ptr RemoteConnection ->
Ptr GVariant ->
CUInt ->
Ptr GVariant ->
Ptr Gio.Cancellable.Cancellable ->
FunPtr Gio.Callbacks.C_AsyncReadyCallback ->
Ptr () ->
IO ()
remoteConnectionUpdate2 ::
(B.CallStack.HasCallStack, MonadIO m, IsRemoteConnection a, Gio.Cancellable.IsCancellable b) =>
a
-> Maybe (GVariant)
-> [NM.Flags.SettingsUpdate2Flags]
-> Maybe (GVariant)
-> Maybe (b)
-> Maybe (Gio.Callbacks.AsyncReadyCallback)
-> m ()
remoteConnectionUpdate2 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsRemoteConnection a, IsCancellable b) =>
a
-> Maybe GVariant
-> [SettingsUpdate2Flags]
-> Maybe GVariant
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
remoteConnectionUpdate2 a
connection Maybe GVariant
settings [SettingsUpdate2Flags]
flags Maybe GVariant
args 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 RemoteConnection
connection' <- a -> IO (Ptr RemoteConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
Ptr GVariant
maybeSettings <- case Maybe GVariant
settings of
Maybe GVariant
Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
FP.nullPtr
Just GVariant
jSettings -> do
Ptr GVariant
jSettings' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jSettings
Ptr GVariant -> IO (Ptr GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jSettings'
let flags' :: CUInt
flags' = [SettingsUpdate2Flags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SettingsUpdate2Flags]
flags
Ptr GVariant
maybeArgs <- case Maybe GVariant
args of
Maybe GVariant
Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
FP.nullPtr
Just GVariant
jArgs -> do
Ptr GVariant
jArgs' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jArgs
Ptr GVariant -> IO (Ptr GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jArgs'
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 RemoteConnection
-> Ptr GVariant
-> CUInt
-> Ptr GVariant
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_remote_connection_update2 Ptr RemoteConnection
connection' Ptr GVariant
maybeSettings CUInt
flags' Ptr GVariant
maybeArgs Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
settings GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
args GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
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 RemoteConnectionUpdate2MethodInfo
instance (signature ~ (Maybe (GVariant) -> [NM.Flags.SettingsUpdate2Flags] -> Maybe (GVariant) -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsRemoteConnection a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod RemoteConnectionUpdate2MethodInfo a signature where
overloadedMethod = remoteConnectionUpdate2
instance O.OverloadedMethodInfo RemoteConnectionUpdate2MethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.remoteConnectionUpdate2",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#v:remoteConnectionUpdate2"
})
#endif
foreign import ccall "nm_remote_connection_update2_finish" nm_remote_connection_update2_finish ::
Ptr RemoteConnection ->
Ptr Gio.AsyncResult.AsyncResult ->
Ptr (Ptr GError) ->
IO (Ptr GVariant)
remoteConnectionUpdate2Finish ::
(B.CallStack.HasCallStack, MonadIO m, IsRemoteConnection a, Gio.AsyncResult.IsAsyncResult b) =>
a
-> b
-> m GVariant
remoteConnectionUpdate2Finish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsRemoteConnection a, IsAsyncResult b) =>
a -> b -> m GVariant
remoteConnectionUpdate2Finish a
connection b
result_ = IO GVariant -> m GVariant
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
Ptr RemoteConnection
connection' <- a -> IO (Ptr RemoteConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
IO GVariant -> IO () -> IO GVariant
forall a b. IO a -> IO b -> IO a
onException (do
Ptr GVariant
result <- (Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant))
-> (Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant)
forall a b. (a -> b) -> a -> b
$ Ptr RemoteConnection
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr GVariant)
nm_remote_connection_update2_finish Ptr RemoteConnection
connection' Ptr AsyncResult
result_'
Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"remoteConnectionUpdate2Finish" Ptr GVariant
result
GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
GVariant -> IO GVariant
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result'
) (do
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
)
#if defined(ENABLE_OVERLOADING)
data RemoteConnectionUpdate2FinishMethodInfo
instance (signature ~ (b -> m GVariant), MonadIO m, IsRemoteConnection a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod RemoteConnectionUpdate2FinishMethodInfo a signature where
overloadedMethod = remoteConnectionUpdate2Finish
instance O.OverloadedMethodInfo RemoteConnectionUpdate2FinishMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.RemoteConnection.remoteConnectionUpdate2Finish",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-RemoteConnection.html#v:remoteConnectionUpdate2Finish"
})
#endif