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

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

module GI.NM.Callbacks
    ( 

 -- * Signals


-- ** KeyfileReadHandler #signal:KeyfileReadHandler#

    C_KeyfileReadHandler                    ,
    KeyfileReadHandler                      ,
    KeyfileReadHandler_WithClosures         ,
    drop_closures_KeyfileReadHandler        ,
    dynamic_KeyfileReadHandler              ,
    genClosure_KeyfileReadHandler           ,
    mk_KeyfileReadHandler                   ,
    noKeyfileReadHandler                    ,
    noKeyfileReadHandler_WithClosures       ,
    wrap_KeyfileReadHandler                 ,


-- ** KeyfileWriteHandler #signal:KeyfileWriteHandler#

    C_KeyfileWriteHandler                   ,
    KeyfileWriteHandler                     ,
    KeyfileWriteHandler_WithClosures        ,
    drop_closures_KeyfileWriteHandler       ,
    dynamic_KeyfileWriteHandler             ,
    genClosure_KeyfileWriteHandler          ,
    mk_KeyfileWriteHandler                  ,
    noKeyfileWriteHandler                   ,
    noKeyfileWriteHandler_WithClosures      ,
    wrap_KeyfileWriteHandler                ,


-- ** SecretAgentOldDeleteSecretsFunc #signal:SecretAgentOldDeleteSecretsFunc#

    C_SecretAgentOldDeleteSecretsFunc       ,
    SecretAgentOldDeleteSecretsFunc         ,
    SecretAgentOldDeleteSecretsFunc_WithClosures,
    drop_closures_SecretAgentOldDeleteSecretsFunc,
    dynamic_SecretAgentOldDeleteSecretsFunc ,
    genClosure_SecretAgentOldDeleteSecretsFunc,
    mk_SecretAgentOldDeleteSecretsFunc      ,
    noSecretAgentOldDeleteSecretsFunc       ,
    noSecretAgentOldDeleteSecretsFunc_WithClosures,
    wrap_SecretAgentOldDeleteSecretsFunc    ,


-- ** SecretAgentOldGetSecretsFunc #signal:SecretAgentOldGetSecretsFunc#

    C_SecretAgentOldGetSecretsFunc          ,
    SecretAgentOldGetSecretsFunc            ,
    SecretAgentOldGetSecretsFunc_WithClosures,
    drop_closures_SecretAgentOldGetSecretsFunc,
    dynamic_SecretAgentOldGetSecretsFunc    ,
    genClosure_SecretAgentOldGetSecretsFunc ,
    mk_SecretAgentOldGetSecretsFunc         ,
    noSecretAgentOldGetSecretsFunc          ,
    noSecretAgentOldGetSecretsFunc_WithClosures,
    wrap_SecretAgentOldGetSecretsFunc       ,


-- ** SecretAgentOldSaveSecretsFunc #signal:SecretAgentOldSaveSecretsFunc#

    C_SecretAgentOldSaveSecretsFunc         ,
    SecretAgentOldSaveSecretsFunc           ,
    SecretAgentOldSaveSecretsFunc_WithClosures,
    drop_closures_SecretAgentOldSaveSecretsFunc,
    dynamic_SecretAgentOldSaveSecretsFunc   ,
    genClosure_SecretAgentOldSaveSecretsFunc,
    mk_SecretAgentOldSaveSecretsFunc        ,
    noSecretAgentOldSaveSecretsFunc         ,
    noSecretAgentOldSaveSecretsFunc_WithClosures,
    wrap_SecretAgentOldSaveSecretsFunc      ,


-- ** SettingClearSecretsWithFlagsFn #signal:SettingClearSecretsWithFlagsFn#

    C_SettingClearSecretsWithFlagsFn        ,
    SettingClearSecretsWithFlagsFn          ,
    SettingClearSecretsWithFlagsFn_WithClosures,
    drop_closures_SettingClearSecretsWithFlagsFn,
    dynamic_SettingClearSecretsWithFlagsFn  ,
    genClosure_SettingClearSecretsWithFlagsFn,
    mk_SettingClearSecretsWithFlagsFn       ,
    noSettingClearSecretsWithFlagsFn        ,
    noSettingClearSecretsWithFlagsFn_WithClosures,
    wrap_SettingClearSecretsWithFlagsFn     ,


-- ** SettingValueIterFn #signal:SettingValueIterFn#

    C_SettingValueIterFn                    ,
    SettingValueIterFn                      ,
    SettingValueIterFn_WithClosures         ,
    drop_closures_SettingValueIterFn        ,
    dynamic_SettingValueIterFn              ,
    genClosure_SettingValueIterFn           ,
    mk_SettingValueIterFn                   ,
    noSettingValueIterFn                    ,
    noSettingValueIterFn_WithClosures       ,
    wrap_SettingValueIterFn                 ,


-- ** UtilsCheckFilePredicate #signal:UtilsCheckFilePredicate#

    C_UtilsCheckFilePredicate               ,
    UtilsCheckFilePredicate                 ,
    UtilsCheckFilePredicate_WithClosures    ,
    drop_closures_UtilsCheckFilePredicate   ,
    dynamic_UtilsCheckFilePredicate         ,
    mk_UtilsCheckFilePredicate              ,
    noUtilsCheckFilePredicate               ,
    noUtilsCheckFilePredicate_WithClosures  ,


-- ** UtilsFileSearchInPathsPredicate #signal:UtilsFileSearchInPathsPredicate#

    C_UtilsFileSearchInPathsPredicate       ,
    UtilsFileSearchInPathsPredicate         ,
    UtilsFileSearchInPathsPredicate_WithClosures,
    drop_closures_UtilsFileSearchInPathsPredicate,
    dynamic_UtilsFileSearchInPathsPredicate ,
    genClosure_UtilsFileSearchInPathsPredicate,
    mk_UtilsFileSearchInPathsPredicate      ,
    noUtilsFileSearchInPathsPredicate       ,
    noUtilsFileSearchInPathsPredicate_WithClosures,
    wrap_UtilsFileSearchInPathsPredicate    ,


-- ** UtilsPredicateStr #signal:UtilsPredicateStr#

    C_UtilsPredicateStr                     ,
    UtilsPredicateStr                       ,
    dynamic_UtilsPredicateStr               ,
    genClosure_UtilsPredicateStr            ,
    mk_UtilsPredicateStr                    ,
    noUtilsPredicateStr                     ,
    wrap_UtilsPredicateStr                  ,


-- ** VpnIterFunc #signal:VpnIterFunc#

    C_VpnIterFunc                           ,
    VpnIterFunc                             ,
    VpnIterFunc_WithClosures                ,
    drop_closures_VpnIterFunc               ,
    dynamic_VpnIterFunc                     ,
    genClosure_VpnIterFunc                  ,
    mk_VpnIterFunc                          ,
    noVpnIterFunc                           ,
    noVpnIterFunc_WithClosures              ,
    wrap_VpnIterFunc                        ,




    ) where

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

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

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GLib.Structs.KeyFile as GLib.KeyFile
import qualified GI.GLib.Structs.MainContext as GLib.MainContext
import qualified GI.GLib.Structs.VariantType as GLib.VariantType
import qualified GI.GObject.Flags as GObject.Flags
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 {-# 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.SecretAgentOld as NM.SecretAgentOld
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.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.KeyfileHandlerData as NM.KeyfileHandlerData
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.GLib.Structs.KeyFile as GLib.KeyFile
import qualified GI.GObject.Flags as GObject.Flags
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.SecretAgentOld as NM.SecretAgentOld
import {-# SOURCE #-} qualified GI.NM.Objects.Setting as NM.Setting
import {-# SOURCE #-} qualified GI.NM.Structs.KeyfileHandlerData as NM.KeyfileHandlerData

#endif

-- callback VpnIterFunc
{- Callable
  { returnType = Nothing
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , args =
      [ Arg
          { argCName = "key"
          , argType = TBasicType TUTF8
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the name of the data or secret item"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "value"
          , argType = TBasicType TUTF8
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the value of the data or secret item"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText =
                    Just
                      "User data passed to nm_setting_vpn_foreach_data_item() or\nnm_setting_vpn_foreach_secret()"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = True
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_VpnIterFunc =
    CString ->
    CString ->
    Ptr () ->
    IO ()

-- Args: [ Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the data or secret item"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value of the data or secret item"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "User data passed to nm_setting_vpn_foreach_data_item() or\nnm_setting_vpn_foreach_secret()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_VpnIterFunc :: FunPtr C_VpnIterFunc -> C_VpnIterFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_VpnIterFunc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_VpnIterFunc
    -> T.Text
    -- ^ /@key@/: the name of the data or secret item
    -> T.Text
    -- ^ /@value@/: the value of the data or secret item
    -> Ptr ()
    -- ^ /@userData@/: User data passed to 'GI.NM.Objects.SettingVpn.settingVpnForeachDataItem' or
    -- 'GI.NM.Objects.SettingVpn.settingVpnForeachSecret'
    -> m ()
dynamic_VpnIterFunc :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_VpnIterFunc -> Text -> Text -> Ptr () -> m ()
dynamic_VpnIterFunc FunPtr C_VpnIterFunc
__funPtr Text
key Text
value Ptr ()
userData = 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
    CString
key' <- Text -> IO CString
textToCString Text
key
    CString
value' <- Text -> IO CString
textToCString Text
value
    (FunPtr C_VpnIterFunc -> C_VpnIterFunc
__dynamic_C_VpnIterFunc FunPtr C_VpnIterFunc
__funPtr) CString
key' CString
value' Ptr ()
userData
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Generate a function pointer callable from C code, from a `C_VpnIterFunc`.
foreign import ccall "wrapper"
    mk_VpnIterFunc :: C_VpnIterFunc -> IO (FunPtr C_VpnIterFunc)

-- | /No description available in the introspection data./
type VpnIterFunc =
    T.Text
    -- ^ /@key@/: the name of the data or secret item
    -> T.Text
    -- ^ /@value@/: the value of the data or secret item
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `VpnIterFunc`@.
noVpnIterFunc :: Maybe VpnIterFunc
noVpnIterFunc :: Maybe VpnIterFunc
noVpnIterFunc = Maybe VpnIterFunc
forall a. Maybe a
Nothing

-- | /No description available in the introspection data./
type VpnIterFunc_WithClosures =
    T.Text
    -- ^ /@key@/: the name of the data or secret item
    -> T.Text
    -- ^ /@value@/: the value of the data or secret item
    -> Ptr ()
    -- ^ /@userData@/: User data passed to 'GI.NM.Objects.SettingVpn.settingVpnForeachDataItem' or
    -- 'GI.NM.Objects.SettingVpn.settingVpnForeachSecret'
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `VpnIterFunc_WithClosures`@.
noVpnIterFunc_WithClosures :: Maybe VpnIterFunc_WithClosures
noVpnIterFunc_WithClosures :: Maybe VpnIterFunc_WithClosures
noVpnIterFunc_WithClosures = Maybe VpnIterFunc_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_VpnIterFunc :: VpnIterFunc -> VpnIterFunc_WithClosures
drop_closures_VpnIterFunc :: VpnIterFunc -> VpnIterFunc_WithClosures
drop_closures_VpnIterFunc VpnIterFunc
_f Text
key Text
value Ptr ()
_ = VpnIterFunc
_f Text
key Text
value

-- | Wrap the callback into a `GClosure`.
genClosure_VpnIterFunc :: MonadIO m => VpnIterFunc -> m (GClosure C_VpnIterFunc)
genClosure_VpnIterFunc :: forall (m :: * -> *).
MonadIO m =>
VpnIterFunc -> m (GClosure C_VpnIterFunc)
genClosure_VpnIterFunc VpnIterFunc
cb = IO (GClosure C_VpnIterFunc) -> m (GClosure C_VpnIterFunc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_VpnIterFunc) -> m (GClosure C_VpnIterFunc))
-> IO (GClosure C_VpnIterFunc) -> m (GClosure C_VpnIterFunc)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: VpnIterFunc_WithClosures
cb' = VpnIterFunc -> VpnIterFunc_WithClosures
drop_closures_VpnIterFunc VpnIterFunc
cb
    let cb'' :: C_VpnIterFunc
cb'' = Maybe (Ptr (FunPtr C_VpnIterFunc))
-> VpnIterFunc_WithClosures -> C_VpnIterFunc
wrap_VpnIterFunc Maybe (Ptr (FunPtr C_VpnIterFunc))
forall a. Maybe a
Nothing VpnIterFunc_WithClosures
cb'
    C_VpnIterFunc -> IO (FunPtr C_VpnIterFunc)
mk_VpnIterFunc C_VpnIterFunc
cb'' IO (FunPtr C_VpnIterFunc)
-> (FunPtr C_VpnIterFunc -> IO (GClosure C_VpnIterFunc))
-> IO (GClosure C_VpnIterFunc)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_VpnIterFunc -> IO (GClosure C_VpnIterFunc)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `VpnIterFunc` into a `C_VpnIterFunc`.
wrap_VpnIterFunc :: 
    Maybe (Ptr (FunPtr C_VpnIterFunc)) ->
    VpnIterFunc_WithClosures ->
    C_VpnIterFunc
wrap_VpnIterFunc :: Maybe (Ptr (FunPtr C_VpnIterFunc))
-> VpnIterFunc_WithClosures -> C_VpnIterFunc
wrap_VpnIterFunc Maybe (Ptr (FunPtr C_VpnIterFunc))
gi'funptrptr VpnIterFunc_WithClosures
gi'cb CString
key CString
value Ptr ()
userData = do
    Text
key' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
key
    Text
value' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
value
    VpnIterFunc_WithClosures
gi'cb  Text
key' Text
value' Ptr ()
userData
    Maybe (Ptr (FunPtr C_VpnIterFunc)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_VpnIterFunc))
gi'funptrptr


-- callback UtilsPredicateStr
{- Callable
  { returnType = Just (TBasicType TBoolean)
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation
        { rawDocText = Just "%TRUE if the predicate function matches."
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "str"
          , argType = TBasicType TUTF8
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the name to check." , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "This function takes a string argument and returns either %TRUE or %FALSE.\nIt is a general purpose predicate, for example used by nm_setting_option_clear_by_name()."
        , sinceVersion = Just "1.26"
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_UtilsPredicateStr =
    CString ->
    IO CInt

-- Args: [ Arg
--           { argCName = "str"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name to check." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_UtilsPredicateStr :: FunPtr C_UtilsPredicateStr -> C_UtilsPredicateStr

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_UtilsPredicateStr ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_UtilsPredicateStr
    -> T.Text
    -- ^ /@str@/: the name to check.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the predicate function matches.
dynamic_UtilsPredicateStr :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_UtilsPredicateStr -> Text -> m Bool
dynamic_UtilsPredicateStr FunPtr C_UtilsPredicateStr
__funPtr Text
str = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    CString
str' <- Text -> IO CString
textToCString Text
str
    CInt
result <- (FunPtr C_UtilsPredicateStr -> C_UtilsPredicateStr
__dynamic_C_UtilsPredicateStr FunPtr C_UtilsPredicateStr
__funPtr) CString
str'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
str'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

-- | Generate a function pointer callable from C code, from a `C_UtilsPredicateStr`.
foreign import ccall "wrapper"
    mk_UtilsPredicateStr :: C_UtilsPredicateStr -> IO (FunPtr C_UtilsPredicateStr)

-- | This function takes a string argument and returns either 'P.True' or 'P.False'.
-- It is a general purpose predicate, for example used by 'GI.NM.Objects.Setting.settingOptionClearByName'.
-- 
-- /Since: 1.26/
type UtilsPredicateStr =
    T.Text
    -- ^ /@str@/: the name to check.
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if the predicate function matches.

-- | A convenience synonym for @`Nothing` :: `Maybe` `UtilsPredicateStr`@.
noUtilsPredicateStr :: Maybe UtilsPredicateStr
noUtilsPredicateStr :: Maybe UtilsPredicateStr
noUtilsPredicateStr = Maybe UtilsPredicateStr
forall a. Maybe a
Nothing

-- | Wrap the callback into a `GClosure`.
genClosure_UtilsPredicateStr :: MonadIO m => UtilsPredicateStr -> m (GClosure C_UtilsPredicateStr)
genClosure_UtilsPredicateStr :: forall (m :: * -> *).
MonadIO m =>
UtilsPredicateStr -> m (GClosure C_UtilsPredicateStr)
genClosure_UtilsPredicateStr UtilsPredicateStr
cb = IO (GClosure C_UtilsPredicateStr)
-> m (GClosure C_UtilsPredicateStr)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_UtilsPredicateStr)
 -> m (GClosure C_UtilsPredicateStr))
-> IO (GClosure C_UtilsPredicateStr)
-> m (GClosure C_UtilsPredicateStr)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_UtilsPredicateStr
cb' = Maybe (Ptr (FunPtr C_UtilsPredicateStr))
-> UtilsPredicateStr -> C_UtilsPredicateStr
wrap_UtilsPredicateStr Maybe (Ptr (FunPtr C_UtilsPredicateStr))
forall a. Maybe a
Nothing UtilsPredicateStr
cb
    C_UtilsPredicateStr -> IO (FunPtr C_UtilsPredicateStr)
mk_UtilsPredicateStr C_UtilsPredicateStr
cb' IO (FunPtr C_UtilsPredicateStr)
-> (FunPtr C_UtilsPredicateStr
    -> IO (GClosure C_UtilsPredicateStr))
-> IO (GClosure C_UtilsPredicateStr)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_UtilsPredicateStr -> IO (GClosure C_UtilsPredicateStr)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `UtilsPredicateStr` into a `C_UtilsPredicateStr`.
wrap_UtilsPredicateStr :: 
    Maybe (Ptr (FunPtr C_UtilsPredicateStr)) ->
    UtilsPredicateStr ->
    C_UtilsPredicateStr
wrap_UtilsPredicateStr :: Maybe (Ptr (FunPtr C_UtilsPredicateStr))
-> UtilsPredicateStr -> C_UtilsPredicateStr
wrap_UtilsPredicateStr Maybe (Ptr (FunPtr C_UtilsPredicateStr))
gi'funptrptr UtilsPredicateStr
gi'cb CString
str = do
    Text
str' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
str
    Bool
result <- UtilsPredicateStr
gi'cb  Text
str'
    Maybe (Ptr (FunPtr C_UtilsPredicateStr)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_UtilsPredicateStr))
gi'funptrptr
    let result' :: CInt
result' = (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
result
    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- callback UtilsFileSearchInPathsPredicate
{- Callable
  { returnType = Just (TBasicType TBoolean)
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , args =
      [ Arg
          { argCName = "filename"
          , argType = TBasicType TUTF8
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation { rawDocText = Nothing , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation { rawDocText = Nothing , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = True
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_UtilsFileSearchInPathsPredicate =
    CString ->
    Ptr () ->
    IO CInt

-- Args: [ Arg
--           { argCName = "filename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_UtilsFileSearchInPathsPredicate :: FunPtr C_UtilsFileSearchInPathsPredicate -> C_UtilsFileSearchInPathsPredicate

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_UtilsFileSearchInPathsPredicate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_UtilsFileSearchInPathsPredicate
    -> T.Text
    -> Ptr ()
    -> m Bool
dynamic_UtilsFileSearchInPathsPredicate :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_UtilsFileSearchInPathsPredicate
-> Text -> Ptr () -> m Bool
dynamic_UtilsFileSearchInPathsPredicate FunPtr C_UtilsFileSearchInPathsPredicate
__funPtr Text
filename Ptr ()
userData = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    CString
filename' <- Text -> IO CString
textToCString Text
filename
    CInt
result <- (FunPtr C_UtilsFileSearchInPathsPredicate
-> C_UtilsFileSearchInPathsPredicate
__dynamic_C_UtilsFileSearchInPathsPredicate FunPtr C_UtilsFileSearchInPathsPredicate
__funPtr) CString
filename' Ptr ()
userData
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

-- | Generate a function pointer callable from C code, from a `C_UtilsFileSearchInPathsPredicate`.
foreign import ccall "wrapper"
    mk_UtilsFileSearchInPathsPredicate :: C_UtilsFileSearchInPathsPredicate -> IO (FunPtr C_UtilsFileSearchInPathsPredicate)

-- | /No description available in the introspection data./
type UtilsFileSearchInPathsPredicate =
    T.Text
    -> IO Bool

-- | A convenience synonym for @`Nothing` :: `Maybe` `UtilsFileSearchInPathsPredicate`@.
noUtilsFileSearchInPathsPredicate :: Maybe UtilsFileSearchInPathsPredicate
noUtilsFileSearchInPathsPredicate :: Maybe UtilsPredicateStr
noUtilsFileSearchInPathsPredicate = Maybe UtilsPredicateStr
forall a. Maybe a
Nothing

-- | /No description available in the introspection data./
type UtilsFileSearchInPathsPredicate_WithClosures =
    T.Text
    -> Ptr ()
    -> IO Bool

-- | A convenience synonym for @`Nothing` :: `Maybe` `UtilsFileSearchInPathsPredicate_WithClosures`@.
noUtilsFileSearchInPathsPredicate_WithClosures :: Maybe UtilsFileSearchInPathsPredicate_WithClosures
noUtilsFileSearchInPathsPredicate_WithClosures :: Maybe UtilsFileSearchInPathsPredicate_WithClosures
noUtilsFileSearchInPathsPredicate_WithClosures = Maybe UtilsFileSearchInPathsPredicate_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_UtilsFileSearchInPathsPredicate :: UtilsFileSearchInPathsPredicate -> UtilsFileSearchInPathsPredicate_WithClosures
drop_closures_UtilsFileSearchInPathsPredicate :: UtilsPredicateStr -> UtilsFileSearchInPathsPredicate_WithClosures
drop_closures_UtilsFileSearchInPathsPredicate UtilsPredicateStr
_f Text
filename Ptr ()
_ = UtilsPredicateStr
_f Text
filename

-- | Wrap the callback into a `GClosure`.
genClosure_UtilsFileSearchInPathsPredicate :: MonadIO m => UtilsFileSearchInPathsPredicate -> m (GClosure C_UtilsFileSearchInPathsPredicate)
genClosure_UtilsFileSearchInPathsPredicate :: forall (m :: * -> *).
MonadIO m =>
UtilsPredicateStr -> m (GClosure C_UtilsFileSearchInPathsPredicate)
genClosure_UtilsFileSearchInPathsPredicate UtilsPredicateStr
cb = IO (GClosure C_UtilsFileSearchInPathsPredicate)
-> m (GClosure C_UtilsFileSearchInPathsPredicate)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_UtilsFileSearchInPathsPredicate)
 -> m (GClosure C_UtilsFileSearchInPathsPredicate))
-> IO (GClosure C_UtilsFileSearchInPathsPredicate)
-> m (GClosure C_UtilsFileSearchInPathsPredicate)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: UtilsFileSearchInPathsPredicate_WithClosures
cb' = UtilsPredicateStr -> UtilsFileSearchInPathsPredicate_WithClosures
drop_closures_UtilsFileSearchInPathsPredicate UtilsPredicateStr
cb
    let cb'' :: C_UtilsFileSearchInPathsPredicate
cb'' = Maybe (Ptr (FunPtr C_UtilsFileSearchInPathsPredicate))
-> UtilsFileSearchInPathsPredicate_WithClosures
-> C_UtilsFileSearchInPathsPredicate
wrap_UtilsFileSearchInPathsPredicate Maybe (Ptr (FunPtr C_UtilsFileSearchInPathsPredicate))
forall a. Maybe a
Nothing UtilsFileSearchInPathsPredicate_WithClosures
cb'
    C_UtilsFileSearchInPathsPredicate
-> IO (FunPtr C_UtilsFileSearchInPathsPredicate)
mk_UtilsFileSearchInPathsPredicate C_UtilsFileSearchInPathsPredicate
cb'' IO (FunPtr C_UtilsFileSearchInPathsPredicate)
-> (FunPtr C_UtilsFileSearchInPathsPredicate
    -> IO (GClosure C_UtilsFileSearchInPathsPredicate))
-> IO (GClosure C_UtilsFileSearchInPathsPredicate)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_UtilsFileSearchInPathsPredicate
-> IO (GClosure C_UtilsFileSearchInPathsPredicate)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `UtilsFileSearchInPathsPredicate` into a `C_UtilsFileSearchInPathsPredicate`.
wrap_UtilsFileSearchInPathsPredicate :: 
    Maybe (Ptr (FunPtr C_UtilsFileSearchInPathsPredicate)) ->
    UtilsFileSearchInPathsPredicate_WithClosures ->
    C_UtilsFileSearchInPathsPredicate
wrap_UtilsFileSearchInPathsPredicate :: Maybe (Ptr (FunPtr C_UtilsFileSearchInPathsPredicate))
-> UtilsFileSearchInPathsPredicate_WithClosures
-> C_UtilsFileSearchInPathsPredicate
wrap_UtilsFileSearchInPathsPredicate Maybe (Ptr (FunPtr C_UtilsFileSearchInPathsPredicate))
gi'funptrptr UtilsFileSearchInPathsPredicate_WithClosures
gi'cb CString
filename Ptr ()
userData = do
    Text
filename' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
filename
    Bool
result <- UtilsFileSearchInPathsPredicate_WithClosures
gi'cb  Text
filename' Ptr ()
userData
    Maybe (Ptr (FunPtr C_UtilsFileSearchInPathsPredicate)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_UtilsFileSearchInPathsPredicate))
gi'funptrptr
    let result' :: CInt
result' = (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
result
    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- callback UtilsCheckFilePredicate
{- Callable
  { returnType = Just (TBasicType TBoolean)
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , args =
      [ Arg
          { argCName = "filename"
          , argType = TBasicType TUTF8
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation { rawDocText = Nothing , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "stat"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation { rawDocText = Nothing , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation { rawDocText = Nothing , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = True
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = True
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_UtilsCheckFilePredicate =
    CString ->
    Ptr () ->
    Ptr () ->
    Ptr (Ptr GError) ->
    IO CInt

-- Args: [ Arg
--           { argCName = "filename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stat"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_UtilsCheckFilePredicate :: FunPtr C_UtilsCheckFilePredicate -> C_UtilsCheckFilePredicate

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_UtilsCheckFilePredicate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_UtilsCheckFilePredicate
    -> T.Text
    -> Ptr ()
    -> Ptr ()
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
dynamic_UtilsCheckFilePredicate :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_UtilsCheckFilePredicate
-> Text -> Ptr () -> Ptr () -> m ()
dynamic_UtilsCheckFilePredicate FunPtr C_UtilsCheckFilePredicate
__funPtr Text
filename Ptr ()
stat Ptr ()
userData = 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
    CString
filename' <- Text -> IO CString
textToCString Text
filename
    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
$ (FunPtr C_UtilsCheckFilePredicate -> C_UtilsCheckFilePredicate
__dynamic_C_UtilsCheckFilePredicate FunPtr C_UtilsCheckFilePredicate
__funPtr) CString
filename' Ptr ()
stat Ptr ()
userData
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
        () -> 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
filename'
     )

-- | Generate a function pointer callable from C code, from a `C_UtilsCheckFilePredicate`.
foreign import ccall "wrapper"
    mk_UtilsCheckFilePredicate :: C_UtilsCheckFilePredicate -> IO (FunPtr C_UtilsCheckFilePredicate)

-- | /No description available in the introspection data./
type UtilsCheckFilePredicate =
    T.Text
    -> Ptr ()
    -> IO ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/

-- | A convenience synonym for @`Nothing` :: `Maybe` `UtilsCheckFilePredicate`@.
noUtilsCheckFilePredicate :: Maybe UtilsCheckFilePredicate
noUtilsCheckFilePredicate :: Maybe UtilsCheckFilePredicate
noUtilsCheckFilePredicate = Maybe UtilsCheckFilePredicate
forall a. Maybe a
Nothing

-- | /No description available in the introspection data./
type UtilsCheckFilePredicate_WithClosures =
    T.Text
    -> Ptr ()
    -> Ptr ()
    -> IO ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/

-- | A convenience synonym for @`Nothing` :: `Maybe` `UtilsCheckFilePredicate_WithClosures`@.
noUtilsCheckFilePredicate_WithClosures :: Maybe UtilsCheckFilePredicate_WithClosures
noUtilsCheckFilePredicate_WithClosures :: Maybe UtilsCheckFilePredicate_WithClosures
noUtilsCheckFilePredicate_WithClosures = Maybe UtilsCheckFilePredicate_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_UtilsCheckFilePredicate :: UtilsCheckFilePredicate -> UtilsCheckFilePredicate_WithClosures
drop_closures_UtilsCheckFilePredicate :: UtilsCheckFilePredicate -> UtilsCheckFilePredicate_WithClosures
drop_closures_UtilsCheckFilePredicate UtilsCheckFilePredicate
_f Text
filename Ptr ()
stat Ptr ()
_ = UtilsCheckFilePredicate
_f Text
filename Ptr ()
stat

-- No Haskell->C wrapper generated since the function throws.

-- callback SettingValueIterFn
{- Callable
  { returnType = Nothing
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , args =
      [ Arg
          { argCName = "setting"
          , argType = TInterface Name { namespace = "NM" , name = "Setting" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText =
                    Just
                      "The setting for which properties are being iterated, given to\nnm_setting_enumerate_values()"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "key"
          , argType = TBasicType TUTF8
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "The value/property name"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "value"
          , argType = TGValue
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "The property's value"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "flags"
          , argType =
              TInterface Name { namespace = "GObject" , name = "ParamFlags" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText =
                    Just "The property's flags, like %NM_SETTING_PARAM_SECRET"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText =
                    Just "User data passed to nm_setting_enumerate_values()"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = True
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_SettingValueIterFn =
    Ptr NM.Setting.Setting ->
    CString ->
    Ptr GValue ->
    CUInt ->
    Ptr () ->
    IO ()

-- Args: [ Arg
--           { argCName = "setting"
--           , argType = TInterface Name { namespace = "NM" , name = "Setting" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The setting for which properties are being iterated, given to\nnm_setting_enumerate_values()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value/property name"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The property's value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "ParamFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The property's flags, like %NM_SETTING_PARAM_SECRET"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "User data passed to nm_setting_enumerate_values()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_SettingValueIterFn :: FunPtr C_SettingValueIterFn -> C_SettingValueIterFn

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_SettingValueIterFn ::
    (B.CallStack.HasCallStack, MonadIO m, NM.Setting.IsSetting a) =>
    FunPtr C_SettingValueIterFn
    -> a
    -- ^ /@setting@/: The setting for which properties are being iterated, given to
    -- 'GI.NM.Objects.Setting.settingEnumerateValues'
    -> T.Text
    -- ^ /@key@/: The value\/property name
    -> GValue
    -- ^ /@value@/: The property\'s value
    -> [GObject.Flags.ParamFlags]
    -- ^ /@flags@/: The property\'s flags, like 'GI.NM.Constants.SETTING_PARAM_SECRET'
    -> Ptr ()
    -- ^ /@userData@/: User data passed to 'GI.NM.Objects.Setting.settingEnumerateValues'
    -> m ()
dynamic_SettingValueIterFn :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSetting a) =>
FunPtr C_SettingValueIterFn
-> a -> Text -> GValue -> [ParamFlags] -> Ptr () -> m ()
dynamic_SettingValueIterFn FunPtr C_SettingValueIterFn
__funPtr a
setting Text
key GValue
value [ParamFlags]
flags Ptr ()
userData = 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 Setting
setting' <- a -> IO (Ptr Setting)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
    CString
key' <- Text -> IO CString
textToCString Text
key
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    let flags' :: CUInt
flags' = [ParamFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ParamFlags]
flags
    (FunPtr C_SettingValueIterFn -> C_SettingValueIterFn
__dynamic_C_SettingValueIterFn FunPtr C_SettingValueIterFn
__funPtr) Ptr Setting
setting' CString
key' Ptr GValue
value' CUInt
flags' Ptr ()
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Generate a function pointer callable from C code, from a `C_SettingValueIterFn`.
foreign import ccall "wrapper"
    mk_SettingValueIterFn :: C_SettingValueIterFn -> IO (FunPtr C_SettingValueIterFn)

-- | /No description available in the introspection data./
type SettingValueIterFn =
    NM.Setting.Setting
    -- ^ /@setting@/: The setting for which properties are being iterated, given to
    -- 'GI.NM.Objects.Setting.settingEnumerateValues'
    -> T.Text
    -- ^ /@key@/: The value\/property name
    -> GValue
    -- ^ /@value@/: The property\'s value
    -> [GObject.Flags.ParamFlags]
    -- ^ /@flags@/: The property\'s flags, like 'GI.NM.Constants.SETTING_PARAM_SECRET'
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `SettingValueIterFn`@.
noSettingValueIterFn :: Maybe SettingValueIterFn
noSettingValueIterFn :: Maybe SettingValueIterFn
noSettingValueIterFn = Maybe SettingValueIterFn
forall a. Maybe a
Nothing

-- | /No description available in the introspection data./
type SettingValueIterFn_WithClosures =
    NM.Setting.Setting
    -- ^ /@setting@/: The setting for which properties are being iterated, given to
    -- 'GI.NM.Objects.Setting.settingEnumerateValues'
    -> T.Text
    -- ^ /@key@/: The value\/property name
    -> GValue
    -- ^ /@value@/: The property\'s value
    -> [GObject.Flags.ParamFlags]
    -- ^ /@flags@/: The property\'s flags, like 'GI.NM.Constants.SETTING_PARAM_SECRET'
    -> Ptr ()
    -- ^ /@userData@/: User data passed to 'GI.NM.Objects.Setting.settingEnumerateValues'
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `SettingValueIterFn_WithClosures`@.
noSettingValueIterFn_WithClosures :: Maybe SettingValueIterFn_WithClosures
noSettingValueIterFn_WithClosures :: Maybe SettingValueIterFn_WithClosures
noSettingValueIterFn_WithClosures = Maybe SettingValueIterFn_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_SettingValueIterFn :: SettingValueIterFn -> SettingValueIterFn_WithClosures
drop_closures_SettingValueIterFn :: SettingValueIterFn -> SettingValueIterFn_WithClosures
drop_closures_SettingValueIterFn SettingValueIterFn
_f Setting
setting Text
key GValue
value [ParamFlags]
flags Ptr ()
_ = SettingValueIterFn
_f Setting
setting Text
key GValue
value [ParamFlags]
flags

-- | Wrap the callback into a `GClosure`.
genClosure_SettingValueIterFn :: MonadIO m => SettingValueIterFn -> m (GClosure C_SettingValueIterFn)
genClosure_SettingValueIterFn :: forall (m :: * -> *).
MonadIO m =>
SettingValueIterFn -> m (GClosure C_SettingValueIterFn)
genClosure_SettingValueIterFn SettingValueIterFn
cb = IO (GClosure C_SettingValueIterFn)
-> m (GClosure C_SettingValueIterFn)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_SettingValueIterFn)
 -> m (GClosure C_SettingValueIterFn))
-> IO (GClosure C_SettingValueIterFn)
-> m (GClosure C_SettingValueIterFn)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: SettingValueIterFn_WithClosures
cb' = SettingValueIterFn -> SettingValueIterFn_WithClosures
drop_closures_SettingValueIterFn SettingValueIterFn
cb
    let cb'' :: C_SettingValueIterFn
cb'' = Maybe (Ptr (FunPtr C_SettingValueIterFn))
-> SettingValueIterFn_WithClosures -> C_SettingValueIterFn
wrap_SettingValueIterFn Maybe (Ptr (FunPtr C_SettingValueIterFn))
forall a. Maybe a
Nothing SettingValueIterFn_WithClosures
cb'
    C_SettingValueIterFn -> IO (FunPtr C_SettingValueIterFn)
mk_SettingValueIterFn C_SettingValueIterFn
cb'' IO (FunPtr C_SettingValueIterFn)
-> (FunPtr C_SettingValueIterFn
    -> IO (GClosure C_SettingValueIterFn))
-> IO (GClosure C_SettingValueIterFn)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_SettingValueIterFn -> IO (GClosure C_SettingValueIterFn)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `SettingValueIterFn` into a `C_SettingValueIterFn`.
wrap_SettingValueIterFn :: 
    Maybe (Ptr (FunPtr C_SettingValueIterFn)) ->
    SettingValueIterFn_WithClosures ->
    C_SettingValueIterFn
wrap_SettingValueIterFn :: Maybe (Ptr (FunPtr C_SettingValueIterFn))
-> SettingValueIterFn_WithClosures -> C_SettingValueIterFn
wrap_SettingValueIterFn Maybe (Ptr (FunPtr C_SettingValueIterFn))
gi'funptrptr SettingValueIterFn_WithClosures
gi'cb Ptr Setting
setting CString
key Ptr GValue
value CUInt
flags Ptr ()
userData = do
    Setting
setting' <- ((ManagedPtr Setting -> Setting) -> Ptr Setting -> IO Setting
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Setting -> Setting
NM.Setting.Setting) Ptr Setting
setting
    Text
key' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
key
    GValue
value' <- Ptr GValue -> IO GValue
B.GValue.newGValueFromPtr Ptr GValue
value
    let flags' :: [ParamFlags]
flags' = CUInt -> [ParamFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
flags
    SettingValueIterFn_WithClosures
gi'cb  Setting
setting' Text
key' GValue
value' [ParamFlags]
flags' Ptr ()
userData
    Maybe (Ptr (FunPtr C_SettingValueIterFn)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_SettingValueIterFn))
gi'funptrptr


-- callback SettingClearSecretsWithFlagsFn
{- Callable
  { returnType = Just (TBasicType TBoolean)
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just "%TRUE to clear the secret, %FALSE to not clear the secret"
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "setting"
          , argType = TInterface Name { namespace = "NM" , name = "Setting" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText =
                    Just "The setting for which secrets are being iterated"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "secret"
          , argType = TBasicType TUTF8
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "The secret's name" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "flags"
          , argType =
              TInterface Name { namespace = "NM" , name = "SettingSecretFlags" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText =
                    Just "The secret's flags, eg %NM_SETTING_SECRET_FLAG_AGENT_OWNED"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText =
                    Just "User data passed to nm_connection_clear_secrets_with_flags()"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = True
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_SettingClearSecretsWithFlagsFn =
    Ptr NM.Setting.Setting ->
    CString ->
    CUInt ->
    Ptr () ->
    IO CInt

-- Args: [ Arg
--           { argCName = "setting"
--           , argType = TInterface Name { namespace = "NM" , name = "Setting" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The setting for which secrets are being iterated"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "secret"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The secret's name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SettingSecretFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The secret's flags, eg %NM_SETTING_SECRET_FLAG_AGENT_OWNED"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "User data passed to nm_connection_clear_secrets_with_flags()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_SettingClearSecretsWithFlagsFn :: FunPtr C_SettingClearSecretsWithFlagsFn -> C_SettingClearSecretsWithFlagsFn

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_SettingClearSecretsWithFlagsFn ::
    (B.CallStack.HasCallStack, MonadIO m, NM.Setting.IsSetting a) =>
    FunPtr C_SettingClearSecretsWithFlagsFn
    -> a
    -- ^ /@setting@/: The setting for which secrets are being iterated
    -> T.Text
    -- ^ /@secret@/: The secret\'s name
    -> [NM.Flags.SettingSecretFlags]
    -- ^ /@flags@/: The secret\'s flags, eg 'GI.NM.Flags.SettingSecretFlagsAgentOwned'
    -> Ptr ()
    -- ^ /@userData@/: User data passed to 'GI.NM.Interfaces.Connection.connectionClearSecretsWithFlags'
    -> m Bool
    -- ^ __Returns:__ 'P.True' to clear the secret, 'P.False' to not clear the secret
dynamic_SettingClearSecretsWithFlagsFn :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSetting a) =>
FunPtr C_SettingClearSecretsWithFlagsFn
-> a -> Text -> [SettingSecretFlags] -> Ptr () -> m Bool
dynamic_SettingClearSecretsWithFlagsFn FunPtr C_SettingClearSecretsWithFlagsFn
__funPtr a
setting Text
secret [SettingSecretFlags]
flags Ptr ()
userData = 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 Setting
setting' <- a -> IO (Ptr Setting)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
    CString
secret' <- Text -> IO CString
textToCString Text
secret
    let flags' :: CUInt
flags' = [SettingSecretFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SettingSecretFlags]
flags
    CInt
result <- (FunPtr C_SettingClearSecretsWithFlagsFn
-> C_SettingClearSecretsWithFlagsFn
__dynamic_C_SettingClearSecretsWithFlagsFn FunPtr C_SettingClearSecretsWithFlagsFn
__funPtr) Ptr Setting
setting' CString
secret' CUInt
flags' Ptr ()
userData
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
secret'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

-- | Generate a function pointer callable from C code, from a `C_SettingClearSecretsWithFlagsFn`.
foreign import ccall "wrapper"
    mk_SettingClearSecretsWithFlagsFn :: C_SettingClearSecretsWithFlagsFn -> IO (FunPtr C_SettingClearSecretsWithFlagsFn)

-- | /No description available in the introspection data./
type SettingClearSecretsWithFlagsFn =
    NM.Setting.Setting
    -- ^ /@setting@/: The setting for which secrets are being iterated
    -> T.Text
    -- ^ /@secret@/: The secret\'s name
    -> [NM.Flags.SettingSecretFlags]
    -- ^ /@flags@/: The secret\'s flags, eg 'GI.NM.Flags.SettingSecretFlagsAgentOwned'
    -> IO Bool
    -- ^ __Returns:__ 'P.True' to clear the secret, 'P.False' to not clear the secret

-- | A convenience synonym for @`Nothing` :: `Maybe` `SettingClearSecretsWithFlagsFn`@.
noSettingClearSecretsWithFlagsFn :: Maybe SettingClearSecretsWithFlagsFn
noSettingClearSecretsWithFlagsFn :: Maybe SettingClearSecretsWithFlagsFn
noSettingClearSecretsWithFlagsFn = Maybe SettingClearSecretsWithFlagsFn
forall a. Maybe a
Nothing

-- | /No description available in the introspection data./
type SettingClearSecretsWithFlagsFn_WithClosures =
    NM.Setting.Setting
    -- ^ /@setting@/: The setting for which secrets are being iterated
    -> T.Text
    -- ^ /@secret@/: The secret\'s name
    -> [NM.Flags.SettingSecretFlags]
    -- ^ /@flags@/: The secret\'s flags, eg 'GI.NM.Flags.SettingSecretFlagsAgentOwned'
    -> Ptr ()
    -- ^ /@userData@/: User data passed to 'GI.NM.Interfaces.Connection.connectionClearSecretsWithFlags'
    -> IO Bool
    -- ^ __Returns:__ 'P.True' to clear the secret, 'P.False' to not clear the secret

-- | A convenience synonym for @`Nothing` :: `Maybe` `SettingClearSecretsWithFlagsFn_WithClosures`@.
noSettingClearSecretsWithFlagsFn_WithClosures :: Maybe SettingClearSecretsWithFlagsFn_WithClosures
noSettingClearSecretsWithFlagsFn_WithClosures :: Maybe SettingClearSecretsWithFlagsFn_WithClosures
noSettingClearSecretsWithFlagsFn_WithClosures = Maybe SettingClearSecretsWithFlagsFn_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_SettingClearSecretsWithFlagsFn :: SettingClearSecretsWithFlagsFn -> SettingClearSecretsWithFlagsFn_WithClosures
drop_closures_SettingClearSecretsWithFlagsFn :: SettingClearSecretsWithFlagsFn
-> SettingClearSecretsWithFlagsFn_WithClosures
drop_closures_SettingClearSecretsWithFlagsFn SettingClearSecretsWithFlagsFn
_f Setting
setting Text
secret [SettingSecretFlags]
flags Ptr ()
_ = SettingClearSecretsWithFlagsFn
_f Setting
setting Text
secret [SettingSecretFlags]
flags

-- | Wrap the callback into a `GClosure`.
genClosure_SettingClearSecretsWithFlagsFn :: MonadIO m => SettingClearSecretsWithFlagsFn -> m (GClosure C_SettingClearSecretsWithFlagsFn)
genClosure_SettingClearSecretsWithFlagsFn :: forall (m :: * -> *).
MonadIO m =>
SettingClearSecretsWithFlagsFn
-> m (GClosure C_SettingClearSecretsWithFlagsFn)
genClosure_SettingClearSecretsWithFlagsFn SettingClearSecretsWithFlagsFn
cb = IO (GClosure C_SettingClearSecretsWithFlagsFn)
-> m (GClosure C_SettingClearSecretsWithFlagsFn)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_SettingClearSecretsWithFlagsFn)
 -> m (GClosure C_SettingClearSecretsWithFlagsFn))
-> IO (GClosure C_SettingClearSecretsWithFlagsFn)
-> m (GClosure C_SettingClearSecretsWithFlagsFn)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: SettingClearSecretsWithFlagsFn_WithClosures
cb' = SettingClearSecretsWithFlagsFn
-> SettingClearSecretsWithFlagsFn_WithClosures
drop_closures_SettingClearSecretsWithFlagsFn SettingClearSecretsWithFlagsFn
cb
    let cb'' :: C_SettingClearSecretsWithFlagsFn
cb'' = Maybe (Ptr (FunPtr C_SettingClearSecretsWithFlagsFn))
-> SettingClearSecretsWithFlagsFn_WithClosures
-> C_SettingClearSecretsWithFlagsFn
wrap_SettingClearSecretsWithFlagsFn Maybe (Ptr (FunPtr C_SettingClearSecretsWithFlagsFn))
forall a. Maybe a
Nothing SettingClearSecretsWithFlagsFn_WithClosures
cb'
    C_SettingClearSecretsWithFlagsFn
-> IO (FunPtr C_SettingClearSecretsWithFlagsFn)
mk_SettingClearSecretsWithFlagsFn C_SettingClearSecretsWithFlagsFn
cb'' IO (FunPtr C_SettingClearSecretsWithFlagsFn)
-> (FunPtr C_SettingClearSecretsWithFlagsFn
    -> IO (GClosure C_SettingClearSecretsWithFlagsFn))
-> IO (GClosure C_SettingClearSecretsWithFlagsFn)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_SettingClearSecretsWithFlagsFn
-> IO (GClosure C_SettingClearSecretsWithFlagsFn)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `SettingClearSecretsWithFlagsFn` into a `C_SettingClearSecretsWithFlagsFn`.
wrap_SettingClearSecretsWithFlagsFn :: 
    Maybe (Ptr (FunPtr C_SettingClearSecretsWithFlagsFn)) ->
    SettingClearSecretsWithFlagsFn_WithClosures ->
    C_SettingClearSecretsWithFlagsFn
wrap_SettingClearSecretsWithFlagsFn :: Maybe (Ptr (FunPtr C_SettingClearSecretsWithFlagsFn))
-> SettingClearSecretsWithFlagsFn_WithClosures
-> C_SettingClearSecretsWithFlagsFn
wrap_SettingClearSecretsWithFlagsFn Maybe (Ptr (FunPtr C_SettingClearSecretsWithFlagsFn))
gi'funptrptr SettingClearSecretsWithFlagsFn_WithClosures
gi'cb Ptr Setting
setting CString
secret CUInt
flags Ptr ()
userData = do
    Setting
setting' <- ((ManagedPtr Setting -> Setting) -> Ptr Setting -> IO Setting
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Setting -> Setting
NM.Setting.Setting) Ptr Setting
setting
    Text
secret' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
secret
    let flags' :: [SettingSecretFlags]
flags' = CUInt -> [SettingSecretFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
flags
    Bool
result <- SettingClearSecretsWithFlagsFn_WithClosures
gi'cb  Setting
setting' Text
secret' [SettingSecretFlags]
flags' Ptr ()
userData
    Maybe (Ptr (FunPtr C_SettingClearSecretsWithFlagsFn)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_SettingClearSecretsWithFlagsFn))
gi'funptrptr
    let result' :: CInt
result' = (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
result
    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- callback SecretAgentOldSaveSecretsFunc
{- Callable
  { returnType = Nothing
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , args =
      [ Arg
          { argCName = "agent"
          , argType =
              TInterface Name { namespace = "NM" , name = "SecretAgentOld" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the secret agent object"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "connection"
          , argType =
              TInterface Name { namespace = "NM" , name = "Connection" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText =
                    Just
                      "the connection for which secrets were to be saved,\nnote that this object will be unrefed after the callback has returned, use\ng_object_ref()/g_object_unref() if you want to use this object after the callback\nhas returned"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "error"
          , argType = TError
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText =
                    Just "if the saving secrets failed, give a descriptive error here"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText =
                    Just "caller-specific data to be passed to the function"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = True
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "Called as a result of a request by NM to save secrets.  When the\n#NMSecretAgentOld subclass has finished saving the secrets, this function\nshould be called."
        , sinceVersion = Nothing
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_SecretAgentOldSaveSecretsFunc =
    Ptr NM.SecretAgentOld.SecretAgentOld ->
    Ptr NM.Connection.Connection ->
    Ptr GError ->
    Ptr () ->
    IO ()

-- Args: [ Arg
--           { argCName = "agent"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SecretAgentOld" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret agent object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "connection"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "Connection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the connection for which secrets were to be saved,\nnote that this object will be unrefed after the callback has returned, use\ng_object_ref()/g_object_unref() if you want to use this object after the callback\nhas returned"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "error"
--           , argType = TError
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "if the saving secrets failed, give a descriptive error here"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "caller-specific data to be passed to the function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_SecretAgentOldSaveSecretsFunc :: FunPtr C_SecretAgentOldSaveSecretsFunc -> C_SecretAgentOldSaveSecretsFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_SecretAgentOldSaveSecretsFunc ::
    (B.CallStack.HasCallStack, MonadIO m, NM.SecretAgentOld.IsSecretAgentOld a, NM.Connection.IsConnection b) =>
    FunPtr C_SecretAgentOldSaveSecretsFunc
    -> a
    -- ^ /@agent@/: the secret agent object
    -> b
    -- ^ /@connection@/: the connection for which secrets were to be saved,
    -- note that this object will be unrefed after the callback has returned, use
    -- 'GI.GObject.Objects.Object.objectRef'\/'GI.GObject.Objects.Object.objectUnref' if you want to use this object after the callback
    -- has returned
    -> GError
    -- ^ /@error@/: if the saving secrets failed, give a descriptive error here
    -> Ptr ()
    -- ^ /@userData@/: caller-specific data to be passed to the function
    -> m ()
dynamic_SecretAgentOldSaveSecretsFunc :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSecretAgentOld a, IsConnection b) =>
FunPtr C_SecretAgentOldSaveSecretsFunc
-> a -> b -> GError -> Ptr () -> m ()
dynamic_SecretAgentOldSaveSecretsFunc FunPtr C_SecretAgentOldSaveSecretsFunc
__funPtr a
agent b
connection GError
error_ Ptr ()
userData = 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 SecretAgentOld
agent' <- a -> IO (Ptr SecretAgentOld)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
agent
    Ptr Connection
connection' <- b -> IO (Ptr Connection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
connection
    Ptr GError
error_' <- GError -> IO (Ptr GError)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GError
error_
    (FunPtr C_SecretAgentOldSaveSecretsFunc
-> C_SecretAgentOldSaveSecretsFunc
__dynamic_C_SecretAgentOldSaveSecretsFunc FunPtr C_SecretAgentOldSaveSecretsFunc
__funPtr) Ptr SecretAgentOld
agent' Ptr Connection
connection' Ptr GError
error_' Ptr ()
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
agent
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
connection
    GError -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GError
error_
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Generate a function pointer callable from C code, from a `C_SecretAgentOldSaveSecretsFunc`.
foreign import ccall "wrapper"
    mk_SecretAgentOldSaveSecretsFunc :: C_SecretAgentOldSaveSecretsFunc -> IO (FunPtr C_SecretAgentOldSaveSecretsFunc)

-- | Called as a result of a request by NM to save secrets.  When the
-- t'GI.NM.Objects.SecretAgentOld.SecretAgentOld' subclass has finished saving the secrets, this function
-- should be called.
type SecretAgentOldSaveSecretsFunc =
    NM.SecretAgentOld.SecretAgentOld
    -- ^ /@agent@/: the secret agent object
    -> NM.Connection.Connection
    -- ^ /@connection@/: the connection for which secrets were to be saved,
    -- note that this object will be unrefed after the callback has returned, use
    -- 'GI.GObject.Objects.Object.objectRef'\/'GI.GObject.Objects.Object.objectUnref' if you want to use this object after the callback
    -- has returned
    -> GError
    -- ^ /@error@/: if the saving secrets failed, give a descriptive error here
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `SecretAgentOldSaveSecretsFunc`@.
noSecretAgentOldSaveSecretsFunc :: Maybe SecretAgentOldSaveSecretsFunc
noSecretAgentOldSaveSecretsFunc :: Maybe SecretAgentOldSaveSecretsFunc
noSecretAgentOldSaveSecretsFunc = Maybe SecretAgentOldSaveSecretsFunc
forall a. Maybe a
Nothing

-- | Called as a result of a request by NM to save secrets.  When the
-- t'GI.NM.Objects.SecretAgentOld.SecretAgentOld' subclass has finished saving the secrets, this function
-- should be called.
type SecretAgentOldSaveSecretsFunc_WithClosures =
    NM.SecretAgentOld.SecretAgentOld
    -- ^ /@agent@/: the secret agent object
    -> NM.Connection.Connection
    -- ^ /@connection@/: the connection for which secrets were to be saved,
    -- note that this object will be unrefed after the callback has returned, use
    -- 'GI.GObject.Objects.Object.objectRef'\/'GI.GObject.Objects.Object.objectUnref' if you want to use this object after the callback
    -- has returned
    -> GError
    -- ^ /@error@/: if the saving secrets failed, give a descriptive error here
    -> Ptr ()
    -- ^ /@userData@/: caller-specific data to be passed to the function
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `SecretAgentOldSaveSecretsFunc_WithClosures`@.
noSecretAgentOldSaveSecretsFunc_WithClosures :: Maybe SecretAgentOldSaveSecretsFunc_WithClosures
noSecretAgentOldSaveSecretsFunc_WithClosures :: Maybe SecretAgentOldSaveSecretsFunc_WithClosures
noSecretAgentOldSaveSecretsFunc_WithClosures = Maybe SecretAgentOldSaveSecretsFunc_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_SecretAgentOldSaveSecretsFunc :: SecretAgentOldSaveSecretsFunc -> SecretAgentOldSaveSecretsFunc_WithClosures
drop_closures_SecretAgentOldSaveSecretsFunc :: SecretAgentOldSaveSecretsFunc
-> SecretAgentOldSaveSecretsFunc_WithClosures
drop_closures_SecretAgentOldSaveSecretsFunc SecretAgentOldSaveSecretsFunc
_f SecretAgentOld
agent Connection
connection GError
error_ Ptr ()
_ = SecretAgentOldSaveSecretsFunc
_f SecretAgentOld
agent Connection
connection GError
error_

-- | Wrap the callback into a `GClosure`.
genClosure_SecretAgentOldSaveSecretsFunc :: MonadIO m => SecretAgentOldSaveSecretsFunc -> m (GClosure C_SecretAgentOldSaveSecretsFunc)
genClosure_SecretAgentOldSaveSecretsFunc :: forall (m :: * -> *).
MonadIO m =>
SecretAgentOldSaveSecretsFunc
-> m (GClosure C_SecretAgentOldSaveSecretsFunc)
genClosure_SecretAgentOldSaveSecretsFunc SecretAgentOldSaveSecretsFunc
cb = IO (GClosure C_SecretAgentOldSaveSecretsFunc)
-> m (GClosure C_SecretAgentOldSaveSecretsFunc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_SecretAgentOldSaveSecretsFunc)
 -> m (GClosure C_SecretAgentOldSaveSecretsFunc))
-> IO (GClosure C_SecretAgentOldSaveSecretsFunc)
-> m (GClosure C_SecretAgentOldSaveSecretsFunc)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: SecretAgentOldSaveSecretsFunc_WithClosures
cb' = SecretAgentOldSaveSecretsFunc
-> SecretAgentOldSaveSecretsFunc_WithClosures
drop_closures_SecretAgentOldSaveSecretsFunc SecretAgentOldSaveSecretsFunc
cb
    let cb'' :: C_SecretAgentOldSaveSecretsFunc
cb'' = Maybe (Ptr (FunPtr C_SecretAgentOldSaveSecretsFunc))
-> SecretAgentOldSaveSecretsFunc_WithClosures
-> C_SecretAgentOldSaveSecretsFunc
wrap_SecretAgentOldSaveSecretsFunc Maybe (Ptr (FunPtr C_SecretAgentOldSaveSecretsFunc))
forall a. Maybe a
Nothing SecretAgentOldSaveSecretsFunc_WithClosures
cb'
    C_SecretAgentOldSaveSecretsFunc
-> IO (FunPtr C_SecretAgentOldSaveSecretsFunc)
mk_SecretAgentOldSaveSecretsFunc C_SecretAgentOldSaveSecretsFunc
cb'' IO (FunPtr C_SecretAgentOldSaveSecretsFunc)
-> (FunPtr C_SecretAgentOldSaveSecretsFunc
    -> IO (GClosure C_SecretAgentOldSaveSecretsFunc))
-> IO (GClosure C_SecretAgentOldSaveSecretsFunc)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_SecretAgentOldSaveSecretsFunc
-> IO (GClosure C_SecretAgentOldSaveSecretsFunc)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `SecretAgentOldSaveSecretsFunc` into a `C_SecretAgentOldSaveSecretsFunc`.
wrap_SecretAgentOldSaveSecretsFunc :: 
    Maybe (Ptr (FunPtr C_SecretAgentOldSaveSecretsFunc)) ->
    SecretAgentOldSaveSecretsFunc_WithClosures ->
    C_SecretAgentOldSaveSecretsFunc
wrap_SecretAgentOldSaveSecretsFunc :: Maybe (Ptr (FunPtr C_SecretAgentOldSaveSecretsFunc))
-> SecretAgentOldSaveSecretsFunc_WithClosures
-> C_SecretAgentOldSaveSecretsFunc
wrap_SecretAgentOldSaveSecretsFunc Maybe (Ptr (FunPtr C_SecretAgentOldSaveSecretsFunc))
gi'funptrptr SecretAgentOldSaveSecretsFunc_WithClosures
gi'cb Ptr SecretAgentOld
agent Ptr Connection
connection Ptr GError
error_ Ptr ()
userData = do
    SecretAgentOld
agent' <- ((ManagedPtr SecretAgentOld -> SecretAgentOld)
-> Ptr SecretAgentOld -> IO SecretAgentOld
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr SecretAgentOld -> SecretAgentOld
NM.SecretAgentOld.SecretAgentOld) Ptr SecretAgentOld
agent
    Connection
connection' <- ((ManagedPtr Connection -> Connection)
-> Ptr Connection -> IO Connection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Connection -> Connection
NM.Connection.Connection) Ptr Connection
connection
    GError
error_' <- ((ManagedPtr GError -> GError) -> Ptr GError -> IO GError
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr GError -> GError
GError) Ptr GError
error_
    SecretAgentOldSaveSecretsFunc_WithClosures
gi'cb  SecretAgentOld
agent' Connection
connection' GError
error_' Ptr ()
userData
    Maybe (Ptr (FunPtr C_SecretAgentOldSaveSecretsFunc)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_SecretAgentOldSaveSecretsFunc))
gi'funptrptr


-- callback SecretAgentOldGetSecretsFunc
{- Callable
  { returnType = Nothing
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , args =
      [ Arg
          { argCName = "agent"
          , argType =
              TInterface Name { namespace = "NM" , name = "SecretAgentOld" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the secret agent object"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "connection"
          , argType =
              TInterface Name { namespace = "NM" , name = "Connection" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText =
                    Just
                      "the connection for which secrets were requested,\nnote that this object will be unrefed after the callback has returned, use\ng_object_ref()/g_object_unref() if you want to use this object after the callback\nhas returned"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "secrets"
          , argType = TVariant
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText =
                    Just
                      "the #GVariant of type %NM_VARIANT_TYPE_CONNECTION containing the requested\nsecrets (as created by nm_connection_to_dbus() for example).  Each key in @secrets\nshould be the name of a #NMSetting object (like \"802-11-wireless-security\")\nand each value should be an %NM_VARIANT_TYPE_SETTING variant.  The sub-dicts\nmap string:value, where the string is the setting property name (like \"psk\")\nand the value is the secret"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "error"
          , argType = TError
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText =
                    Just "if the secrets request failed, give a descriptive error here"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText =
                    Just "caller-specific data to be passed to the function"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = True
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "Called as a result of a request by NM to retrieve secrets.  When the\n#NMSecretAgentOld subclass has finished retrieving secrets and is ready to\nreturn them, or to return an error, this function should be called with\nthose secrets or the error.\n\nTo easily create the dictionary to return the Wi-Fi PSK, you could do\nsomething like this:\n<example>\n <title>Creating a secrets dictionary</title>\n <programlisting>\n  NMConnection *secrets;\n  NMSettingWirelessSecurity *s_wsec;\n  GVariant *secrets_dict;\n\n  secrets = nm_simple_connection_new ();\n  s_wsec = (NMSettingWirelessSecurity *) nm_setting_wireless_security_new ();\n  g_object_set (G_OBJECT (s_wsec),\n                NM_SETTING_WIRELESS_SECURITY_PSK, \"my really cool PSK\",\n                NULL);\n  nm_connection_add_setting (secrets, NM_SETTING (s_wsec));\n  secrets_dict = nm_connection_to_dbus (secrets, NM_CONNECTION_SERIALIZE_ALL);\n\n  (call the NMSecretAgentOldGetSecretsFunc with secrets_dict)\n\n  g_object_unref (secrets);\n  g_variant_unref (secrets_dict);\n </programlisting>\n</example>"
        , sinceVersion = Nothing
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_SecretAgentOldGetSecretsFunc =
    Ptr NM.SecretAgentOld.SecretAgentOld ->
    Ptr NM.Connection.Connection ->
    Ptr GVariant ->
    Ptr GError ->
    Ptr () ->
    IO ()

-- Args: [ Arg
--           { argCName = "agent"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SecretAgentOld" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret agent object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "connection"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "Connection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the connection for which secrets were requested,\nnote that this object will be unrefed after the callback has returned, use\ng_object_ref()/g_object_unref() if you want to use this object after the callback\nhas returned"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "secrets"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #GVariant of type %NM_VARIANT_TYPE_CONNECTION containing the requested\nsecrets (as created by nm_connection_to_dbus() for example).  Each key in @secrets\nshould be the name of a #NMSetting object (like \"802-11-wireless-security\")\nand each value should be an %NM_VARIANT_TYPE_SETTING variant.  The sub-dicts\nmap string:value, where the string is the setting property name (like \"psk\")\nand the value is the secret"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "error"
--           , argType = TError
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "if the secrets request failed, give a descriptive error here"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "caller-specific data to be passed to the function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_SecretAgentOldGetSecretsFunc :: FunPtr C_SecretAgentOldGetSecretsFunc -> C_SecretAgentOldGetSecretsFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_SecretAgentOldGetSecretsFunc ::
    (B.CallStack.HasCallStack, MonadIO m, NM.SecretAgentOld.IsSecretAgentOld a, NM.Connection.IsConnection b) =>
    FunPtr C_SecretAgentOldGetSecretsFunc
    -> a
    -- ^ /@agent@/: the secret agent object
    -> b
    -- ^ /@connection@/: the connection for which secrets were requested,
    -- note that this object will be unrefed after the callback has returned, use
    -- 'GI.GObject.Objects.Object.objectRef'\/'GI.GObject.Objects.Object.objectUnref' if you want to use this object after the callback
    -- has returned
    -> GVariant
    -- ^ /@secrets@/: the t'GVariant' of type @/NM_VARIANT_TYPE_CONNECTION/@ containing the requested
    -- secrets (as created by 'GI.NM.Interfaces.Connection.connectionToDbus' for example).  Each key in /@secrets@/
    -- should be the name of a t'GI.NM.Objects.Setting.Setting' object (like \"802-11-wireless-security\")
    -- and each value should be an @/NM_VARIANT_TYPE_SETTING/@ variant.  The sub-dicts
    -- map string:value, where the string is the setting property name (like \"psk\")
    -- and the value is the secret
    -> GError
    -- ^ /@error@/: if the secrets request failed, give a descriptive error here
    -> Ptr ()
    -- ^ /@userData@/: caller-specific data to be passed to the function
    -> m ()
dynamic_SecretAgentOldGetSecretsFunc :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSecretAgentOld a, IsConnection b) =>
FunPtr C_SecretAgentOldGetSecretsFunc
-> a -> b -> GVariant -> GError -> Ptr () -> m ()
dynamic_SecretAgentOldGetSecretsFunc FunPtr C_SecretAgentOldGetSecretsFunc
__funPtr a
agent b
connection GVariant
secrets GError
error_ Ptr ()
userData = 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 SecretAgentOld
agent' <- a -> IO (Ptr SecretAgentOld)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
agent
    Ptr Connection
connection' <- b -> IO (Ptr Connection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
connection
    Ptr GVariant
secrets' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
secrets
    Ptr GError
error_' <- GError -> IO (Ptr GError)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GError
error_
    (FunPtr C_SecretAgentOldGetSecretsFunc
-> C_SecretAgentOldGetSecretsFunc
__dynamic_C_SecretAgentOldGetSecretsFunc FunPtr C_SecretAgentOldGetSecretsFunc
__funPtr) Ptr SecretAgentOld
agent' Ptr Connection
connection' Ptr GVariant
secrets' Ptr GError
error_' Ptr ()
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
agent
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
connection
    GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
secrets
    GError -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GError
error_
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Generate a function pointer callable from C code, from a `C_SecretAgentOldGetSecretsFunc`.
foreign import ccall "wrapper"
    mk_SecretAgentOldGetSecretsFunc :: C_SecretAgentOldGetSecretsFunc -> IO (FunPtr C_SecretAgentOldGetSecretsFunc)

-- | Called as a result of a request by NM to retrieve secrets.  When the
-- t'GI.NM.Objects.SecretAgentOld.SecretAgentOld' subclass has finished retrieving secrets and is ready to
-- return them, or to return an error, this function should be called with
-- those secrets or the error.
-- 
-- To easily create the dictionary to return the Wi-Fi PSK, you could do
-- something like this:
-- \<example>
--  \<title>Creating a secrets dictionary\<\/title>
--  \<programlisting>
--   NMConnection *secrets;
--   NMSettingWirelessSecurity *s_wsec;
--   GVariant *secrets_dict;
-- 
--   secrets = nm_simple_connection_new ();
--   s_wsec = (NMSettingWirelessSecurity *) nm_setting_wireless_security_new ();
--   g_object_set (G_OBJECT (s_wsec),
--                 NM_SETTING_WIRELESS_SECURITY_PSK, \"my really cool PSK\",
--                 NULL);
--   nm_connection_add_setting (secrets, NM_SETTING (s_wsec));
--   secrets_dict = nm_connection_to_dbus (secrets, NM_CONNECTION_SERIALIZE_ALL);
-- 
--   (call the NMSecretAgentOldGetSecretsFunc with secrets_dict)
-- 
--   g_object_unref (secrets);
--   g_variant_unref (secrets_dict);
--  \<\/programlisting>
-- \<\/example>
type SecretAgentOldGetSecretsFunc =
    NM.SecretAgentOld.SecretAgentOld
    -- ^ /@agent@/: the secret agent object
    -> NM.Connection.Connection
    -- ^ /@connection@/: the connection for which secrets were requested,
    -- note that this object will be unrefed after the callback has returned, use
    -- 'GI.GObject.Objects.Object.objectRef'\/'GI.GObject.Objects.Object.objectUnref' if you want to use this object after the callback
    -- has returned
    -> GVariant
    -- ^ /@secrets@/: the t'GVariant' of type @/NM_VARIANT_TYPE_CONNECTION/@ containing the requested
    -- secrets (as created by 'GI.NM.Interfaces.Connection.connectionToDbus' for example).  Each key in /@secrets@/
    -- should be the name of a t'GI.NM.Objects.Setting.Setting' object (like \"802-11-wireless-security\")
    -- and each value should be an @/NM_VARIANT_TYPE_SETTING/@ variant.  The sub-dicts
    -- map string:value, where the string is the setting property name (like \"psk\")
    -- and the value is the secret
    -> GError
    -- ^ /@error@/: if the secrets request failed, give a descriptive error here
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `SecretAgentOldGetSecretsFunc`@.
noSecretAgentOldGetSecretsFunc :: Maybe SecretAgentOldGetSecretsFunc
noSecretAgentOldGetSecretsFunc :: Maybe SecretAgentOldGetSecretsFunc
noSecretAgentOldGetSecretsFunc = Maybe SecretAgentOldGetSecretsFunc
forall a. Maybe a
Nothing

-- | Called as a result of a request by NM to retrieve secrets.  When the
-- t'GI.NM.Objects.SecretAgentOld.SecretAgentOld' subclass has finished retrieving secrets and is ready to
-- return them, or to return an error, this function should be called with
-- those secrets or the error.
-- 
-- To easily create the dictionary to return the Wi-Fi PSK, you could do
-- something like this:
-- \<example>
--  \<title>Creating a secrets dictionary\<\/title>
--  \<programlisting>
--   NMConnection *secrets;
--   NMSettingWirelessSecurity *s_wsec;
--   GVariant *secrets_dict;
-- 
--   secrets = nm_simple_connection_new ();
--   s_wsec = (NMSettingWirelessSecurity *) nm_setting_wireless_security_new ();
--   g_object_set (G_OBJECT (s_wsec),
--                 NM_SETTING_WIRELESS_SECURITY_PSK, \"my really cool PSK\",
--                 NULL);
--   nm_connection_add_setting (secrets, NM_SETTING (s_wsec));
--   secrets_dict = nm_connection_to_dbus (secrets, NM_CONNECTION_SERIALIZE_ALL);
-- 
--   (call the NMSecretAgentOldGetSecretsFunc with secrets_dict)
-- 
--   g_object_unref (secrets);
--   g_variant_unref (secrets_dict);
--  \<\/programlisting>
-- \<\/example>
type SecretAgentOldGetSecretsFunc_WithClosures =
    NM.SecretAgentOld.SecretAgentOld
    -- ^ /@agent@/: the secret agent object
    -> NM.Connection.Connection
    -- ^ /@connection@/: the connection for which secrets were requested,
    -- note that this object will be unrefed after the callback has returned, use
    -- 'GI.GObject.Objects.Object.objectRef'\/'GI.GObject.Objects.Object.objectUnref' if you want to use this object after the callback
    -- has returned
    -> GVariant
    -- ^ /@secrets@/: the t'GVariant' of type @/NM_VARIANT_TYPE_CONNECTION/@ containing the requested
    -- secrets (as created by 'GI.NM.Interfaces.Connection.connectionToDbus' for example).  Each key in /@secrets@/
    -- should be the name of a t'GI.NM.Objects.Setting.Setting' object (like \"802-11-wireless-security\")
    -- and each value should be an @/NM_VARIANT_TYPE_SETTING/@ variant.  The sub-dicts
    -- map string:value, where the string is the setting property name (like \"psk\")
    -- and the value is the secret
    -> GError
    -- ^ /@error@/: if the secrets request failed, give a descriptive error here
    -> Ptr ()
    -- ^ /@userData@/: caller-specific data to be passed to the function
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `SecretAgentOldGetSecretsFunc_WithClosures`@.
noSecretAgentOldGetSecretsFunc_WithClosures :: Maybe SecretAgentOldGetSecretsFunc_WithClosures
noSecretAgentOldGetSecretsFunc_WithClosures :: Maybe SecretAgentOldGetSecretsFunc_WithClosures
noSecretAgentOldGetSecretsFunc_WithClosures = Maybe SecretAgentOldGetSecretsFunc_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_SecretAgentOldGetSecretsFunc :: SecretAgentOldGetSecretsFunc -> SecretAgentOldGetSecretsFunc_WithClosures
drop_closures_SecretAgentOldGetSecretsFunc :: SecretAgentOldGetSecretsFunc
-> SecretAgentOldGetSecretsFunc_WithClosures
drop_closures_SecretAgentOldGetSecretsFunc SecretAgentOldGetSecretsFunc
_f SecretAgentOld
agent Connection
connection GVariant
secrets GError
error_ Ptr ()
_ = SecretAgentOldGetSecretsFunc
_f SecretAgentOld
agent Connection
connection GVariant
secrets GError
error_

-- | Wrap the callback into a `GClosure`.
genClosure_SecretAgentOldGetSecretsFunc :: MonadIO m => SecretAgentOldGetSecretsFunc -> m (GClosure C_SecretAgentOldGetSecretsFunc)
genClosure_SecretAgentOldGetSecretsFunc :: forall (m :: * -> *).
MonadIO m =>
SecretAgentOldGetSecretsFunc
-> m (GClosure C_SecretAgentOldGetSecretsFunc)
genClosure_SecretAgentOldGetSecretsFunc SecretAgentOldGetSecretsFunc
cb = IO (GClosure C_SecretAgentOldGetSecretsFunc)
-> m (GClosure C_SecretAgentOldGetSecretsFunc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_SecretAgentOldGetSecretsFunc)
 -> m (GClosure C_SecretAgentOldGetSecretsFunc))
-> IO (GClosure C_SecretAgentOldGetSecretsFunc)
-> m (GClosure C_SecretAgentOldGetSecretsFunc)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: SecretAgentOldGetSecretsFunc_WithClosures
cb' = SecretAgentOldGetSecretsFunc
-> SecretAgentOldGetSecretsFunc_WithClosures
drop_closures_SecretAgentOldGetSecretsFunc SecretAgentOldGetSecretsFunc
cb
    let cb'' :: C_SecretAgentOldGetSecretsFunc
cb'' = Maybe (Ptr (FunPtr C_SecretAgentOldGetSecretsFunc))
-> SecretAgentOldGetSecretsFunc_WithClosures
-> C_SecretAgentOldGetSecretsFunc
wrap_SecretAgentOldGetSecretsFunc Maybe (Ptr (FunPtr C_SecretAgentOldGetSecretsFunc))
forall a. Maybe a
Nothing SecretAgentOldGetSecretsFunc_WithClosures
cb'
    C_SecretAgentOldGetSecretsFunc
-> IO (FunPtr C_SecretAgentOldGetSecretsFunc)
mk_SecretAgentOldGetSecretsFunc C_SecretAgentOldGetSecretsFunc
cb'' IO (FunPtr C_SecretAgentOldGetSecretsFunc)
-> (FunPtr C_SecretAgentOldGetSecretsFunc
    -> IO (GClosure C_SecretAgentOldGetSecretsFunc))
-> IO (GClosure C_SecretAgentOldGetSecretsFunc)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_SecretAgentOldGetSecretsFunc
-> IO (GClosure C_SecretAgentOldGetSecretsFunc)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `SecretAgentOldGetSecretsFunc` into a `C_SecretAgentOldGetSecretsFunc`.
wrap_SecretAgentOldGetSecretsFunc :: 
    Maybe (Ptr (FunPtr C_SecretAgentOldGetSecretsFunc)) ->
    SecretAgentOldGetSecretsFunc_WithClosures ->
    C_SecretAgentOldGetSecretsFunc
wrap_SecretAgentOldGetSecretsFunc :: Maybe (Ptr (FunPtr C_SecretAgentOldGetSecretsFunc))
-> SecretAgentOldGetSecretsFunc_WithClosures
-> C_SecretAgentOldGetSecretsFunc
wrap_SecretAgentOldGetSecretsFunc Maybe (Ptr (FunPtr C_SecretAgentOldGetSecretsFunc))
gi'funptrptr SecretAgentOldGetSecretsFunc_WithClosures
gi'cb Ptr SecretAgentOld
agent Ptr Connection
connection Ptr GVariant
secrets Ptr GError
error_ Ptr ()
userData = do
    SecretAgentOld
agent' <- ((ManagedPtr SecretAgentOld -> SecretAgentOld)
-> Ptr SecretAgentOld -> IO SecretAgentOld
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr SecretAgentOld -> SecretAgentOld
NM.SecretAgentOld.SecretAgentOld) Ptr SecretAgentOld
agent
    Connection
connection' <- ((ManagedPtr Connection -> Connection)
-> Ptr Connection -> IO Connection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Connection -> Connection
NM.Connection.Connection) Ptr Connection
connection
    GVariant
secrets' <- Ptr GVariant -> IO GVariant
B.GVariant.newGVariantFromPtr Ptr GVariant
secrets
    GError
error_' <- ((ManagedPtr GError -> GError) -> Ptr GError -> IO GError
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr GError -> GError
GError) Ptr GError
error_
    SecretAgentOldGetSecretsFunc_WithClosures
gi'cb  SecretAgentOld
agent' Connection
connection' GVariant
secrets' GError
error_' Ptr ()
userData
    Maybe (Ptr (FunPtr C_SecretAgentOldGetSecretsFunc)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_SecretAgentOldGetSecretsFunc))
gi'funptrptr


-- callback SecretAgentOldDeleteSecretsFunc
{- Callable
  { returnType = Nothing
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , args =
      [ Arg
          { argCName = "agent"
          , argType =
              TInterface Name { namespace = "NM" , name = "SecretAgentOld" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the secret agent object"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "connection"
          , argType =
              TInterface Name { namespace = "NM" , name = "Connection" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText =
                    Just
                      "the connection for which secrets were to be deleted,\nnote that this object will be unrefed after the callback has returned, use\ng_object_ref()/g_object_unref() if you want to use this object after the callback\nhas returned"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "error"
          , argType = TError
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText =
                    Just
                      "if the deleting secrets failed, give a descriptive error here"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText =
                    Just "caller-specific data to be passed to the function"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = True
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "Called as a result of a request by NM to delete secrets.  When the\n#NMSecretAgentOld subclass has finished deleting the secrets, this function\nshould be called."
        , sinceVersion = Nothing
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_SecretAgentOldDeleteSecretsFunc =
    Ptr NM.SecretAgentOld.SecretAgentOld ->
    Ptr NM.Connection.Connection ->
    Ptr GError ->
    Ptr () ->
    IO ()

-- Args: [ Arg
--           { argCName = "agent"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SecretAgentOld" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret agent object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "connection"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "Connection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the connection for which secrets were to be deleted,\nnote that this object will be unrefed after the callback has returned, use\ng_object_ref()/g_object_unref() if you want to use this object after the callback\nhas returned"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "error"
--           , argType = TError
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "if the deleting secrets failed, give a descriptive error here"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "caller-specific data to be passed to the function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_SecretAgentOldDeleteSecretsFunc :: FunPtr C_SecretAgentOldDeleteSecretsFunc -> C_SecretAgentOldDeleteSecretsFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_SecretAgentOldDeleteSecretsFunc ::
    (B.CallStack.HasCallStack, MonadIO m, NM.SecretAgentOld.IsSecretAgentOld a, NM.Connection.IsConnection b) =>
    FunPtr C_SecretAgentOldDeleteSecretsFunc
    -> a
    -- ^ /@agent@/: the secret agent object
    -> b
    -- ^ /@connection@/: the connection for which secrets were to be deleted,
    -- note that this object will be unrefed after the callback has returned, use
    -- 'GI.GObject.Objects.Object.objectRef'\/'GI.GObject.Objects.Object.objectUnref' if you want to use this object after the callback
    -- has returned
    -> GError
    -- ^ /@error@/: if the deleting secrets failed, give a descriptive error here
    -> Ptr ()
    -- ^ /@userData@/: caller-specific data to be passed to the function
    -> m ()
dynamic_SecretAgentOldDeleteSecretsFunc :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSecretAgentOld a, IsConnection b) =>
FunPtr C_SecretAgentOldSaveSecretsFunc
-> a -> b -> GError -> Ptr () -> m ()
dynamic_SecretAgentOldDeleteSecretsFunc FunPtr C_SecretAgentOldSaveSecretsFunc
__funPtr a
agent b
connection GError
error_ Ptr ()
userData = 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 SecretAgentOld
agent' <- a -> IO (Ptr SecretAgentOld)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
agent
    Ptr Connection
connection' <- b -> IO (Ptr Connection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
connection
    Ptr GError
error_' <- GError -> IO (Ptr GError)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GError
error_
    (FunPtr C_SecretAgentOldSaveSecretsFunc
-> C_SecretAgentOldSaveSecretsFunc
__dynamic_C_SecretAgentOldDeleteSecretsFunc FunPtr C_SecretAgentOldSaveSecretsFunc
__funPtr) Ptr SecretAgentOld
agent' Ptr Connection
connection' Ptr GError
error_' Ptr ()
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
agent
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
connection
    GError -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GError
error_
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Generate a function pointer callable from C code, from a `C_SecretAgentOldDeleteSecretsFunc`.
foreign import ccall "wrapper"
    mk_SecretAgentOldDeleteSecretsFunc :: C_SecretAgentOldDeleteSecretsFunc -> IO (FunPtr C_SecretAgentOldDeleteSecretsFunc)

-- | Called as a result of a request by NM to delete secrets.  When the
-- t'GI.NM.Objects.SecretAgentOld.SecretAgentOld' subclass has finished deleting the secrets, this function
-- should be called.
type SecretAgentOldDeleteSecretsFunc =
    NM.SecretAgentOld.SecretAgentOld
    -- ^ /@agent@/: the secret agent object
    -> NM.Connection.Connection
    -- ^ /@connection@/: the connection for which secrets were to be deleted,
    -- note that this object will be unrefed after the callback has returned, use
    -- 'GI.GObject.Objects.Object.objectRef'\/'GI.GObject.Objects.Object.objectUnref' if you want to use this object after the callback
    -- has returned
    -> GError
    -- ^ /@error@/: if the deleting secrets failed, give a descriptive error here
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `SecretAgentOldDeleteSecretsFunc`@.
noSecretAgentOldDeleteSecretsFunc :: Maybe SecretAgentOldDeleteSecretsFunc
noSecretAgentOldDeleteSecretsFunc :: Maybe SecretAgentOldSaveSecretsFunc
noSecretAgentOldDeleteSecretsFunc = Maybe SecretAgentOldSaveSecretsFunc
forall a. Maybe a
Nothing

-- | Called as a result of a request by NM to delete secrets.  When the
-- t'GI.NM.Objects.SecretAgentOld.SecretAgentOld' subclass has finished deleting the secrets, this function
-- should be called.
type SecretAgentOldDeleteSecretsFunc_WithClosures =
    NM.SecretAgentOld.SecretAgentOld
    -- ^ /@agent@/: the secret agent object
    -> NM.Connection.Connection
    -- ^ /@connection@/: the connection for which secrets were to be deleted,
    -- note that this object will be unrefed after the callback has returned, use
    -- 'GI.GObject.Objects.Object.objectRef'\/'GI.GObject.Objects.Object.objectUnref' if you want to use this object after the callback
    -- has returned
    -> GError
    -- ^ /@error@/: if the deleting secrets failed, give a descriptive error here
    -> Ptr ()
    -- ^ /@userData@/: caller-specific data to be passed to the function
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `SecretAgentOldDeleteSecretsFunc_WithClosures`@.
noSecretAgentOldDeleteSecretsFunc_WithClosures :: Maybe SecretAgentOldDeleteSecretsFunc_WithClosures
noSecretAgentOldDeleteSecretsFunc_WithClosures :: Maybe SecretAgentOldSaveSecretsFunc_WithClosures
noSecretAgentOldDeleteSecretsFunc_WithClosures = Maybe SecretAgentOldSaveSecretsFunc_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_SecretAgentOldDeleteSecretsFunc :: SecretAgentOldDeleteSecretsFunc -> SecretAgentOldDeleteSecretsFunc_WithClosures
drop_closures_SecretAgentOldDeleteSecretsFunc :: SecretAgentOldSaveSecretsFunc
-> SecretAgentOldSaveSecretsFunc_WithClosures
drop_closures_SecretAgentOldDeleteSecretsFunc SecretAgentOldSaveSecretsFunc
_f SecretAgentOld
agent Connection
connection GError
error_ Ptr ()
_ = SecretAgentOldSaveSecretsFunc
_f SecretAgentOld
agent Connection
connection GError
error_

-- | Wrap the callback into a `GClosure`.
genClosure_SecretAgentOldDeleteSecretsFunc :: MonadIO m => SecretAgentOldDeleteSecretsFunc -> m (GClosure C_SecretAgentOldDeleteSecretsFunc)
genClosure_SecretAgentOldDeleteSecretsFunc :: forall (m :: * -> *).
MonadIO m =>
SecretAgentOldSaveSecretsFunc
-> m (GClosure C_SecretAgentOldSaveSecretsFunc)
genClosure_SecretAgentOldDeleteSecretsFunc SecretAgentOldSaveSecretsFunc
cb = IO (GClosure C_SecretAgentOldSaveSecretsFunc)
-> m (GClosure C_SecretAgentOldSaveSecretsFunc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_SecretAgentOldSaveSecretsFunc)
 -> m (GClosure C_SecretAgentOldSaveSecretsFunc))
-> IO (GClosure C_SecretAgentOldSaveSecretsFunc)
-> m (GClosure C_SecretAgentOldSaveSecretsFunc)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: SecretAgentOldSaveSecretsFunc_WithClosures
cb' = SecretAgentOldSaveSecretsFunc
-> SecretAgentOldSaveSecretsFunc_WithClosures
drop_closures_SecretAgentOldDeleteSecretsFunc SecretAgentOldSaveSecretsFunc
cb
    let cb'' :: C_SecretAgentOldSaveSecretsFunc
cb'' = Maybe (Ptr (FunPtr C_SecretAgentOldSaveSecretsFunc))
-> SecretAgentOldSaveSecretsFunc_WithClosures
-> C_SecretAgentOldSaveSecretsFunc
wrap_SecretAgentOldDeleteSecretsFunc Maybe (Ptr (FunPtr C_SecretAgentOldSaveSecretsFunc))
forall a. Maybe a
Nothing SecretAgentOldSaveSecretsFunc_WithClosures
cb'
    C_SecretAgentOldSaveSecretsFunc
-> IO (FunPtr C_SecretAgentOldSaveSecretsFunc)
mk_SecretAgentOldDeleteSecretsFunc C_SecretAgentOldSaveSecretsFunc
cb'' IO (FunPtr C_SecretAgentOldSaveSecretsFunc)
-> (FunPtr C_SecretAgentOldSaveSecretsFunc
    -> IO (GClosure C_SecretAgentOldSaveSecretsFunc))
-> IO (GClosure C_SecretAgentOldSaveSecretsFunc)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_SecretAgentOldSaveSecretsFunc
-> IO (GClosure C_SecretAgentOldSaveSecretsFunc)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `SecretAgentOldDeleteSecretsFunc` into a `C_SecretAgentOldDeleteSecretsFunc`.
wrap_SecretAgentOldDeleteSecretsFunc :: 
    Maybe (Ptr (FunPtr C_SecretAgentOldDeleteSecretsFunc)) ->
    SecretAgentOldDeleteSecretsFunc_WithClosures ->
    C_SecretAgentOldDeleteSecretsFunc
wrap_SecretAgentOldDeleteSecretsFunc :: Maybe (Ptr (FunPtr C_SecretAgentOldSaveSecretsFunc))
-> SecretAgentOldSaveSecretsFunc_WithClosures
-> C_SecretAgentOldSaveSecretsFunc
wrap_SecretAgentOldDeleteSecretsFunc Maybe (Ptr (FunPtr C_SecretAgentOldSaveSecretsFunc))
gi'funptrptr SecretAgentOldSaveSecretsFunc_WithClosures
gi'cb Ptr SecretAgentOld
agent Ptr Connection
connection Ptr GError
error_ Ptr ()
userData = do
    SecretAgentOld
agent' <- ((ManagedPtr SecretAgentOld -> SecretAgentOld)
-> Ptr SecretAgentOld -> IO SecretAgentOld
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr SecretAgentOld -> SecretAgentOld
NM.SecretAgentOld.SecretAgentOld) Ptr SecretAgentOld
agent
    Connection
connection' <- ((ManagedPtr Connection -> Connection)
-> Ptr Connection -> IO Connection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Connection -> Connection
NM.Connection.Connection) Ptr Connection
connection
    GError
error_' <- ((ManagedPtr GError -> GError) -> Ptr GError -> IO GError
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr GError -> GError
GError) Ptr GError
error_
    SecretAgentOldSaveSecretsFunc_WithClosures
gi'cb  SecretAgentOld
agent' Connection
connection' GError
error_' Ptr ()
userData
    Maybe (Ptr (FunPtr C_SecretAgentOldSaveSecretsFunc)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_SecretAgentOldSaveSecretsFunc))
gi'funptrptr


-- callback KeyfileWriteHandler
{- Callable
  { returnType = Just (TBasicType TBoolean)
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just
              "the callee should return %TRUE if the event was handled. If the\n  event was unhandled, a default action will be performed that depends on\n  the @handler_type."
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "connection"
          , argType =
              TInterface Name { namespace = "NM" , name = "Connection" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the #NMConnection that is currently written."
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "keyfile"
          , argType =
              TInterface Name { namespace = "GLib" , name = "KeyFile" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the #GKeyFile that is currently constructed."
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "handler_type"
          , argType =
              TInterface Name { namespace = "NM" , name = "KeyfileHandlerType" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText =
                    Just
                      "the %NMKeyfileHandlerType that indicates which type\n  the request is."
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "handler_data"
          , argType =
              TInterface Name { namespace = "NM" , name = "KeyfileHandlerData" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText =
                    Just
                      "the #NMKeyfileHandlerData. What you can do with it\n  depends on the @handler_type."
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText = Just "the user-data argument to nm_keyfile_read()."
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = True
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "This is a hook to tweak the serialization.\n\nHandler for certain properties or events that are not entirely contained\nwithin the keyfile or that might be serialized differently. The @type and\n@handler_data arguments tell which kind of argument we have at hand.\n\nCurrently only the type %NM_KEYFILE_HANDLER_TYPE_WRITE_CERT is supported.\n\nThe callee may call nm_keyfile_handler_data_fail_with_error() to abort\nthe writing with error."
        , sinceVersion = Just "1.30"
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_KeyfileWriteHandler =
    Ptr NM.Connection.Connection ->
    Ptr GLib.KeyFile.KeyFile ->
    CUInt ->
    Ptr NM.KeyfileHandlerData.KeyfileHandlerData ->
    Ptr () ->
    IO CInt

-- Args: [ Arg
--           { argCName = "connection"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "Connection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMConnection that is currently written."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keyfile"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "KeyFile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GKeyFile that is currently constructed."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "handler_type"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "KeyfileHandlerType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the %NMKeyfileHandlerType that indicates which type\n  the request is."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "handler_data"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "KeyfileHandlerData" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #NMKeyfileHandlerData. What you can do with it\n  depends on the @handler_type."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the user-data argument to nm_keyfile_read()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_KeyfileWriteHandler :: FunPtr C_KeyfileWriteHandler -> C_KeyfileWriteHandler

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_KeyfileWriteHandler ::
    (B.CallStack.HasCallStack, MonadIO m, NM.Connection.IsConnection a) =>
    FunPtr C_KeyfileWriteHandler
    -> a
    -- ^ /@connection@/: the t'GI.NM.Interfaces.Connection.Connection' that is currently written.
    -> GLib.KeyFile.KeyFile
    -- ^ /@keyfile@/: the t'GI.GLib.Structs.KeyFile.KeyFile' that is currently constructed.
    -> NM.Enums.KeyfileHandlerType
    -- ^ /@handlerType@/: the @/NMKeyfileHandlerType/@ that indicates which type
    --   the request is.
    -> NM.KeyfileHandlerData.KeyfileHandlerData
    -- ^ /@handlerData@/: the t'GI.NM.Structs.KeyfileHandlerData.KeyfileHandlerData'. What you can do with it
    --   depends on the /@handlerType@/.
    -> Ptr ()
    -- ^ /@userData@/: the user-data argument to 'GI.NM.Functions.keyfileRead'.
    -> m Bool
    -- ^ __Returns:__ the callee should return 'P.True' if the event was handled. If the
    --   event was unhandled, a default action will be performed that depends on
    --   the /@handlerType@/.
dynamic_KeyfileWriteHandler :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsConnection a) =>
FunPtr C_KeyfileWriteHandler
-> a
-> KeyFile
-> KeyfileHandlerType
-> KeyfileHandlerData
-> Ptr ()
-> m Bool
dynamic_KeyfileWriteHandler FunPtr C_KeyfileWriteHandler
__funPtr a
connection KeyFile
keyfile KeyfileHandlerType
handlerType KeyfileHandlerData
handlerData Ptr ()
userData = 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 Connection
connection' <- a -> IO (Ptr Connection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
    Ptr KeyFile
keyfile' <- KeyFile -> IO (Ptr KeyFile)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr KeyFile
keyfile
    let handlerType' :: CUInt
handlerType' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (KeyfileHandlerType -> Int) -> KeyfileHandlerType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyfileHandlerType -> Int
forall a. Enum a => a -> Int
fromEnum) KeyfileHandlerType
handlerType
    Ptr KeyfileHandlerData
handlerData' <- KeyfileHandlerData -> IO (Ptr KeyfileHandlerData)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr KeyfileHandlerData
handlerData
    CInt
result <- (FunPtr C_KeyfileWriteHandler -> C_KeyfileWriteHandler
__dynamic_C_KeyfileWriteHandler FunPtr C_KeyfileWriteHandler
__funPtr) Ptr Connection
connection' Ptr KeyFile
keyfile' CUInt
handlerType' Ptr KeyfileHandlerData
handlerData' Ptr ()
userData
    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
    KeyFile -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr KeyFile
keyfile
    KeyfileHandlerData -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr KeyfileHandlerData
handlerData
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

-- | Generate a function pointer callable from C code, from a `C_KeyfileWriteHandler`.
foreign import ccall "wrapper"
    mk_KeyfileWriteHandler :: C_KeyfileWriteHandler -> IO (FunPtr C_KeyfileWriteHandler)

-- | This is a hook to tweak the serialization.
-- 
-- Handler for certain properties or events that are not entirely contained
-- within the keyfile or that might be serialized differently. The /@type@/ and
-- /@handlerData@/ arguments tell which kind of argument we have at hand.
-- 
-- Currently only the type 'GI.NM.Enums.KeyfileHandlerTypeWriteCert' is supported.
-- 
-- The callee may call 'GI.NM.Structs.KeyfileHandlerData.keyfileHandlerDataFailWithError' to abort
-- the writing with error.
-- 
-- /Since: 1.30/
type KeyfileWriteHandler =
    NM.Connection.Connection
    -- ^ /@connection@/: the t'GI.NM.Interfaces.Connection.Connection' that is currently written.
    -> GLib.KeyFile.KeyFile
    -- ^ /@keyfile@/: the t'GI.GLib.Structs.KeyFile.KeyFile' that is currently constructed.
    -> NM.Enums.KeyfileHandlerType
    -- ^ /@handlerType@/: the @/NMKeyfileHandlerType/@ that indicates which type
    --   the request is.
    -> NM.KeyfileHandlerData.KeyfileHandlerData
    -- ^ /@handlerData@/: the t'GI.NM.Structs.KeyfileHandlerData.KeyfileHandlerData'. What you can do with it
    --   depends on the /@handlerType@/.
    -> IO Bool
    -- ^ __Returns:__ the callee should return 'P.True' if the event was handled. If the
    --   event was unhandled, a default action will be performed that depends on
    --   the /@handlerType@/.

-- | A convenience synonym for @`Nothing` :: `Maybe` `KeyfileWriteHandler`@.
noKeyfileWriteHandler :: Maybe KeyfileWriteHandler
noKeyfileWriteHandler :: Maybe KeyfileWriteHandler
noKeyfileWriteHandler = Maybe KeyfileWriteHandler
forall a. Maybe a
Nothing

-- | This is a hook to tweak the serialization.
-- 
-- Handler for certain properties or events that are not entirely contained
-- within the keyfile or that might be serialized differently. The /@type@/ and
-- /@handlerData@/ arguments tell which kind of argument we have at hand.
-- 
-- Currently only the type 'GI.NM.Enums.KeyfileHandlerTypeWriteCert' is supported.
-- 
-- The callee may call 'GI.NM.Structs.KeyfileHandlerData.keyfileHandlerDataFailWithError' to abort
-- the writing with error.
-- 
-- /Since: 1.30/
type KeyfileWriteHandler_WithClosures =
    NM.Connection.Connection
    -- ^ /@connection@/: the t'GI.NM.Interfaces.Connection.Connection' that is currently written.
    -> GLib.KeyFile.KeyFile
    -- ^ /@keyfile@/: the t'GI.GLib.Structs.KeyFile.KeyFile' that is currently constructed.
    -> NM.Enums.KeyfileHandlerType
    -- ^ /@handlerType@/: the @/NMKeyfileHandlerType/@ that indicates which type
    --   the request is.
    -> NM.KeyfileHandlerData.KeyfileHandlerData
    -- ^ /@handlerData@/: the t'GI.NM.Structs.KeyfileHandlerData.KeyfileHandlerData'. What you can do with it
    --   depends on the /@handlerType@/.
    -> Ptr ()
    -- ^ /@userData@/: the user-data argument to 'GI.NM.Functions.keyfileRead'.
    -> IO Bool
    -- ^ __Returns:__ the callee should return 'P.True' if the event was handled. If the
    --   event was unhandled, a default action will be performed that depends on
    --   the /@handlerType@/.

-- | A convenience synonym for @`Nothing` :: `Maybe` `KeyfileWriteHandler_WithClosures`@.
noKeyfileWriteHandler_WithClosures :: Maybe KeyfileWriteHandler_WithClosures
noKeyfileWriteHandler_WithClosures :: Maybe KeyfileWriteHandler_WithClosures
noKeyfileWriteHandler_WithClosures = Maybe KeyfileWriteHandler_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_KeyfileWriteHandler :: KeyfileWriteHandler -> KeyfileWriteHandler_WithClosures
drop_closures_KeyfileWriteHandler :: KeyfileWriteHandler -> KeyfileWriteHandler_WithClosures
drop_closures_KeyfileWriteHandler KeyfileWriteHandler
_f Connection
connection KeyFile
keyfile KeyfileHandlerType
handlerType KeyfileHandlerData
handlerData Ptr ()
_ = KeyfileWriteHandler
_f Connection
connection KeyFile
keyfile KeyfileHandlerType
handlerType KeyfileHandlerData
handlerData

-- | Wrap the callback into a `GClosure`.
genClosure_KeyfileWriteHandler :: MonadIO m => KeyfileWriteHandler -> m (GClosure C_KeyfileWriteHandler)
genClosure_KeyfileWriteHandler :: forall (m :: * -> *).
MonadIO m =>
KeyfileWriteHandler -> m (GClosure C_KeyfileWriteHandler)
genClosure_KeyfileWriteHandler KeyfileWriteHandler
cb = IO (GClosure C_KeyfileWriteHandler)
-> m (GClosure C_KeyfileWriteHandler)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_KeyfileWriteHandler)
 -> m (GClosure C_KeyfileWriteHandler))
-> IO (GClosure C_KeyfileWriteHandler)
-> m (GClosure C_KeyfileWriteHandler)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: KeyfileWriteHandler_WithClosures
cb' = KeyfileWriteHandler -> KeyfileWriteHandler_WithClosures
drop_closures_KeyfileWriteHandler KeyfileWriteHandler
cb
    let cb'' :: C_KeyfileWriteHandler
cb'' = Maybe (Ptr (FunPtr C_KeyfileWriteHandler))
-> KeyfileWriteHandler_WithClosures -> C_KeyfileWriteHandler
wrap_KeyfileWriteHandler Maybe (Ptr (FunPtr C_KeyfileWriteHandler))
forall a. Maybe a
Nothing KeyfileWriteHandler_WithClosures
cb'
    C_KeyfileWriteHandler -> IO (FunPtr C_KeyfileWriteHandler)
mk_KeyfileWriteHandler C_KeyfileWriteHandler
cb'' IO (FunPtr C_KeyfileWriteHandler)
-> (FunPtr C_KeyfileWriteHandler
    -> IO (GClosure C_KeyfileWriteHandler))
-> IO (GClosure C_KeyfileWriteHandler)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_KeyfileWriteHandler -> IO (GClosure C_KeyfileWriteHandler)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `KeyfileWriteHandler` into a `C_KeyfileWriteHandler`.
wrap_KeyfileWriteHandler :: 
    Maybe (Ptr (FunPtr C_KeyfileWriteHandler)) ->
    KeyfileWriteHandler_WithClosures ->
    C_KeyfileWriteHandler
wrap_KeyfileWriteHandler :: Maybe (Ptr (FunPtr C_KeyfileWriteHandler))
-> KeyfileWriteHandler_WithClosures -> C_KeyfileWriteHandler
wrap_KeyfileWriteHandler Maybe (Ptr (FunPtr C_KeyfileWriteHandler))
gi'funptrptr KeyfileWriteHandler_WithClosures
gi'cb Ptr Connection
connection Ptr KeyFile
keyfile CUInt
handlerType Ptr KeyfileHandlerData
handlerData Ptr ()
userData = do
    Connection
connection' <- ((ManagedPtr Connection -> Connection)
-> Ptr Connection -> IO Connection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Connection -> Connection
NM.Connection.Connection) Ptr Connection
connection
    Ptr KeyFile -> (KeyFile -> IO CInt) -> IO CInt
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient  Ptr KeyFile
keyfile ((KeyFile -> IO CInt) -> IO CInt)
-> (KeyFile -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \KeyFile
keyfile' -> do
        let handlerType' :: KeyfileHandlerType
handlerType' = (Int -> KeyfileHandlerType
forall a. Enum a => Int -> a
toEnum (Int -> KeyfileHandlerType)
-> (CUInt -> Int) -> CUInt -> KeyfileHandlerType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
handlerType
        KeyfileHandlerData
handlerData' <- ((ManagedPtr KeyfileHandlerData -> KeyfileHandlerData)
-> Ptr KeyfileHandlerData -> IO KeyfileHandlerData
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr KeyfileHandlerData -> KeyfileHandlerData
NM.KeyfileHandlerData.KeyfileHandlerData) Ptr KeyfileHandlerData
handlerData
        Bool
result <- KeyfileWriteHandler_WithClosures
gi'cb  Connection
connection' KeyFile
keyfile' KeyfileHandlerType
handlerType' KeyfileHandlerData
handlerData' Ptr ()
userData
        Maybe (Ptr (FunPtr C_KeyfileWriteHandler)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_KeyfileWriteHandler))
gi'funptrptr
        let result' :: CInt
result' = (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
result
        CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- callback KeyfileReadHandler
{- Callable
  { returnType = Just (TBasicType TBoolean)
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just
              "the callee should return TRUE, if the event was handled and/or recognized.\n  Otherwise, a default action will be performed that depends on the @type.\n  For %NM_KEYFILE_HANDLER_TYPE_WARN type, the default action is doing nothing."
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "keyfile"
          , argType =
              TInterface Name { namespace = "GLib" , name = "KeyFile" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the #GKeyFile that is currently read"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "connection"
          , argType =
              TInterface Name { namespace = "NM" , name = "Connection" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the #NMConnection that is being constructed."
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "handler_type"
          , argType =
              TInterface Name { namespace = "NM" , name = "KeyfileHandlerType" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText =
                    Just
                      "the %NMKeyfileHandlerType that indicates which type\n  the request is."
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "handler_data"
          , argType =
              TInterface Name { namespace = "NM" , name = "KeyfileHandlerData" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText =
                    Just
                      "the #NMKeyfileHandlerData. What you can do with it\n  depends on the @handler_type."
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText = Just "the user-data argument to nm_keyfile_read()."
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , argCallbackUserData = True
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "Hook to nm_keyfile_read().\n\nThe callee may abort the reading by setting an error via nm_keyfile_handler_data_fail_with_error()."
        , sinceVersion = Just "1.30"
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_KeyfileReadHandler =
    Ptr GLib.KeyFile.KeyFile ->
    Ptr NM.Connection.Connection ->
    CUInt ->
    Ptr NM.KeyfileHandlerData.KeyfileHandlerData ->
    Ptr () ->
    IO CInt

-- Args: [ Arg
--           { argCName = "keyfile"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "KeyFile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GKeyFile that is currently read"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "connection"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "Connection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMConnection that is being constructed."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "handler_type"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "KeyfileHandlerType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the %NMKeyfileHandlerType that indicates which type\n  the request is."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "handler_data"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "KeyfileHandlerData" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #NMKeyfileHandlerData. What you can do with it\n  depends on the @handler_type."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the user-data argument to nm_keyfile_read()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_KeyfileReadHandler :: FunPtr C_KeyfileReadHandler -> C_KeyfileReadHandler

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_KeyfileReadHandler ::
    (B.CallStack.HasCallStack, MonadIO m, NM.Connection.IsConnection a) =>
    FunPtr C_KeyfileReadHandler
    -> GLib.KeyFile.KeyFile
    -- ^ /@keyfile@/: the t'GI.GLib.Structs.KeyFile.KeyFile' that is currently read
    -> a
    -- ^ /@connection@/: the t'GI.NM.Interfaces.Connection.Connection' that is being constructed.
    -> NM.Enums.KeyfileHandlerType
    -- ^ /@handlerType@/: the @/NMKeyfileHandlerType/@ that indicates which type
    --   the request is.
    -> NM.KeyfileHandlerData.KeyfileHandlerData
    -- ^ /@handlerData@/: the t'GI.NM.Structs.KeyfileHandlerData.KeyfileHandlerData'. What you can do with it
    --   depends on the /@handlerType@/.
    -> Ptr ()
    -- ^ /@userData@/: the user-data argument to 'GI.NM.Functions.keyfileRead'.
    -> m Bool
    -- ^ __Returns:__ the callee should return TRUE, if the event was handled and\/or recognized.
    --   Otherwise, a default action will be performed that depends on the /@type@/.
    --   For 'GI.NM.Enums.KeyfileHandlerTypeWarn' type, the default action is doing nothing.
dynamic_KeyfileReadHandler :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsConnection a) =>
FunPtr C_KeyfileReadHandler
-> KeyFile
-> a
-> KeyfileHandlerType
-> KeyfileHandlerData
-> Ptr ()
-> m Bool
dynamic_KeyfileReadHandler FunPtr C_KeyfileReadHandler
__funPtr KeyFile
keyfile a
connection KeyfileHandlerType
handlerType KeyfileHandlerData
handlerData Ptr ()
userData = 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 KeyFile
keyfile' <- KeyFile -> IO (Ptr KeyFile)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr KeyFile
keyfile
    Ptr Connection
connection' <- a -> IO (Ptr Connection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
    let handlerType' :: CUInt
handlerType' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (KeyfileHandlerType -> Int) -> KeyfileHandlerType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyfileHandlerType -> Int
forall a. Enum a => a -> Int
fromEnum) KeyfileHandlerType
handlerType
    Ptr KeyfileHandlerData
handlerData' <- KeyfileHandlerData -> IO (Ptr KeyfileHandlerData)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr KeyfileHandlerData
handlerData
    CInt
result <- (FunPtr C_KeyfileReadHandler -> C_KeyfileReadHandler
__dynamic_C_KeyfileReadHandler FunPtr C_KeyfileReadHandler
__funPtr) Ptr KeyFile
keyfile' Ptr Connection
connection' CUInt
handlerType' Ptr KeyfileHandlerData
handlerData' Ptr ()
userData
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    KeyFile -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr KeyFile
keyfile
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
    KeyfileHandlerData -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr KeyfileHandlerData
handlerData
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

-- | Generate a function pointer callable from C code, from a `C_KeyfileReadHandler`.
foreign import ccall "wrapper"
    mk_KeyfileReadHandler :: C_KeyfileReadHandler -> IO (FunPtr C_KeyfileReadHandler)

-- | Hook to 'GI.NM.Functions.keyfileRead'.
-- 
-- The callee may abort the reading by setting an error via 'GI.NM.Structs.KeyfileHandlerData.keyfileHandlerDataFailWithError'.
-- 
-- /Since: 1.30/
type KeyfileReadHandler =
    GLib.KeyFile.KeyFile
    -- ^ /@keyfile@/: the t'GI.GLib.Structs.KeyFile.KeyFile' that is currently read
    -> NM.Connection.Connection
    -- ^ /@connection@/: the t'GI.NM.Interfaces.Connection.Connection' that is being constructed.
    -> NM.Enums.KeyfileHandlerType
    -- ^ /@handlerType@/: the @/NMKeyfileHandlerType/@ that indicates which type
    --   the request is.
    -> NM.KeyfileHandlerData.KeyfileHandlerData
    -- ^ /@handlerData@/: the t'GI.NM.Structs.KeyfileHandlerData.KeyfileHandlerData'. What you can do with it
    --   depends on the /@handlerType@/.
    -> IO Bool
    -- ^ __Returns:__ the callee should return TRUE, if the event was handled and\/or recognized.
    --   Otherwise, a default action will be performed that depends on the /@type@/.
    --   For 'GI.NM.Enums.KeyfileHandlerTypeWarn' type, the default action is doing nothing.

-- | A convenience synonym for @`Nothing` :: `Maybe` `KeyfileReadHandler`@.
noKeyfileReadHandler :: Maybe KeyfileReadHandler
noKeyfileReadHandler :: Maybe KeyfileReadHandler
noKeyfileReadHandler = Maybe KeyfileReadHandler
forall a. Maybe a
Nothing

-- | Hook to 'GI.NM.Functions.keyfileRead'.
-- 
-- The callee may abort the reading by setting an error via 'GI.NM.Structs.KeyfileHandlerData.keyfileHandlerDataFailWithError'.
-- 
-- /Since: 1.30/
type KeyfileReadHandler_WithClosures =
    GLib.KeyFile.KeyFile
    -- ^ /@keyfile@/: the t'GI.GLib.Structs.KeyFile.KeyFile' that is currently read
    -> NM.Connection.Connection
    -- ^ /@connection@/: the t'GI.NM.Interfaces.Connection.Connection' that is being constructed.
    -> NM.Enums.KeyfileHandlerType
    -- ^ /@handlerType@/: the @/NMKeyfileHandlerType/@ that indicates which type
    --   the request is.
    -> NM.KeyfileHandlerData.KeyfileHandlerData
    -- ^ /@handlerData@/: the t'GI.NM.Structs.KeyfileHandlerData.KeyfileHandlerData'. What you can do with it
    --   depends on the /@handlerType@/.
    -> Ptr ()
    -- ^ /@userData@/: the user-data argument to 'GI.NM.Functions.keyfileRead'.
    -> IO Bool
    -- ^ __Returns:__ the callee should return TRUE, if the event was handled and\/or recognized.
    --   Otherwise, a default action will be performed that depends on the /@type@/.
    --   For 'GI.NM.Enums.KeyfileHandlerTypeWarn' type, the default action is doing nothing.

-- | A convenience synonym for @`Nothing` :: `Maybe` `KeyfileReadHandler_WithClosures`@.
noKeyfileReadHandler_WithClosures :: Maybe KeyfileReadHandler_WithClosures
noKeyfileReadHandler_WithClosures :: Maybe KeyfileReadHandler_WithClosures
noKeyfileReadHandler_WithClosures = Maybe KeyfileReadHandler_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_KeyfileReadHandler :: KeyfileReadHandler -> KeyfileReadHandler_WithClosures
drop_closures_KeyfileReadHandler :: KeyfileReadHandler -> KeyfileReadHandler_WithClosures
drop_closures_KeyfileReadHandler KeyfileReadHandler
_f KeyFile
keyfile Connection
connection KeyfileHandlerType
handlerType KeyfileHandlerData
handlerData Ptr ()
_ = KeyfileReadHandler
_f KeyFile
keyfile Connection
connection KeyfileHandlerType
handlerType KeyfileHandlerData
handlerData

-- | Wrap the callback into a `GClosure`.
genClosure_KeyfileReadHandler :: MonadIO m => KeyfileReadHandler -> m (GClosure C_KeyfileReadHandler)
genClosure_KeyfileReadHandler :: forall (m :: * -> *).
MonadIO m =>
KeyfileReadHandler -> m (GClosure C_KeyfileReadHandler)
genClosure_KeyfileReadHandler KeyfileReadHandler
cb = IO (GClosure C_KeyfileReadHandler)
-> m (GClosure C_KeyfileReadHandler)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_KeyfileReadHandler)
 -> m (GClosure C_KeyfileReadHandler))
-> IO (GClosure C_KeyfileReadHandler)
-> m (GClosure C_KeyfileReadHandler)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: KeyfileReadHandler_WithClosures
cb' = KeyfileReadHandler -> KeyfileReadHandler_WithClosures
drop_closures_KeyfileReadHandler KeyfileReadHandler
cb
    let cb'' :: C_KeyfileReadHandler
cb'' = Maybe (Ptr (FunPtr C_KeyfileReadHandler))
-> KeyfileReadHandler_WithClosures -> C_KeyfileReadHandler
wrap_KeyfileReadHandler Maybe (Ptr (FunPtr C_KeyfileReadHandler))
forall a. Maybe a
Nothing KeyfileReadHandler_WithClosures
cb'
    C_KeyfileReadHandler -> IO (FunPtr C_KeyfileReadHandler)
mk_KeyfileReadHandler C_KeyfileReadHandler
cb'' IO (FunPtr C_KeyfileReadHandler)
-> (FunPtr C_KeyfileReadHandler
    -> IO (GClosure C_KeyfileReadHandler))
-> IO (GClosure C_KeyfileReadHandler)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_KeyfileReadHandler -> IO (GClosure C_KeyfileReadHandler)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `KeyfileReadHandler` into a `C_KeyfileReadHandler`.
wrap_KeyfileReadHandler :: 
    Maybe (Ptr (FunPtr C_KeyfileReadHandler)) ->
    KeyfileReadHandler_WithClosures ->
    C_KeyfileReadHandler
wrap_KeyfileReadHandler :: Maybe (Ptr (FunPtr C_KeyfileReadHandler))
-> KeyfileReadHandler_WithClosures -> C_KeyfileReadHandler
wrap_KeyfileReadHandler Maybe (Ptr (FunPtr C_KeyfileReadHandler))
gi'funptrptr KeyfileReadHandler_WithClosures
gi'cb Ptr KeyFile
keyfile Ptr Connection
connection CUInt
handlerType Ptr KeyfileHandlerData
handlerData Ptr ()
userData = do
    Ptr KeyFile -> (KeyFile -> IO CInt) -> IO CInt
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient  Ptr KeyFile
keyfile ((KeyFile -> IO CInt) -> IO CInt)
-> (KeyFile -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \KeyFile
keyfile' -> do
        Connection
connection' <- ((ManagedPtr Connection -> Connection)
-> Ptr Connection -> IO Connection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Connection -> Connection
NM.Connection.Connection) Ptr Connection
connection
        let handlerType' :: KeyfileHandlerType
handlerType' = (Int -> KeyfileHandlerType
forall a. Enum a => Int -> a
toEnum (Int -> KeyfileHandlerType)
-> (CUInt -> Int) -> CUInt -> KeyfileHandlerType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
handlerType
        KeyfileHandlerData
handlerData' <- ((ManagedPtr KeyfileHandlerData -> KeyfileHandlerData)
-> Ptr KeyfileHandlerData -> IO KeyfileHandlerData
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr KeyfileHandlerData -> KeyfileHandlerData
NM.KeyfileHandlerData.KeyfileHandlerData) Ptr KeyfileHandlerData
handlerData
        Bool
result <- KeyfileReadHandler_WithClosures
gi'cb  KeyFile
keyfile' Connection
connection' KeyfileHandlerType
handlerType' KeyfileHandlerData
handlerData' Ptr ()
userData
        Maybe (Ptr (FunPtr C_KeyfileReadHandler)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_KeyfileReadHandler))
gi'funptrptr
        let result' :: CInt
result' = (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
result
        CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'