{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.NM.Interfaces.VpnEditorPlugin
(
#if defined(ENABLE_OVERLOADING)
VpnEditorPluginGetVtMethodInfo ,
#endif
VpnEditorPlugin(..) ,
IsVpnEditorPlugin ,
toVpnEditorPlugin ,
#if defined(ENABLE_OVERLOADING)
ResolveVpnEditorPluginMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
VpnEditorPluginExportMethodInfo ,
#endif
vpnEditorPluginExport ,
#if defined(ENABLE_OVERLOADING)
VpnEditorPluginGetCapabilitiesMethodInfo,
#endif
vpnEditorPluginGetCapabilities ,
#if defined(ENABLE_OVERLOADING)
VpnEditorPluginGetEditorMethodInfo ,
#endif
vpnEditorPluginGetEditor ,
#if defined(ENABLE_OVERLOADING)
VpnEditorPluginGetPluginInfoMethodInfo ,
#endif
vpnEditorPluginGetPluginInfo ,
#if defined(ENABLE_OVERLOADING)
VpnEditorPluginGetSuggestedFilenameMethodInfo,
#endif
vpnEditorPluginGetSuggestedFilename ,
#if defined(ENABLE_OVERLOADING)
VpnEditorPluginImportMethodInfo ,
#endif
vpnEditorPluginImport ,
vpnEditorPluginLoad ,
vpnEditorPluginLoadFromFile ,
#if defined(ENABLE_OVERLOADING)
VpnEditorPluginSetPluginInfoMethodInfo ,
#endif
vpnEditorPluginSetPluginInfo ,
#if defined(ENABLE_OVERLOADING)
VpnEditorPluginDescriptionPropertyInfo ,
#endif
getVpnEditorPluginDescription ,
#if defined(ENABLE_OVERLOADING)
vpnEditorPluginDescription ,
#endif
#if defined(ENABLE_OVERLOADING)
VpnEditorPluginNamePropertyInfo ,
#endif
getVpnEditorPluginName ,
#if defined(ENABLE_OVERLOADING)
vpnEditorPluginName ,
#endif
#if defined(ENABLE_OVERLOADING)
VpnEditorPluginServicePropertyInfo ,
#endif
getVpnEditorPluginService ,
#if defined(ENABLE_OVERLOADING)
vpnEditorPluginService ,
#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.KeyFile as GLib.KeyFile
import qualified GI.GLib.Structs.VariantType as GLib.VariantType
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
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.Interfaces.VpnEditor as NM.VpnEditor
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.Objects.VpnPluginInfo as NM.VpnPluginInfo
import {-# SOURCE #-} qualified GI.NM.Structs.BridgeVlan as NM.BridgeVlan
import {-# SOURCE #-} qualified GI.NM.Structs.IPAddress as NM.IPAddress
import {-# SOURCE #-} qualified GI.NM.Structs.IPRoute as NM.IPRoute
import {-# SOURCE #-} qualified GI.NM.Structs.IPRoutingRule as NM.IPRoutingRule
import {-# SOURCE #-} qualified GI.NM.Structs.Range as NM.Range
import {-# SOURCE #-} qualified GI.NM.Structs.TCAction as NM.TCAction
import {-# SOURCE #-} qualified GI.NM.Structs.TCQdisc as NM.TCQdisc
import {-# SOURCE #-} qualified GI.NM.Structs.TCTfilter as NM.TCTfilter
import {-# SOURCE #-} qualified GI.NM.Structs.TeamLinkWatcher as NM.TeamLinkWatcher
import {-# SOURCE #-} qualified GI.NM.Structs.VariantAttributeSpec as NM.VariantAttributeSpec
#else
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.NM.Callbacks as NM.Callbacks
import {-# SOURCE #-} qualified GI.NM.Flags as NM.Flags
import {-# SOURCE #-} qualified GI.NM.Interfaces.Connection as NM.Connection
import {-# SOURCE #-} qualified GI.NM.Interfaces.VpnEditor as NM.VpnEditor
import {-# SOURCE #-} qualified GI.NM.Objects.VpnPluginInfo as NM.VpnPluginInfo
#endif
newtype VpnEditorPlugin = VpnEditorPlugin (SP.ManagedPtr VpnEditorPlugin)
deriving (VpnEditorPlugin -> VpnEditorPlugin -> Bool
(VpnEditorPlugin -> VpnEditorPlugin -> Bool)
-> (VpnEditorPlugin -> VpnEditorPlugin -> Bool)
-> Eq VpnEditorPlugin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VpnEditorPlugin -> VpnEditorPlugin -> Bool
== :: VpnEditorPlugin -> VpnEditorPlugin -> Bool
$c/= :: VpnEditorPlugin -> VpnEditorPlugin -> Bool
/= :: VpnEditorPlugin -> VpnEditorPlugin -> Bool
Eq)
instance SP.ManagedPtrNewtype VpnEditorPlugin where
toManagedPtr :: VpnEditorPlugin -> ManagedPtr VpnEditorPlugin
toManagedPtr (VpnEditorPlugin ManagedPtr VpnEditorPlugin
p) = ManagedPtr VpnEditorPlugin
p
foreign import ccall "nm_vpn_editor_plugin_get_type"
c_nm_vpn_editor_plugin_get_type :: IO B.Types.GType
instance B.Types.TypedObject VpnEditorPlugin where
glibType :: IO GType
glibType = IO GType
c_nm_vpn_editor_plugin_get_type
instance B.Types.GObject VpnEditorPlugin
class (SP.GObject o, O.IsDescendantOf VpnEditorPlugin o) => IsVpnEditorPlugin o
instance (SP.GObject o, O.IsDescendantOf VpnEditorPlugin o) => IsVpnEditorPlugin o
instance O.HasParentTypes VpnEditorPlugin
type instance O.ParentTypes VpnEditorPlugin = '[GObject.Object.Object]
toVpnEditorPlugin :: (MIO.MonadIO m, IsVpnEditorPlugin o) => o -> m VpnEditorPlugin
toVpnEditorPlugin :: forall (m :: * -> *) o.
(MonadIO m, IsVpnEditorPlugin o) =>
o -> m VpnEditorPlugin
toVpnEditorPlugin = IO VpnEditorPlugin -> m VpnEditorPlugin
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO VpnEditorPlugin -> m VpnEditorPlugin)
-> (o -> IO VpnEditorPlugin) -> o -> m VpnEditorPlugin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr VpnEditorPlugin -> VpnEditorPlugin)
-> o -> IO VpnEditorPlugin
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr VpnEditorPlugin -> VpnEditorPlugin
VpnEditorPlugin
instance B.GValue.IsGValue (Maybe VpnEditorPlugin) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_nm_vpn_editor_plugin_get_type
gvalueSet_ :: Ptr GValue -> Maybe VpnEditorPlugin -> IO ()
gvalueSet_ Ptr GValue
gv Maybe VpnEditorPlugin
P.Nothing = Ptr GValue -> Ptr VpnEditorPlugin -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr VpnEditorPlugin
forall a. Ptr a
FP.nullPtr :: FP.Ptr VpnEditorPlugin)
gvalueSet_ Ptr GValue
gv (P.Just VpnEditorPlugin
obj) = VpnEditorPlugin -> (Ptr VpnEditorPlugin -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr VpnEditorPlugin
obj (Ptr GValue -> Ptr VpnEditorPlugin -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe VpnEditorPlugin)
gvalueGet_ Ptr GValue
gv = do
Ptr VpnEditorPlugin
ptr <- Ptr GValue -> IO (Ptr VpnEditorPlugin)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr VpnEditorPlugin)
if Ptr VpnEditorPlugin
ptr Ptr VpnEditorPlugin -> Ptr VpnEditorPlugin -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr VpnEditorPlugin
forall a. Ptr a
FP.nullPtr
then VpnEditorPlugin -> Maybe VpnEditorPlugin
forall a. a -> Maybe a
P.Just (VpnEditorPlugin -> Maybe VpnEditorPlugin)
-> IO VpnEditorPlugin -> IO (Maybe VpnEditorPlugin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr VpnEditorPlugin -> VpnEditorPlugin)
-> Ptr VpnEditorPlugin -> IO VpnEditorPlugin
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr VpnEditorPlugin -> VpnEditorPlugin
VpnEditorPlugin Ptr VpnEditorPlugin
ptr
else Maybe VpnEditorPlugin -> IO (Maybe VpnEditorPlugin)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe VpnEditorPlugin
forall a. Maybe a
P.Nothing
getVpnEditorPluginDescription :: (MonadIO m, IsVpnEditorPlugin o) => o -> m (Maybe T.Text)
getVpnEditorPluginDescription :: forall (m :: * -> *) o.
(MonadIO m, IsVpnEditorPlugin o) =>
o -> m (Maybe Text)
getVpnEditorPluginDescription o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"description"
#if defined(ENABLE_OVERLOADING)
data VpnEditorPluginDescriptionPropertyInfo
instance AttrInfo VpnEditorPluginDescriptionPropertyInfo where
type AttrAllowedOps VpnEditorPluginDescriptionPropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint VpnEditorPluginDescriptionPropertyInfo = IsVpnEditorPlugin
type AttrSetTypeConstraint VpnEditorPluginDescriptionPropertyInfo = (~) ()
type AttrTransferTypeConstraint VpnEditorPluginDescriptionPropertyInfo = (~) ()
type AttrTransferType VpnEditorPluginDescriptionPropertyInfo = ()
type AttrGetType VpnEditorPluginDescriptionPropertyInfo = (Maybe T.Text)
type AttrLabel VpnEditorPluginDescriptionPropertyInfo = "description"
type AttrOrigin VpnEditorPluginDescriptionPropertyInfo = VpnEditorPlugin
attrGet = getVpnEditorPluginDescription
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Interfaces.VpnEditorPlugin.description"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Interfaces-VpnEditorPlugin.html#g:attr:description"
})
#endif
getVpnEditorPluginName :: (MonadIO m, IsVpnEditorPlugin o) => o -> m (Maybe T.Text)
getVpnEditorPluginName :: forall (m :: * -> *) o.
(MonadIO m, IsVpnEditorPlugin o) =>
o -> m (Maybe Text)
getVpnEditorPluginName o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"name"
#if defined(ENABLE_OVERLOADING)
data VpnEditorPluginNamePropertyInfo
instance AttrInfo VpnEditorPluginNamePropertyInfo where
type AttrAllowedOps VpnEditorPluginNamePropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint VpnEditorPluginNamePropertyInfo = IsVpnEditorPlugin
type AttrSetTypeConstraint VpnEditorPluginNamePropertyInfo = (~) ()
type AttrTransferTypeConstraint VpnEditorPluginNamePropertyInfo = (~) ()
type AttrTransferType VpnEditorPluginNamePropertyInfo = ()
type AttrGetType VpnEditorPluginNamePropertyInfo = (Maybe T.Text)
type AttrLabel VpnEditorPluginNamePropertyInfo = "name"
type AttrOrigin VpnEditorPluginNamePropertyInfo = VpnEditorPlugin
attrGet = getVpnEditorPluginName
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Interfaces.VpnEditorPlugin.name"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Interfaces-VpnEditorPlugin.html#g:attr:name"
})
#endif
getVpnEditorPluginService :: (MonadIO m, IsVpnEditorPlugin o) => o -> m (Maybe T.Text)
getVpnEditorPluginService :: forall (m :: * -> *) o.
(MonadIO m, IsVpnEditorPlugin o) =>
o -> m (Maybe Text)
getVpnEditorPluginService o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"service"
#if defined(ENABLE_OVERLOADING)
data VpnEditorPluginServicePropertyInfo
instance AttrInfo VpnEditorPluginServicePropertyInfo where
type AttrAllowedOps VpnEditorPluginServicePropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint VpnEditorPluginServicePropertyInfo = IsVpnEditorPlugin
type AttrSetTypeConstraint VpnEditorPluginServicePropertyInfo = (~) ()
type AttrTransferTypeConstraint VpnEditorPluginServicePropertyInfo = (~) ()
type AttrTransferType VpnEditorPluginServicePropertyInfo = ()
type AttrGetType VpnEditorPluginServicePropertyInfo = (Maybe T.Text)
type AttrLabel VpnEditorPluginServicePropertyInfo = "service"
type AttrOrigin VpnEditorPluginServicePropertyInfo = VpnEditorPlugin
attrGet = getVpnEditorPluginService
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Interfaces.VpnEditorPlugin.service"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Interfaces-VpnEditorPlugin.html#g:attr:service"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList VpnEditorPlugin
type instance O.AttributeList VpnEditorPlugin = VpnEditorPluginAttributeList
type VpnEditorPluginAttributeList = ('[ '("description", VpnEditorPluginDescriptionPropertyInfo), '("name", VpnEditorPluginNamePropertyInfo), '("service", VpnEditorPluginServicePropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
vpnEditorPluginDescription :: AttrLabelProxy "description"
vpnEditorPluginDescription = AttrLabelProxy
vpnEditorPluginName :: AttrLabelProxy "name"
vpnEditorPluginName = AttrLabelProxy
vpnEditorPluginService :: AttrLabelProxy "service"
vpnEditorPluginService = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type family ResolveVpnEditorPluginMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveVpnEditorPluginMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveVpnEditorPluginMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveVpnEditorPluginMethod "export" o = VpnEditorPluginExportMethodInfo
ResolveVpnEditorPluginMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveVpnEditorPluginMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveVpnEditorPluginMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveVpnEditorPluginMethod "import" o = VpnEditorPluginImportMethodInfo
ResolveVpnEditorPluginMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveVpnEditorPluginMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveVpnEditorPluginMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveVpnEditorPluginMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveVpnEditorPluginMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveVpnEditorPluginMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveVpnEditorPluginMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveVpnEditorPluginMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveVpnEditorPluginMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveVpnEditorPluginMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveVpnEditorPluginMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveVpnEditorPluginMethod "getCapabilities" o = VpnEditorPluginGetCapabilitiesMethodInfo
ResolveVpnEditorPluginMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveVpnEditorPluginMethod "getEditor" o = VpnEditorPluginGetEditorMethodInfo
ResolveVpnEditorPluginMethod "getPluginInfo" o = VpnEditorPluginGetPluginInfoMethodInfo
ResolveVpnEditorPluginMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveVpnEditorPluginMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveVpnEditorPluginMethod "getSuggestedFilename" o = VpnEditorPluginGetSuggestedFilenameMethodInfo
ResolveVpnEditorPluginMethod "getVt" o = VpnEditorPluginGetVtMethodInfo
ResolveVpnEditorPluginMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveVpnEditorPluginMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveVpnEditorPluginMethod "setPluginInfo" o = VpnEditorPluginSetPluginInfoMethodInfo
ResolveVpnEditorPluginMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveVpnEditorPluginMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveVpnEditorPluginMethod t VpnEditorPlugin, O.OverloadedMethod info VpnEditorPlugin p) => OL.IsLabel t (VpnEditorPlugin -> 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 ~ ResolveVpnEditorPluginMethod t VpnEditorPlugin, O.OverloadedMethod info VpnEditorPlugin p, R.HasField t VpnEditorPlugin p) => R.HasField t VpnEditorPlugin p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveVpnEditorPluginMethod t VpnEditorPlugin, O.OverloadedMethodInfo info VpnEditorPlugin) => OL.IsLabel t (O.MethodProxy info VpnEditorPlugin) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
foreign import ccall "nm_vpn_editor_plugin_export" nm_vpn_editor_plugin_export ::
Ptr VpnEditorPlugin ->
CString ->
Ptr NM.Connection.Connection ->
Ptr (Ptr GError) ->
IO CInt
vpnEditorPluginExport ::
(B.CallStack.HasCallStack, MonadIO m, IsVpnEditorPlugin a, NM.Connection.IsConnection b) =>
a
-> T.Text
-> b
-> m ()
vpnEditorPluginExport :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsVpnEditorPlugin a, IsConnection b) =>
a -> Text -> b -> m ()
vpnEditorPluginExport a
plugin Text
path b
connection = 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 VpnEditorPlugin
plugin' <- a -> IO (Ptr VpnEditorPlugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
CString
path' <- Text -> IO CString
textToCString Text
path
Ptr Connection
connection' <- b -> IO (Ptr Connection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
connection
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 VpnEditorPlugin
-> CString -> Ptr Connection -> Ptr (Ptr GError) -> IO CInt
nm_vpn_editor_plugin_export Ptr VpnEditorPlugin
plugin' CString
path' Ptr Connection
connection'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
connection
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
) (do
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
)
#if defined(ENABLE_OVERLOADING)
data VpnEditorPluginExportMethodInfo
instance (signature ~ (T.Text -> b -> m ()), MonadIO m, IsVpnEditorPlugin a, NM.Connection.IsConnection b) => O.OverloadedMethod VpnEditorPluginExportMethodInfo a signature where
overloadedMethod = vpnEditorPluginExport
instance O.OverloadedMethodInfo VpnEditorPluginExportMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Interfaces.VpnEditorPlugin.vpnEditorPluginExport",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Interfaces-VpnEditorPlugin.html#v:vpnEditorPluginExport"
})
#endif
foreign import ccall "nm_vpn_editor_plugin_get_capabilities" nm_vpn_editor_plugin_get_capabilities ::
Ptr VpnEditorPlugin ->
IO CUInt
vpnEditorPluginGetCapabilities ::
(B.CallStack.HasCallStack, MonadIO m, IsVpnEditorPlugin a) =>
a
-> m [NM.Flags.VpnEditorPluginCapability]
vpnEditorPluginGetCapabilities :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnEditorPlugin a) =>
a -> m [VpnEditorPluginCapability]
vpnEditorPluginGetCapabilities a
plugin = IO [VpnEditorPluginCapability] -> m [VpnEditorPluginCapability]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [VpnEditorPluginCapability] -> m [VpnEditorPluginCapability])
-> IO [VpnEditorPluginCapability] -> m [VpnEditorPluginCapability]
forall a b. (a -> b) -> a -> b
$ do
Ptr VpnEditorPlugin
plugin' <- a -> IO (Ptr VpnEditorPlugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
CUInt
result <- Ptr VpnEditorPlugin -> IO CUInt
nm_vpn_editor_plugin_get_capabilities Ptr VpnEditorPlugin
plugin'
let result' :: [VpnEditorPluginCapability]
result' = CUInt -> [VpnEditorPluginCapability]
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
plugin
[VpnEditorPluginCapability] -> IO [VpnEditorPluginCapability]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [VpnEditorPluginCapability]
result'
#if defined(ENABLE_OVERLOADING)
data VpnEditorPluginGetCapabilitiesMethodInfo
instance (signature ~ (m [NM.Flags.VpnEditorPluginCapability]), MonadIO m, IsVpnEditorPlugin a) => O.OverloadedMethod VpnEditorPluginGetCapabilitiesMethodInfo a signature where
overloadedMethod = vpnEditorPluginGetCapabilities
instance O.OverloadedMethodInfo VpnEditorPluginGetCapabilitiesMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Interfaces.VpnEditorPlugin.vpnEditorPluginGetCapabilities",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Interfaces-VpnEditorPlugin.html#v:vpnEditorPluginGetCapabilities"
})
#endif
foreign import ccall "nm_vpn_editor_plugin_get_editor" nm_vpn_editor_plugin_get_editor ::
Ptr VpnEditorPlugin ->
Ptr NM.Connection.Connection ->
Ptr (Ptr GError) ->
IO (Ptr NM.VpnEditor.VpnEditor)
vpnEditorPluginGetEditor ::
(B.CallStack.HasCallStack, MonadIO m, IsVpnEditorPlugin a, NM.Connection.IsConnection b) =>
a
-> b
-> m NM.VpnEditor.VpnEditor
vpnEditorPluginGetEditor :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsVpnEditorPlugin a, IsConnection b) =>
a -> b -> m VpnEditor
vpnEditorPluginGetEditor a
plugin b
connection = IO VpnEditor -> m VpnEditor
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VpnEditor -> m VpnEditor) -> IO VpnEditor -> m VpnEditor
forall a b. (a -> b) -> a -> b
$ do
Ptr VpnEditorPlugin
plugin' <- a -> IO (Ptr VpnEditorPlugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
Ptr Connection
connection' <- b -> IO (Ptr Connection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
connection
IO VpnEditor -> IO () -> IO VpnEditor
forall a b. IO a -> IO b -> IO a
onException (do
Ptr VpnEditor
result <- (Ptr (Ptr GError) -> IO (Ptr VpnEditor)) -> IO (Ptr VpnEditor)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr VpnEditor)) -> IO (Ptr VpnEditor))
-> (Ptr (Ptr GError) -> IO (Ptr VpnEditor)) -> IO (Ptr VpnEditor)
forall a b. (a -> b) -> a -> b
$ Ptr VpnEditorPlugin
-> Ptr Connection -> Ptr (Ptr GError) -> IO (Ptr VpnEditor)
nm_vpn_editor_plugin_get_editor Ptr VpnEditorPlugin
plugin' Ptr Connection
connection'
Text -> Ptr VpnEditor -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnEditorPluginGetEditor" Ptr VpnEditor
result
VpnEditor
result' <- ((ManagedPtr VpnEditor -> VpnEditor)
-> Ptr VpnEditor -> IO VpnEditor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr VpnEditor -> VpnEditor
NM.VpnEditor.VpnEditor) Ptr VpnEditor
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
connection
VpnEditor -> IO VpnEditor
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VpnEditor
result'
) (do
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
)
#if defined(ENABLE_OVERLOADING)
data VpnEditorPluginGetEditorMethodInfo
instance (signature ~ (b -> m NM.VpnEditor.VpnEditor), MonadIO m, IsVpnEditorPlugin a, NM.Connection.IsConnection b) => O.OverloadedMethod VpnEditorPluginGetEditorMethodInfo a signature where
overloadedMethod = vpnEditorPluginGetEditor
instance O.OverloadedMethodInfo VpnEditorPluginGetEditorMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Interfaces.VpnEditorPlugin.vpnEditorPluginGetEditor",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Interfaces-VpnEditorPlugin.html#v:vpnEditorPluginGetEditor"
})
#endif
foreign import ccall "nm_vpn_editor_plugin_get_plugin_info" nm_vpn_editor_plugin_get_plugin_info ::
Ptr VpnEditorPlugin ->
IO (Ptr NM.VpnPluginInfo.VpnPluginInfo)
vpnEditorPluginGetPluginInfo ::
(B.CallStack.HasCallStack, MonadIO m, IsVpnEditorPlugin a) =>
a
-> m NM.VpnPluginInfo.VpnPluginInfo
vpnEditorPluginGetPluginInfo :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnEditorPlugin a) =>
a -> m VpnPluginInfo
vpnEditorPluginGetPluginInfo a
plugin = IO VpnPluginInfo -> m VpnPluginInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VpnPluginInfo -> m VpnPluginInfo)
-> IO VpnPluginInfo -> m VpnPluginInfo
forall a b. (a -> b) -> a -> b
$ do
Ptr VpnEditorPlugin
plugin' <- a -> IO (Ptr VpnEditorPlugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
Ptr VpnPluginInfo
result <- Ptr VpnEditorPlugin -> IO (Ptr VpnPluginInfo)
nm_vpn_editor_plugin_get_plugin_info Ptr VpnEditorPlugin
plugin'
Text -> Ptr VpnPluginInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnEditorPluginGetPluginInfo" Ptr VpnPluginInfo
result
VpnPluginInfo
result' <- ((ManagedPtr VpnPluginInfo -> VpnPluginInfo)
-> Ptr VpnPluginInfo -> IO VpnPluginInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr VpnPluginInfo -> VpnPluginInfo
NM.VpnPluginInfo.VpnPluginInfo) Ptr VpnPluginInfo
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
VpnPluginInfo -> IO VpnPluginInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VpnPluginInfo
result'
#if defined(ENABLE_OVERLOADING)
data VpnEditorPluginGetPluginInfoMethodInfo
instance (signature ~ (m NM.VpnPluginInfo.VpnPluginInfo), MonadIO m, IsVpnEditorPlugin a) => O.OverloadedMethod VpnEditorPluginGetPluginInfoMethodInfo a signature where
overloadedMethod = vpnEditorPluginGetPluginInfo
instance O.OverloadedMethodInfo VpnEditorPluginGetPluginInfoMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Interfaces.VpnEditorPlugin.vpnEditorPluginGetPluginInfo",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Interfaces-VpnEditorPlugin.html#v:vpnEditorPluginGetPluginInfo"
})
#endif
foreign import ccall "nm_vpn_editor_plugin_get_suggested_filename" nm_vpn_editor_plugin_get_suggested_filename ::
Ptr VpnEditorPlugin ->
Ptr NM.Connection.Connection ->
IO CString
vpnEditorPluginGetSuggestedFilename ::
(B.CallStack.HasCallStack, MonadIO m, IsVpnEditorPlugin a, NM.Connection.IsConnection b) =>
a
-> b
-> m T.Text
vpnEditorPluginGetSuggestedFilename :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsVpnEditorPlugin a, IsConnection b) =>
a -> b -> m Text
vpnEditorPluginGetSuggestedFilename a
plugin b
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 VpnEditorPlugin
plugin' <- a -> IO (Ptr VpnEditorPlugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
Ptr Connection
connection' <- b -> IO (Ptr Connection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
connection
CString
result <- Ptr VpnEditorPlugin -> Ptr Connection -> IO CString
nm_vpn_editor_plugin_get_suggested_filename Ptr VpnEditorPlugin
plugin' Ptr Connection
connection'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnEditorPluginGetSuggestedFilename" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
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 VpnEditorPluginGetSuggestedFilenameMethodInfo
instance (signature ~ (b -> m T.Text), MonadIO m, IsVpnEditorPlugin a, NM.Connection.IsConnection b) => O.OverloadedMethod VpnEditorPluginGetSuggestedFilenameMethodInfo a signature where
overloadedMethod = vpnEditorPluginGetSuggestedFilename
instance O.OverloadedMethodInfo VpnEditorPluginGetSuggestedFilenameMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Interfaces.VpnEditorPlugin.vpnEditorPluginGetSuggestedFilename",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Interfaces-VpnEditorPlugin.html#v:vpnEditorPluginGetSuggestedFilename"
})
#endif
#if defined(ENABLE_OVERLOADING)
data VpnEditorPluginGetVtMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "getVt" VpnEditorPlugin) => O.OverloadedMethod VpnEditorPluginGetVtMethodInfo o p where
overloadedMethod = undefined
instance (o ~ O.UnsupportedMethodError "getVt" VpnEditorPlugin) => O.OverloadedMethodInfo VpnEditorPluginGetVtMethodInfo o where
overloadedMethodInfo = undefined
#endif
foreign import ccall "nm_vpn_editor_plugin_import" nm_vpn_editor_plugin_import ::
Ptr VpnEditorPlugin ->
CString ->
Ptr (Ptr GError) ->
IO (Ptr NM.Connection.Connection)
vpnEditorPluginImport ::
(B.CallStack.HasCallStack, MonadIO m, IsVpnEditorPlugin a) =>
a
-> T.Text
-> m NM.Connection.Connection
vpnEditorPluginImport :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnEditorPlugin a) =>
a -> Text -> m Connection
vpnEditorPluginImport a
plugin Text
path = IO Connection -> m Connection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Connection -> m Connection) -> IO Connection -> m Connection
forall a b. (a -> b) -> a -> b
$ do
Ptr VpnEditorPlugin
plugin' <- a -> IO (Ptr VpnEditorPlugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
CString
path' <- Text -> IO CString
textToCString Text
path
IO Connection -> IO () -> IO Connection
forall a b. IO a -> IO b -> IO a
onException (do
Ptr Connection
result <- (Ptr (Ptr GError) -> IO (Ptr Connection)) -> IO (Ptr Connection)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Connection)) -> IO (Ptr Connection))
-> (Ptr (Ptr GError) -> IO (Ptr Connection)) -> IO (Ptr Connection)
forall a b. (a -> b) -> a -> b
$ Ptr VpnEditorPlugin
-> CString -> Ptr (Ptr GError) -> IO (Ptr Connection)
nm_vpn_editor_plugin_import Ptr VpnEditorPlugin
plugin' CString
path'
Text -> Ptr Connection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnEditorPluginImport" Ptr Connection
result
Connection
result' <- ((ManagedPtr Connection -> Connection)
-> Ptr Connection -> IO Connection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Connection -> Connection
NM.Connection.Connection) Ptr Connection
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
Connection -> IO Connection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Connection
result'
) (do
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
)
#if defined(ENABLE_OVERLOADING)
data VpnEditorPluginImportMethodInfo
instance (signature ~ (T.Text -> m NM.Connection.Connection), MonadIO m, IsVpnEditorPlugin a) => O.OverloadedMethod VpnEditorPluginImportMethodInfo a signature where
overloadedMethod = vpnEditorPluginImport
instance O.OverloadedMethodInfo VpnEditorPluginImportMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Interfaces.VpnEditorPlugin.vpnEditorPluginImport",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Interfaces-VpnEditorPlugin.html#v:vpnEditorPluginImport"
})
#endif
foreign import ccall "nm_vpn_editor_plugin_set_plugin_info" nm_vpn_editor_plugin_set_plugin_info ::
Ptr VpnEditorPlugin ->
Ptr NM.VpnPluginInfo.VpnPluginInfo ->
IO ()
vpnEditorPluginSetPluginInfo ::
(B.CallStack.HasCallStack, MonadIO m, IsVpnEditorPlugin a, NM.VpnPluginInfo.IsVpnPluginInfo b) =>
a
-> Maybe (b)
-> m ()
vpnEditorPluginSetPluginInfo :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsVpnEditorPlugin a,
IsVpnPluginInfo b) =>
a -> Maybe b -> m ()
vpnEditorPluginSetPluginInfo a
plugin Maybe b
pluginInfo = 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 VpnEditorPlugin
plugin' <- a -> IO (Ptr VpnEditorPlugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
Ptr VpnPluginInfo
maybePluginInfo <- case Maybe b
pluginInfo of
Maybe b
Nothing -> Ptr VpnPluginInfo -> IO (Ptr VpnPluginInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr VpnPluginInfo
forall a. Ptr a
FP.nullPtr
Just b
jPluginInfo -> do
Ptr VpnPluginInfo
jPluginInfo' <- b -> IO (Ptr VpnPluginInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jPluginInfo
Ptr VpnPluginInfo -> IO (Ptr VpnPluginInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr VpnPluginInfo
jPluginInfo'
Ptr VpnEditorPlugin -> Ptr VpnPluginInfo -> IO ()
nm_vpn_editor_plugin_set_plugin_info Ptr VpnEditorPlugin
plugin' Ptr VpnPluginInfo
maybePluginInfo
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
pluginInfo 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 VpnEditorPluginSetPluginInfoMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsVpnEditorPlugin a, NM.VpnPluginInfo.IsVpnPluginInfo b) => O.OverloadedMethod VpnEditorPluginSetPluginInfoMethodInfo a signature where
overloadedMethod = vpnEditorPluginSetPluginInfo
instance O.OverloadedMethodInfo VpnEditorPluginSetPluginInfoMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Interfaces.VpnEditorPlugin.vpnEditorPluginSetPluginInfo",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Interfaces-VpnEditorPlugin.html#v:vpnEditorPluginSetPluginInfo"
})
#endif
foreign import ccall "nm_vpn_editor_plugin_load" nm_vpn_editor_plugin_load ::
CString ->
CString ->
Ptr (Ptr GError) ->
IO (Ptr VpnEditorPlugin)
vpnEditorPluginLoad ::
(B.CallStack.HasCallStack, MonadIO m) =>
T.Text
-> T.Text
-> m VpnEditorPlugin
vpnEditorPluginLoad :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Text -> m VpnEditorPlugin
vpnEditorPluginLoad Text
pluginName Text
checkService = IO VpnEditorPlugin -> m VpnEditorPlugin
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VpnEditorPlugin -> m VpnEditorPlugin)
-> IO VpnEditorPlugin -> m VpnEditorPlugin
forall a b. (a -> b) -> a -> b
$ do
CString
pluginName' <- Text -> IO CString
textToCString Text
pluginName
CString
checkService' <- Text -> IO CString
textToCString Text
checkService
IO VpnEditorPlugin -> IO () -> IO VpnEditorPlugin
forall a b. IO a -> IO b -> IO a
onException (do
Ptr VpnEditorPlugin
result <- (Ptr (Ptr GError) -> IO (Ptr VpnEditorPlugin))
-> IO (Ptr VpnEditorPlugin)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr VpnEditorPlugin))
-> IO (Ptr VpnEditorPlugin))
-> (Ptr (Ptr GError) -> IO (Ptr VpnEditorPlugin))
-> IO (Ptr VpnEditorPlugin)
forall a b. (a -> b) -> a -> b
$ CString -> CString -> Ptr (Ptr GError) -> IO (Ptr VpnEditorPlugin)
nm_vpn_editor_plugin_load CString
pluginName' CString
checkService'
Text -> Ptr VpnEditorPlugin -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnEditorPluginLoad" Ptr VpnEditorPlugin
result
VpnEditorPlugin
result' <- ((ManagedPtr VpnEditorPlugin -> VpnEditorPlugin)
-> Ptr VpnEditorPlugin -> IO VpnEditorPlugin
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr VpnEditorPlugin -> VpnEditorPlugin
VpnEditorPlugin) Ptr VpnEditorPlugin
result
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
pluginName'
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checkService'
VpnEditorPlugin -> IO VpnEditorPlugin
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VpnEditorPlugin
result'
) (do
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
pluginName'
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checkService'
)
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "nm_vpn_editor_plugin_load_from_file" nm_vpn_editor_plugin_load_from_file ::
CString ->
CString ->
Int32 ->
FunPtr NM.Callbacks.C_UtilsCheckFilePredicate ->
Ptr () ->
Ptr (Ptr GError) ->
IO (Ptr VpnEditorPlugin)
vpnEditorPluginLoadFromFile ::
(B.CallStack.HasCallStack, MonadIO m) =>
T.Text
-> T.Text
-> Int32
-> FunPtr NM.Callbacks.C_UtilsCheckFilePredicate
-> m VpnEditorPlugin
vpnEditorPluginLoadFromFile :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text
-> Text
-> Int32
-> FunPtr C_UtilsCheckFilePredicate
-> m VpnEditorPlugin
vpnEditorPluginLoadFromFile Text
pluginName Text
checkService Int32
checkOwner FunPtr C_UtilsCheckFilePredicate
checkFile = IO VpnEditorPlugin -> m VpnEditorPlugin
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VpnEditorPlugin -> m VpnEditorPlugin)
-> IO VpnEditorPlugin -> m VpnEditorPlugin
forall a b. (a -> b) -> a -> b
$ do
CString
pluginName' <- Text -> IO CString
textToCString Text
pluginName
CString
checkService' <- Text -> IO CString
textToCString Text
checkService
let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
IO VpnEditorPlugin -> IO () -> IO VpnEditorPlugin
forall a b. IO a -> IO b -> IO a
onException (do
Ptr VpnEditorPlugin
result <- (Ptr (Ptr GError) -> IO (Ptr VpnEditorPlugin))
-> IO (Ptr VpnEditorPlugin)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr VpnEditorPlugin))
-> IO (Ptr VpnEditorPlugin))
-> (Ptr (Ptr GError) -> IO (Ptr VpnEditorPlugin))
-> IO (Ptr VpnEditorPlugin)
forall a b. (a -> b) -> a -> b
$ CString
-> CString
-> Int32
-> FunPtr C_UtilsCheckFilePredicate
-> Ptr ()
-> Ptr (Ptr GError)
-> IO (Ptr VpnEditorPlugin)
nm_vpn_editor_plugin_load_from_file CString
pluginName' CString
checkService' Int32
checkOwner FunPtr C_UtilsCheckFilePredicate
checkFile Ptr ()
forall a. Ptr a
userData
Text -> Ptr VpnEditorPlugin -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnEditorPluginLoadFromFile" Ptr VpnEditorPlugin
result
VpnEditorPlugin
result' <- ((ManagedPtr VpnEditorPlugin -> VpnEditorPlugin)
-> Ptr VpnEditorPlugin -> IO VpnEditorPlugin
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr VpnEditorPlugin -> VpnEditorPlugin
VpnEditorPlugin) Ptr VpnEditorPlugin
result
Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_UtilsCheckFilePredicate -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_UtilsCheckFilePredicate
checkFile
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
pluginName'
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checkService'
VpnEditorPlugin -> IO VpnEditorPlugin
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VpnEditorPlugin
result'
) (do
Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_UtilsCheckFilePredicate -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_UtilsCheckFilePredicate
checkFile
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
pluginName'
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checkService'
)
#if defined(ENABLE_OVERLOADING)
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList VpnEditorPlugin = VpnEditorPluginSignalList
type VpnEditorPluginSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])
#endif