{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A prompt in the Service
-- 
-- A proxy object representing a prompt that the Secret Service will display
-- to the user.
-- 
-- Certain actions on the Secret Service require user prompting to complete,
-- such as creating a collection, or unlocking a collection. When such a prompt
-- is necessary, then a t'GI.Secret.Objects.Prompt.Prompt' object is created by this library, and
-- passed to the [method/@service@/.prompt] method. In this way it is handled
-- automatically.
-- 
-- In order to customize prompt handling, override the
-- [vfunc/@service@/.prompt_async] and [vfunc/@service@/.prompt_finish] virtual
-- methods of the [class/@service@/] class.

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

module GI.Secret.Objects.Prompt
    ( 

-- * Exported types
    Prompt(..)                              ,
    IsPrompt                                ,
    toPrompt                                ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [call]("GI.Gio.Objects.DBusProxy#g:method:call"), [callFinish]("GI.Gio.Objects.DBusProxy#g:method:callFinish"), [callSync]("GI.Gio.Objects.DBusProxy#g:method:callSync"), [callWithUnixFdList]("GI.Gio.Objects.DBusProxy#g:method:callWithUnixFdList"), [callWithUnixFdListFinish]("GI.Gio.Objects.DBusProxy#g:method:callWithUnixFdListFinish"), [callWithUnixFdListSync]("GI.Gio.Objects.DBusProxy#g:method:callWithUnixFdListSync"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [init]("GI.Gio.Interfaces.Initable#g:method:init"), [initAsync]("GI.Gio.Interfaces.AsyncInitable#g:method:initAsync"), [initFinish]("GI.Gio.Interfaces.AsyncInitable#g:method:initFinish"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [perform]("GI.Secret.Objects.Prompt#g:method:perform"), [performFinish]("GI.Secret.Objects.Prompt#g:method:performFinish"), [performSync]("GI.Secret.Objects.Prompt#g:method:performSync"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [run]("GI.Secret.Objects.Prompt#g:method:run"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getCachedProperty]("GI.Gio.Objects.DBusProxy#g:method:getCachedProperty"), [getCachedPropertyNames]("GI.Gio.Objects.DBusProxy#g:method:getCachedPropertyNames"), [getConnection]("GI.Gio.Objects.DBusProxy#g:method:getConnection"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDefaultTimeout]("GI.Gio.Objects.DBusProxy#g:method:getDefaultTimeout"), [getFlags]("GI.Gio.Objects.DBusProxy#g:method:getFlags"), [getInfo]("GI.Gio.Interfaces.DBusInterface#g:method:getInfo"), [getInterfaceInfo]("GI.Gio.Objects.DBusProxy#g:method:getInterfaceInfo"), [getInterfaceName]("GI.Gio.Objects.DBusProxy#g:method:getInterfaceName"), [getName]("GI.Gio.Objects.DBusProxy#g:method:getName"), [getNameOwner]("GI.Gio.Objects.DBusProxy#g:method:getNameOwner"), [getObject]("GI.Gio.Interfaces.DBusInterface#g:method:getObject"), [getObjectPath]("GI.Gio.Objects.DBusProxy#g:method:getObjectPath"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setCachedProperty]("GI.Gio.Objects.DBusProxy#g:method:setCachedProperty"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDefaultTimeout]("GI.Gio.Objects.DBusProxy#g:method:setDefaultTimeout"), [setInterfaceInfo]("GI.Gio.Objects.DBusProxy#g:method:setInterfaceInfo"), [setObject]("GI.Gio.Interfaces.DBusInterface#g:method:setObject"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolvePromptMethod                     ,
#endif

-- ** perform #method:perform#

#if defined(ENABLE_OVERLOADING)
    PromptPerformMethodInfo                 ,
#endif
    promptPerform                           ,


-- ** performFinish #method:performFinish#

#if defined(ENABLE_OVERLOADING)
    PromptPerformFinishMethodInfo           ,
#endif
    promptPerformFinish                     ,


-- ** performSync #method:performSync#

#if defined(ENABLE_OVERLOADING)
    PromptPerformSyncMethodInfo             ,
#endif
    promptPerformSync                       ,


-- ** run #method:run#

#if defined(ENABLE_OVERLOADING)
    PromptRunMethodInfo                     ,
#endif
    promptRun                               ,




    ) 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.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 GI.GLib.Structs.VariantType as GLib.VariantType
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncInitable as Gio.AsyncInitable
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.DBusInterface as Gio.DBusInterface
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.DBusProxy as Gio.DBusProxy

-- | Memory-managed wrapper type.
newtype Prompt = Prompt (SP.ManagedPtr Prompt)
    deriving (Prompt -> Prompt -> Bool
(Prompt -> Prompt -> Bool)
-> (Prompt -> Prompt -> Bool) -> Eq Prompt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Prompt -> Prompt -> Bool
== :: Prompt -> Prompt -> Bool
$c/= :: Prompt -> Prompt -> Bool
/= :: Prompt -> Prompt -> Bool
Eq)

instance SP.ManagedPtrNewtype Prompt where
    toManagedPtr :: Prompt -> ManagedPtr Prompt
toManagedPtr (Prompt ManagedPtr Prompt
p) = ManagedPtr Prompt
p

foreign import ccall "secret_prompt_get_type"
    c_secret_prompt_get_type :: IO B.Types.GType

instance B.Types.TypedObject Prompt where
    glibType :: IO GType
glibType = IO GType
c_secret_prompt_get_type

instance B.Types.GObject Prompt

-- | Type class for types which can be safely cast to `Prompt`, for instance with `toPrompt`.
class (SP.GObject o, O.IsDescendantOf Prompt o) => IsPrompt o
instance (SP.GObject o, O.IsDescendantOf Prompt o) => IsPrompt o

instance O.HasParentTypes Prompt
type instance O.ParentTypes Prompt = '[Gio.DBusProxy.DBusProxy, GObject.Object.Object, Gio.AsyncInitable.AsyncInitable, Gio.DBusInterface.DBusInterface, Gio.Initable.Initable]

-- | Cast to `Prompt`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toPrompt :: (MIO.MonadIO m, IsPrompt o) => o -> m Prompt
toPrompt :: forall (m :: * -> *) o. (MonadIO m, IsPrompt o) => o -> m Prompt
toPrompt = IO Prompt -> m Prompt
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Prompt -> m Prompt) -> (o -> IO Prompt) -> o -> m Prompt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Prompt -> Prompt) -> o -> IO Prompt
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Prompt -> Prompt
Prompt

-- | Convert 'Prompt' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Prompt) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_secret_prompt_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Prompt -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Prompt
P.Nothing = Ptr GValue -> Ptr Prompt -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Prompt
forall a. Ptr a
FP.nullPtr :: FP.Ptr Prompt)
    gvalueSet_ Ptr GValue
gv (P.Just Prompt
obj) = Prompt -> (Ptr Prompt -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Prompt
obj (Ptr GValue -> Ptr Prompt -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Prompt)
gvalueGet_ Ptr GValue
gv = do
        Ptr Prompt
ptr <- Ptr GValue -> IO (Ptr Prompt)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Prompt)
        if Ptr Prompt
ptr Ptr Prompt -> Ptr Prompt -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Prompt
forall a. Ptr a
FP.nullPtr
        then Prompt -> Maybe Prompt
forall a. a -> Maybe a
P.Just (Prompt -> Maybe Prompt) -> IO Prompt -> IO (Maybe Prompt)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Prompt -> Prompt) -> Ptr Prompt -> IO Prompt
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Prompt -> Prompt
Prompt Ptr Prompt
ptr
        else Maybe Prompt -> IO (Maybe Prompt)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Prompt
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolvePromptMethod (t :: Symbol) (o :: *) :: * where
    ResolvePromptMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePromptMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePromptMethod "call" o = Gio.DBusProxy.DBusProxyCallMethodInfo
    ResolvePromptMethod "callFinish" o = Gio.DBusProxy.DBusProxyCallFinishMethodInfo
    ResolvePromptMethod "callSync" o = Gio.DBusProxy.DBusProxyCallSyncMethodInfo
    ResolvePromptMethod "callWithUnixFdList" o = Gio.DBusProxy.DBusProxyCallWithUnixFdListMethodInfo
    ResolvePromptMethod "callWithUnixFdListFinish" o = Gio.DBusProxy.DBusProxyCallWithUnixFdListFinishMethodInfo
    ResolvePromptMethod "callWithUnixFdListSync" o = Gio.DBusProxy.DBusProxyCallWithUnixFdListSyncMethodInfo
    ResolvePromptMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePromptMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePromptMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePromptMethod "init" o = Gio.Initable.InitableInitMethodInfo
    ResolvePromptMethod "initAsync" o = Gio.AsyncInitable.AsyncInitableInitAsyncMethodInfo
    ResolvePromptMethod "initFinish" o = Gio.AsyncInitable.AsyncInitableInitFinishMethodInfo
    ResolvePromptMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePromptMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePromptMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePromptMethod "perform" o = PromptPerformMethodInfo
    ResolvePromptMethod "performFinish" o = PromptPerformFinishMethodInfo
    ResolvePromptMethod "performSync" o = PromptPerformSyncMethodInfo
    ResolvePromptMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePromptMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePromptMethod "run" o = PromptRunMethodInfo
    ResolvePromptMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePromptMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePromptMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePromptMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePromptMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePromptMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePromptMethod "getCachedProperty" o = Gio.DBusProxy.DBusProxyGetCachedPropertyMethodInfo
    ResolvePromptMethod "getCachedPropertyNames" o = Gio.DBusProxy.DBusProxyGetCachedPropertyNamesMethodInfo
    ResolvePromptMethod "getConnection" o = Gio.DBusProxy.DBusProxyGetConnectionMethodInfo
    ResolvePromptMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePromptMethod "getDefaultTimeout" o = Gio.DBusProxy.DBusProxyGetDefaultTimeoutMethodInfo
    ResolvePromptMethod "getFlags" o = Gio.DBusProxy.DBusProxyGetFlagsMethodInfo
    ResolvePromptMethod "getInfo" o = Gio.DBusInterface.DBusInterfaceGetInfoMethodInfo
    ResolvePromptMethod "getInterfaceInfo" o = Gio.DBusProxy.DBusProxyGetInterfaceInfoMethodInfo
    ResolvePromptMethod "getInterfaceName" o = Gio.DBusProxy.DBusProxyGetInterfaceNameMethodInfo
    ResolvePromptMethod "getName" o = Gio.DBusProxy.DBusProxyGetNameMethodInfo
    ResolvePromptMethod "getNameOwner" o = Gio.DBusProxy.DBusProxyGetNameOwnerMethodInfo
    ResolvePromptMethod "getObject" o = Gio.DBusInterface.DBusInterfaceGetObjectMethodInfo
    ResolvePromptMethod "getObjectPath" o = Gio.DBusProxy.DBusProxyGetObjectPathMethodInfo
    ResolvePromptMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePromptMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePromptMethod "setCachedProperty" o = Gio.DBusProxy.DBusProxySetCachedPropertyMethodInfo
    ResolvePromptMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePromptMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePromptMethod "setDefaultTimeout" o = Gio.DBusProxy.DBusProxySetDefaultTimeoutMethodInfo
    ResolvePromptMethod "setInterfaceInfo" o = Gio.DBusProxy.DBusProxySetInterfaceInfoMethodInfo
    ResolvePromptMethod "setObject" o = Gio.DBusInterface.DBusInterfaceSetObjectMethodInfo
    ResolvePromptMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePromptMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolvePromptMethod t Prompt, O.OverloadedMethod info Prompt p) => OL.IsLabel t (Prompt -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolvePromptMethod t Prompt, O.OverloadedMethod info Prompt p, R.HasField t Prompt p) => R.HasField t Prompt p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolvePromptMethod t Prompt, O.OverloadedMethodInfo info Prompt) => OL.IsLabel t (O.MethodProxy info Prompt) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Prompt
type instance O.AttributeList Prompt = PromptAttributeList
type PromptAttributeList = ('[ '("gBusType", Gio.DBusProxy.DBusProxyGBusTypePropertyInfo), '("gConnection", Gio.DBusProxy.DBusProxyGConnectionPropertyInfo), '("gDefaultTimeout", Gio.DBusProxy.DBusProxyGDefaultTimeoutPropertyInfo), '("gFlags", Gio.DBusProxy.DBusProxyGFlagsPropertyInfo), '("gInterfaceInfo", Gio.DBusProxy.DBusProxyGInterfaceInfoPropertyInfo), '("gInterfaceName", Gio.DBusProxy.DBusProxyGInterfaceNamePropertyInfo), '("gName", Gio.DBusProxy.DBusProxyGNamePropertyInfo), '("gNameOwner", Gio.DBusProxy.DBusProxyGNameOwnerPropertyInfo), '("gObjectPath", Gio.DBusProxy.DBusProxyGObjectPathPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Prompt = PromptSignalList
type PromptSignalList = ('[ '("gPropertiesChanged", Gio.DBusProxy.DBusProxyGPropertiesChangedSignalInfo), '("gSignal", Gio.DBusProxy.DBusProxyGSignalSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Prompt::perform
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Prompt" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a prompt" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "window_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "string form of XWindow id for parent window to be transient for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "return_type"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "VariantType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the variant type of the prompt result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "called when the operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to be passed to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "secret_prompt_perform" secret_prompt_perform :: 
    Ptr Prompt ->                           -- self : TInterface (Name {namespace = "Secret", name = "Prompt"})
    CString ->                              -- window_id : TBasicType TUTF8
    Ptr GLib.VariantType.VariantType ->     -- return_type : TInterface (Name {namespace = "GLib", name = "VariantType"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Runs a prompt and performs the prompting.
-- 
-- Returns 'P.True' if the prompt was completed and not dismissed.
-- 
-- If /@windowId@/ is non-null then it is used as an XWindow id on Linux. The API
-- expects this id to be converted to a string using the @%d@ printf format. The
-- Secret Service can make its prompt transient for the window with this id. In
-- some Secret Service implementations this is not possible, so the behavior
-- depending on this should degrade gracefully.
-- 
-- This method will return immediately and complete asynchronously.
promptPerform ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrompt a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: a prompt
    -> Maybe (T.Text)
    -- ^ /@windowId@/: string form of XWindow id for parent window to be transient for
    -> GLib.VariantType.VariantType
    -- ^ /@returnType@/: the variant type of the prompt result
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: called when the operation completes
    -> m ()
promptPerform :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPrompt a, IsCancellable b) =>
a
-> Maybe Text
-> VariantType
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
promptPerform a
self Maybe Text
windowId VariantType
returnType Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Prompt
self' <- a -> IO (Ptr Prompt)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CChar
maybeWindowId <- case Maybe Text
windowId of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jWindowId -> do
            Ptr CChar
jWindowId' <- Text -> IO (Ptr CChar)
textToCString Text
jWindowId
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jWindowId'
    Ptr VariantType
returnType' <- VariantType -> IO (Ptr VariantType)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VariantType
returnType
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Prompt
-> Ptr CChar
-> Ptr VariantType
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
secret_prompt_perform Ptr Prompt
self' Ptr CChar
maybeWindowId Ptr VariantType
returnType' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    VariantType -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VariantType
returnType
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeWindowId
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PromptPerformMethodInfo
instance (signature ~ (Maybe (T.Text) -> GLib.VariantType.VariantType -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsPrompt a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod PromptPerformMethodInfo a signature where
    overloadedMethod = promptPerform

instance O.OverloadedMethodInfo PromptPerformMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Secret.Objects.Prompt.promptPerform",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-secret-0.0.15/docs/GI-Secret-Objects-Prompt.html#v:promptPerform"
        })


#endif

-- method Prompt::perform_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Prompt" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a prompt" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the asynchronous result passed to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TVariant
-- throws : True
-- Skip return : False

foreign import ccall "secret_prompt_perform_finish" secret_prompt_perform_finish :: 
    Ptr Prompt ->                           -- self : TInterface (Name {namespace = "Secret", name = "Prompt"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GVariant)

-- | Complete asynchronous operation to run a prompt and perform the prompting.
-- 
-- Returns a variant result if the prompt was completed and not dismissed. The
-- type of result depends on the action the prompt is completing, and is
-- defined in the Secret Service DBus API specification.
promptPerformFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrompt a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a prompt
    -> b
    -- ^ /@result@/: the asynchronous result passed to the callback
    -> m GVariant
    -- ^ __Returns:__ 'P.Nothing' if the prompt was dismissed or an error occurred,
    --   a variant result if the prompt was successful /(Can throw 'Data.GI.Base.GError.GError')/
promptPerformFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPrompt a, IsAsyncResult b) =>
a -> b -> m GVariant
promptPerformFinish a
self b
result_ = IO GVariant -> m GVariant
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
    Ptr Prompt
self' <- a -> IO (Ptr Prompt)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO GVariant -> IO () -> IO GVariant
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr GVariant
result <- (Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant))
-> (Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant)
forall a b. (a -> b) -> a -> b
$ Ptr Prompt
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr GVariant)
secret_prompt_perform_finish Ptr Prompt
self' Ptr AsyncResult
result_'
        Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"promptPerformFinish" Ptr GVariant
result
        GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        GVariant -> IO GVariant
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data PromptPerformFinishMethodInfo
instance (signature ~ (b -> m GVariant), MonadIO m, IsPrompt a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod PromptPerformFinishMethodInfo a signature where
    overloadedMethod = promptPerformFinish

instance O.OverloadedMethodInfo PromptPerformFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Secret.Objects.Prompt.promptPerformFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-secret-0.0.15/docs/GI-Secret-Objects-Prompt.html#v:promptPerformFinish"
        })


#endif

-- method Prompt::perform_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Prompt" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a prompt" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "window_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "string form of XWindow id for parent window to be transient for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "return_type"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "VariantType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the variant type of the prompt result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TVariant
-- throws : True
-- Skip return : False

foreign import ccall "secret_prompt_perform_sync" secret_prompt_perform_sync :: 
    Ptr Prompt ->                           -- self : TInterface (Name {namespace = "Secret", name = "Prompt"})
    CString ->                              -- window_id : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr GLib.VariantType.VariantType ->     -- return_type : TInterface (Name {namespace = "GLib", name = "VariantType"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GVariant)

-- | Runs a prompt and performs the prompting.
-- 
-- Returns a variant result if the prompt was completed and not dismissed. The
-- type of result depends on the action the prompt is completing, and is defined
-- in the Secret Service DBus API specification.
-- 
-- If /@windowId@/ is non-null then it is used as an XWindow id on Linux. The API
-- expects this id to be converted to a string using the @%d@ printf format. The
-- Secret Service can make its prompt transient for the window with this id. In
-- some Secret Service implementations this is not possible, so the behavior
-- depending on this should degrade gracefully.
-- 
-- This method may block indefinitely and should not be used in user interface
-- threads.
promptPerformSync ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrompt a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: a prompt
    -> Maybe (T.Text)
    -- ^ /@windowId@/: string form of XWindow id for parent window to be transient for
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> GLib.VariantType.VariantType
    -- ^ /@returnType@/: the variant type of the prompt result
    -> m GVariant
    -- ^ __Returns:__ 'P.Nothing' if the prompt was dismissed or an error occurred /(Can throw 'Data.GI.Base.GError.GError')/
promptPerformSync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPrompt a, IsCancellable b) =>
a -> Maybe Text -> Maybe b -> VariantType -> m GVariant
promptPerformSync a
self Maybe Text
windowId Maybe b
cancellable VariantType
returnType = IO GVariant -> m GVariant
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
    Ptr Prompt
self' <- a -> IO (Ptr Prompt)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CChar
maybeWindowId <- case Maybe Text
windowId of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jWindowId -> do
            Ptr CChar
jWindowId' <- Text -> IO (Ptr CChar)
textToCString Text
jWindowId
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jWindowId'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    Ptr VariantType
returnType' <- VariantType -> IO (Ptr VariantType)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VariantType
returnType
    IO GVariant -> IO () -> IO GVariant
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr GVariant
result <- (Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant))
-> (Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant)
forall a b. (a -> b) -> a -> b
$ Ptr Prompt
-> Ptr CChar
-> Ptr Cancellable
-> Ptr VariantType
-> Ptr (Ptr GError)
-> IO (Ptr GVariant)
secret_prompt_perform_sync Ptr Prompt
self' Ptr CChar
maybeWindowId Ptr Cancellable
maybeCancellable Ptr VariantType
returnType'
        Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"promptPerformSync" Ptr GVariant
result
        GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        VariantType -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VariantType
returnType
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeWindowId
        GVariant -> IO GVariant
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result'
     ) (do
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeWindowId
     )

#if defined(ENABLE_OVERLOADING)
data PromptPerformSyncMethodInfo
instance (signature ~ (Maybe (T.Text) -> Maybe (b) -> GLib.VariantType.VariantType -> m GVariant), MonadIO m, IsPrompt a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod PromptPerformSyncMethodInfo a signature where
    overloadedMethod = promptPerformSync

instance O.OverloadedMethodInfo PromptPerformSyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Secret.Objects.Prompt.promptPerformSync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-secret-0.0.15/docs/GI-Secret-Objects-Prompt.html#v:promptPerformSync"
        })


#endif

-- method Prompt::run
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Prompt" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a prompt" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "window_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "string form of XWindow id for parent window to be transient for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "optional cancellation object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "return_type"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "VariantType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the variant type of the prompt result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TVariant
-- throws : True
-- Skip return : False

foreign import ccall "secret_prompt_run" secret_prompt_run :: 
    Ptr Prompt ->                           -- self : TInterface (Name {namespace = "Secret", name = "Prompt"})
    CString ->                              -- window_id : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr GLib.VariantType.VariantType ->     -- return_type : TInterface (Name {namespace = "GLib", name = "VariantType"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GVariant)

-- | Runs a prompt and performs the prompting.
-- 
-- Returns a variant result if the prompt was completed and not dismissed. The
-- type of result depends on the action the prompt is completing, and is defined
-- in the Secret Service DBus API specification.
-- 
-- If /@windowId@/ is non-null then it is used as an XWindow id on Linux. The API
-- expects this id to be converted to a string using the @%d@ printf format. The
-- Secret Service can make its prompt transient for the window with this id. In
-- some Secret Service implementations this is not possible, so the behavior
-- depending on this should degrade gracefully.
-- 
-- This runs the dialog in a recursive mainloop. When run from a user interface
-- thread, this means the user interface will remain responsive. Care should be
-- taken that appropriate user interface actions are disabled while running the
-- prompt.
promptRun ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrompt a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: a prompt
    -> Maybe (T.Text)
    -- ^ /@windowId@/: string form of XWindow id for parent window to be transient for
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> GLib.VariantType.VariantType
    -- ^ /@returnType@/: the variant type of the prompt result
    -> m GVariant
    -- ^ __Returns:__ 'P.Nothing' if the prompt was dismissed or an error occurred /(Can throw 'Data.GI.Base.GError.GError')/
promptRun :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPrompt a, IsCancellable b) =>
a -> Maybe Text -> Maybe b -> VariantType -> m GVariant
promptRun a
self Maybe Text
windowId Maybe b
cancellable VariantType
returnType = IO GVariant -> m GVariant
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
    Ptr Prompt
self' <- a -> IO (Ptr Prompt)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CChar
maybeWindowId <- case Maybe Text
windowId of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jWindowId -> do
            Ptr CChar
jWindowId' <- Text -> IO (Ptr CChar)
textToCString Text
jWindowId
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jWindowId'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    Ptr VariantType
returnType' <- VariantType -> IO (Ptr VariantType)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VariantType
returnType
    IO GVariant -> IO () -> IO GVariant
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr GVariant
result <- (Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant))
-> (Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant)
forall a b. (a -> b) -> a -> b
$ Ptr Prompt
-> Ptr CChar
-> Ptr Cancellable
-> Ptr VariantType
-> Ptr (Ptr GError)
-> IO (Ptr GVariant)
secret_prompt_run Ptr Prompt
self' Ptr CChar
maybeWindowId Ptr Cancellable
maybeCancellable Ptr VariantType
returnType'
        Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"promptRun" Ptr GVariant
result
        GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        VariantType -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VariantType
returnType
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeWindowId
        GVariant -> IO GVariant
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result'
     ) (do
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeWindowId
     )

#if defined(ENABLE_OVERLOADING)
data PromptRunMethodInfo
instance (signature ~ (Maybe (T.Text) -> Maybe (b) -> GLib.VariantType.VariantType -> m GVariant), MonadIO m, IsPrompt a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod PromptRunMethodInfo a signature where
    overloadedMethod = promptRun

instance O.OverloadedMethodInfo PromptRunMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Secret.Objects.Prompt.promptRun",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-secret-0.0.15/docs/GI-Secret-Objects-Prompt.html#v:promptRun"
        })


#endif