{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A proxy object representing a collection of secrets in the Secret Service.

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

module GI.Secret.Objects.Collection
    ( 

-- * Exported types
    Collection(..)                          ,
    IsCollection                            ,
    toCollection                            ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveCollectionMethod                 ,
#endif


-- ** create #method:create#

    collectionCreate                        ,


-- ** createFinish #method:createFinish#

    collectionCreateFinish                  ,


-- ** createSync #method:createSync#

    collectionCreateSync                    ,


-- ** delete #method:delete#

#if defined(ENABLE_OVERLOADING)
    CollectionDeleteMethodInfo              ,
#endif
    collectionDelete                        ,


-- ** deleteFinish #method:deleteFinish#

#if defined(ENABLE_OVERLOADING)
    CollectionDeleteFinishMethodInfo        ,
#endif
    collectionDeleteFinish                  ,


-- ** deleteSync #method:deleteSync#

#if defined(ENABLE_OVERLOADING)
    CollectionDeleteSyncMethodInfo          ,
#endif
    collectionDeleteSync                    ,


-- ** forAlias #method:forAlias#

    collectionForAlias                      ,


-- ** forAliasFinish #method:forAliasFinish#

    collectionForAliasFinish                ,


-- ** forAliasSync #method:forAliasSync#

    collectionForAliasSync                  ,


-- ** getCreated #method:getCreated#

#if defined(ENABLE_OVERLOADING)
    CollectionGetCreatedMethodInfo          ,
#endif
    collectionGetCreated                    ,


-- ** getFlags #method:getFlags#

#if defined(ENABLE_OVERLOADING)
    CollectionGetFlagsMethodInfo            ,
#endif
    collectionGetFlags                      ,


-- ** getItems #method:getItems#

#if defined(ENABLE_OVERLOADING)
    CollectionGetItemsMethodInfo            ,
#endif
    collectionGetItems                      ,


-- ** getLabel #method:getLabel#

#if defined(ENABLE_OVERLOADING)
    CollectionGetLabelMethodInfo            ,
#endif
    collectionGetLabel                      ,


-- ** getLocked #method:getLocked#

#if defined(ENABLE_OVERLOADING)
    CollectionGetLockedMethodInfo           ,
#endif
    collectionGetLocked                     ,


-- ** getModified #method:getModified#

#if defined(ENABLE_OVERLOADING)
    CollectionGetModifiedMethodInfo         ,
#endif
    collectionGetModified                   ,


-- ** getService #method:getService#

#if defined(ENABLE_OVERLOADING)
    CollectionGetServiceMethodInfo          ,
#endif
    collectionGetService                    ,


-- ** loadItems #method:loadItems#

#if defined(ENABLE_OVERLOADING)
    CollectionLoadItemsMethodInfo           ,
#endif
    collectionLoadItems                     ,


-- ** loadItemsFinish #method:loadItemsFinish#

#if defined(ENABLE_OVERLOADING)
    CollectionLoadItemsFinishMethodInfo     ,
#endif
    collectionLoadItemsFinish               ,


-- ** loadItemsSync #method:loadItemsSync#

#if defined(ENABLE_OVERLOADING)
    CollectionLoadItemsSyncMethodInfo       ,
#endif
    collectionLoadItemsSync                 ,


-- ** refresh #method:refresh#

#if defined(ENABLE_OVERLOADING)
    CollectionRefreshMethodInfo             ,
#endif
    collectionRefresh                       ,


-- ** search #method:search#

#if defined(ENABLE_OVERLOADING)
    CollectionSearchMethodInfo              ,
#endif
    collectionSearch                        ,


-- ** searchFinish #method:searchFinish#

#if defined(ENABLE_OVERLOADING)
    CollectionSearchFinishMethodInfo        ,
#endif
    collectionSearchFinish                  ,


-- ** searchSync #method:searchSync#

#if defined(ENABLE_OVERLOADING)
    CollectionSearchSyncMethodInfo          ,
#endif
    collectionSearchSync                    ,


-- ** setLabel #method:setLabel#

#if defined(ENABLE_OVERLOADING)
    CollectionSetLabelMethodInfo            ,
#endif
    collectionSetLabel                      ,


-- ** setLabelFinish #method:setLabelFinish#

#if defined(ENABLE_OVERLOADING)
    CollectionSetLabelFinishMethodInfo      ,
#endif
    collectionSetLabelFinish                ,


-- ** setLabelSync #method:setLabelSync#

#if defined(ENABLE_OVERLOADING)
    CollectionSetLabelSyncMethodInfo        ,
#endif
    collectionSetLabelSync                  ,




 -- * Properties
-- ** created #attr:created#
-- | The date and time (in seconds since the UNIX epoch) that this
-- collection was created.

#if defined(ENABLE_OVERLOADING)
    CollectionCreatedPropertyInfo           ,
#endif
#if defined(ENABLE_OVERLOADING)
    collectionCreated                       ,
#endif
    constructCollectionCreated              ,
    getCollectionCreated                    ,
    setCollectionCreated                    ,


-- ** flags #attr:flags#
-- | A set of flags describing which parts of the secret collection have
-- been initialized.

#if defined(ENABLE_OVERLOADING)
    CollectionFlagsPropertyInfo             ,
#endif
#if defined(ENABLE_OVERLOADING)
    collectionFlags                         ,
#endif
    constructCollectionFlags                ,
    getCollectionFlags                      ,


-- ** label #attr:label#
-- | The human readable label for the collection.
-- 
-- Setting this property will result in the label of the collection being
-- set asynchronously. To properly track the changing of the label use the
-- 'GI.Secret.Objects.Collection.collectionSetLabel' function.

#if defined(ENABLE_OVERLOADING)
    CollectionLabelPropertyInfo             ,
#endif
    clearCollectionLabel                    ,
#if defined(ENABLE_OVERLOADING)
    collectionLabel                         ,
#endif
    constructCollectionLabel                ,
    getCollectionLabel                      ,
    setCollectionLabel                      ,


-- ** locked #attr:locked#
-- | Whether the collection is locked or not.
-- 
-- To lock or unlock a collection use the 'GI.Secret.Objects.Service.serviceLock' or
-- 'GI.Secret.Objects.Service.serviceUnlock' functions.

#if defined(ENABLE_OVERLOADING)
    CollectionLockedPropertyInfo            ,
#endif
#if defined(ENABLE_OVERLOADING)
    collectionLocked                        ,
#endif
    getCollectionLocked                     ,


-- ** modified #attr:modified#
-- | The date and time (in seconds since the UNIX epoch) that this
-- collection was last modified.

#if defined(ENABLE_OVERLOADING)
    CollectionModifiedPropertyInfo          ,
#endif
#if defined(ENABLE_OVERLOADING)
    collectionModified                      ,
#endif
    constructCollectionModified             ,
    getCollectionModified                   ,
    setCollectionModified                   ,


-- ** service #attr:service#
-- | The t'GI.Secret.Objects.Service.Service' object that this collection is associated with and
-- uses to interact with the actual D-Bus Secret Service.

#if defined(ENABLE_OVERLOADING)
    CollectionServicePropertyInfo           ,
#endif
#if defined(ENABLE_OVERLOADING)
    collectionService                       ,
#endif
    constructCollectionService              ,
    getCollectionService                    ,




    ) 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.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
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.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 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
import {-# SOURCE #-} qualified GI.Secret.Flags as Secret.Flags
import {-# SOURCE #-} qualified GI.Secret.Objects.Item as Secret.Item
import {-# SOURCE #-} qualified GI.Secret.Objects.Service as Secret.Service
import {-# SOURCE #-} qualified GI.Secret.Structs.Schema as Secret.Schema

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

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

foreign import ccall "secret_collection_get_type"
    c_secret_collection_get_type :: IO B.Types.GType

instance B.Types.TypedObject Collection where
    glibType :: IO GType
glibType = IO GType
c_secret_collection_get_type

instance B.Types.GObject Collection

-- | Convert 'Collection' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Collection where
    toGValue :: Collection -> IO GValue
toGValue Collection
o = do
        GType
gtype <- IO GType
c_secret_collection_get_type
        Collection -> (Ptr Collection -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Collection
o (GType
-> (GValue -> Ptr Collection -> IO ())
-> Ptr Collection
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Collection -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO Collection
fromGValue GValue
gv = do
        Ptr Collection
ptr <- GValue -> IO (Ptr Collection)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr Collection)
        (ManagedPtr Collection -> Collection)
-> Ptr Collection -> IO Collection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Collection -> Collection
Collection Ptr Collection
ptr
        
    

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveCollectionMethod (t :: Symbol) (o :: *) :: * where
    ResolveCollectionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveCollectionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveCollectionMethod "call" o = Gio.DBusProxy.DBusProxyCallMethodInfo
    ResolveCollectionMethod "callFinish" o = Gio.DBusProxy.DBusProxyCallFinishMethodInfo
    ResolveCollectionMethod "callSync" o = Gio.DBusProxy.DBusProxyCallSyncMethodInfo
    ResolveCollectionMethod "callWithUnixFdList" o = Gio.DBusProxy.DBusProxyCallWithUnixFdListMethodInfo
    ResolveCollectionMethod "callWithUnixFdListFinish" o = Gio.DBusProxy.DBusProxyCallWithUnixFdListFinishMethodInfo
    ResolveCollectionMethod "callWithUnixFdListSync" o = Gio.DBusProxy.DBusProxyCallWithUnixFdListSyncMethodInfo
    ResolveCollectionMethod "delete" o = CollectionDeleteMethodInfo
    ResolveCollectionMethod "deleteFinish" o = CollectionDeleteFinishMethodInfo
    ResolveCollectionMethod "deleteSync" o = CollectionDeleteSyncMethodInfo
    ResolveCollectionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveCollectionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveCollectionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveCollectionMethod "init" o = Gio.Initable.InitableInitMethodInfo
    ResolveCollectionMethod "initAsync" o = Gio.AsyncInitable.AsyncInitableInitAsyncMethodInfo
    ResolveCollectionMethod "initFinish" o = Gio.AsyncInitable.AsyncInitableInitFinishMethodInfo
    ResolveCollectionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveCollectionMethod "loadItems" o = CollectionLoadItemsMethodInfo
    ResolveCollectionMethod "loadItemsFinish" o = CollectionLoadItemsFinishMethodInfo
    ResolveCollectionMethod "loadItemsSync" o = CollectionLoadItemsSyncMethodInfo
    ResolveCollectionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveCollectionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveCollectionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveCollectionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveCollectionMethod "refresh" o = CollectionRefreshMethodInfo
    ResolveCollectionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveCollectionMethod "search" o = CollectionSearchMethodInfo
    ResolveCollectionMethod "searchFinish" o = CollectionSearchFinishMethodInfo
    ResolveCollectionMethod "searchSync" o = CollectionSearchSyncMethodInfo
    ResolveCollectionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveCollectionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveCollectionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveCollectionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveCollectionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveCollectionMethod "getCachedProperty" o = Gio.DBusProxy.DBusProxyGetCachedPropertyMethodInfo
    ResolveCollectionMethod "getCachedPropertyNames" o = Gio.DBusProxy.DBusProxyGetCachedPropertyNamesMethodInfo
    ResolveCollectionMethod "getConnection" o = Gio.DBusProxy.DBusProxyGetConnectionMethodInfo
    ResolveCollectionMethod "getCreated" o = CollectionGetCreatedMethodInfo
    ResolveCollectionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveCollectionMethod "getDefaultTimeout" o = Gio.DBusProxy.DBusProxyGetDefaultTimeoutMethodInfo
    ResolveCollectionMethod "getFlags" o = CollectionGetFlagsMethodInfo
    ResolveCollectionMethod "getInfo" o = Gio.DBusInterface.DBusInterfaceGetInfoMethodInfo
    ResolveCollectionMethod "getInterfaceInfo" o = Gio.DBusProxy.DBusProxyGetInterfaceInfoMethodInfo
    ResolveCollectionMethod "getInterfaceName" o = Gio.DBusProxy.DBusProxyGetInterfaceNameMethodInfo
    ResolveCollectionMethod "getItems" o = CollectionGetItemsMethodInfo
    ResolveCollectionMethod "getLabel" o = CollectionGetLabelMethodInfo
    ResolveCollectionMethod "getLocked" o = CollectionGetLockedMethodInfo
    ResolveCollectionMethod "getModified" o = CollectionGetModifiedMethodInfo
    ResolveCollectionMethod "getName" o = Gio.DBusProxy.DBusProxyGetNameMethodInfo
    ResolveCollectionMethod "getNameOwner" o = Gio.DBusProxy.DBusProxyGetNameOwnerMethodInfo
    ResolveCollectionMethod "getObject" o = Gio.DBusInterface.DBusInterfaceGetObjectMethodInfo
    ResolveCollectionMethod "getObjectPath" o = Gio.DBusProxy.DBusProxyGetObjectPathMethodInfo
    ResolveCollectionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveCollectionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveCollectionMethod "getService" o = CollectionGetServiceMethodInfo
    ResolveCollectionMethod "setCachedProperty" o = Gio.DBusProxy.DBusProxySetCachedPropertyMethodInfo
    ResolveCollectionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveCollectionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveCollectionMethod "setDefaultTimeout" o = Gio.DBusProxy.DBusProxySetDefaultTimeoutMethodInfo
    ResolveCollectionMethod "setInterfaceInfo" o = Gio.DBusProxy.DBusProxySetInterfaceInfoMethodInfo
    ResolveCollectionMethod "setLabel" o = CollectionSetLabelMethodInfo
    ResolveCollectionMethod "setLabelFinish" o = CollectionSetLabelFinishMethodInfo
    ResolveCollectionMethod "setLabelSync" o = CollectionSetLabelSyncMethodInfo
    ResolveCollectionMethod "setObject" o = Gio.DBusInterface.DBusInterfaceSetObjectMethodInfo
    ResolveCollectionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveCollectionMethod l o = O.MethodResolutionFailed l o

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

#endif

-- VVV Prop "created"
   -- Type: TBasicType TUInt64
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@created@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' collection #created
-- @
getCollectionCreated :: (MonadIO m, IsCollection o) => o -> m Word64
getCollectionCreated :: o -> m Word64
getCollectionCreated o
obj = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word64
forall a. GObject a => a -> String -> IO Word64
B.Properties.getObjectPropertyUInt64 o
obj String
"created"

-- | Set the value of the “@created@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' collection [ #created 'Data.GI.Base.Attributes.:=' value ]
-- @
setCollectionCreated :: (MonadIO m, IsCollection o) => o -> Word64 -> m ()
setCollectionCreated :: o -> Word64 -> m ()
setCollectionCreated o
obj Word64
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Word64 -> IO ()
forall a. GObject a => a -> String -> Word64 -> IO ()
B.Properties.setObjectPropertyUInt64 o
obj String
"created" Word64
val

-- | Construct a `GValueConstruct` with valid value for the “@created@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCollectionCreated :: (IsCollection o, MIO.MonadIO m) => Word64 -> m (GValueConstruct o)
constructCollectionCreated :: Word64 -> m (GValueConstruct o)
constructCollectionCreated Word64
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word64 -> IO (GValueConstruct o)
forall o. String -> Word64 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt64 String
"created" Word64
val

#if defined(ENABLE_OVERLOADING)
data CollectionCreatedPropertyInfo
instance AttrInfo CollectionCreatedPropertyInfo where
    type AttrAllowedOps CollectionCreatedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint CollectionCreatedPropertyInfo = IsCollection
    type AttrSetTypeConstraint CollectionCreatedPropertyInfo = (~) Word64
    type AttrTransferTypeConstraint CollectionCreatedPropertyInfo = (~) Word64
    type AttrTransferType CollectionCreatedPropertyInfo = Word64
    type AttrGetType CollectionCreatedPropertyInfo = Word64
    type AttrLabel CollectionCreatedPropertyInfo = "created"
    type AttrOrigin CollectionCreatedPropertyInfo = Collection
    attrGet = getCollectionCreated
    attrSet = setCollectionCreated
    attrTransfer _ v = do
        return v
    attrConstruct = constructCollectionCreated
    attrClear = undefined
#endif

-- VVV Prop "flags"
   -- Type: TInterface (Name {namespace = "Secret", name = "CollectionFlags"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' collection #flags
-- @
getCollectionFlags :: (MonadIO m, IsCollection o) => o -> m [Secret.Flags.CollectionFlags]
getCollectionFlags :: o -> m [CollectionFlags]
getCollectionFlags o
obj = IO [CollectionFlags] -> m [CollectionFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [CollectionFlags] -> m [CollectionFlags])
-> IO [CollectionFlags] -> m [CollectionFlags]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [CollectionFlags]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"flags"

-- | Construct a `GValueConstruct` with valid value for the “@flags@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCollectionFlags :: (IsCollection o, MIO.MonadIO m) => [Secret.Flags.CollectionFlags] -> m (GValueConstruct o)
constructCollectionFlags :: [CollectionFlags] -> m (GValueConstruct o)
constructCollectionFlags [CollectionFlags]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> [CollectionFlags] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"flags" [CollectionFlags]
val

#if defined(ENABLE_OVERLOADING)
data CollectionFlagsPropertyInfo
instance AttrInfo CollectionFlagsPropertyInfo where
    type AttrAllowedOps CollectionFlagsPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint CollectionFlagsPropertyInfo = IsCollection
    type AttrSetTypeConstraint CollectionFlagsPropertyInfo = (~) [Secret.Flags.CollectionFlags]
    type AttrTransferTypeConstraint CollectionFlagsPropertyInfo = (~) [Secret.Flags.CollectionFlags]
    type AttrTransferType CollectionFlagsPropertyInfo = [Secret.Flags.CollectionFlags]
    type AttrGetType CollectionFlagsPropertyInfo = [Secret.Flags.CollectionFlags]
    type AttrLabel CollectionFlagsPropertyInfo = "flags"
    type AttrOrigin CollectionFlagsPropertyInfo = Collection
    attrGet = getCollectionFlags
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructCollectionFlags
    attrClear = undefined
#endif

-- VVV Prop "label"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@label@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' collection #label
-- @
getCollectionLabel :: (MonadIO m, IsCollection o) => o -> m (Maybe T.Text)
getCollectionLabel :: o -> m (Maybe Text)
getCollectionLabel o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"label"

-- | Set the value of the “@label@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' collection [ #label 'Data.GI.Base.Attributes.:=' value ]
-- @
setCollectionLabel :: (MonadIO m, IsCollection o) => o -> T.Text -> m ()
setCollectionLabel :: o -> Text -> m ()
setCollectionLabel o
obj Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"label" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@label@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCollectionLabel :: (IsCollection o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructCollectionLabel :: Text -> m (GValueConstruct o)
constructCollectionLabel Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"label" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@label@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #label
-- @
clearCollectionLabel :: (MonadIO m, IsCollection o) => o -> m ()
clearCollectionLabel :: o -> m ()
clearCollectionLabel o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"label" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data CollectionLabelPropertyInfo
instance AttrInfo CollectionLabelPropertyInfo where
    type AttrAllowedOps CollectionLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint CollectionLabelPropertyInfo = IsCollection
    type AttrSetTypeConstraint CollectionLabelPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint CollectionLabelPropertyInfo = (~) T.Text
    type AttrTransferType CollectionLabelPropertyInfo = T.Text
    type AttrGetType CollectionLabelPropertyInfo = (Maybe T.Text)
    type AttrLabel CollectionLabelPropertyInfo = "label"
    type AttrOrigin CollectionLabelPropertyInfo = Collection
    attrGet = getCollectionLabel
    attrSet = setCollectionLabel
    attrTransfer _ v = do
        return v
    attrConstruct = constructCollectionLabel
    attrClear = clearCollectionLabel
#endif

-- VVV Prop "locked"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@locked@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' collection #locked
-- @
getCollectionLocked :: (MonadIO m, IsCollection o) => o -> m Bool
getCollectionLocked :: o -> m Bool
getCollectionLocked o
obj = IO Bool -> m Bool
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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"locked"

#if defined(ENABLE_OVERLOADING)
data CollectionLockedPropertyInfo
instance AttrInfo CollectionLockedPropertyInfo where
    type AttrAllowedOps CollectionLockedPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint CollectionLockedPropertyInfo = IsCollection
    type AttrSetTypeConstraint CollectionLockedPropertyInfo = (~) ()
    type AttrTransferTypeConstraint CollectionLockedPropertyInfo = (~) ()
    type AttrTransferType CollectionLockedPropertyInfo = ()
    type AttrGetType CollectionLockedPropertyInfo = Bool
    type AttrLabel CollectionLockedPropertyInfo = "locked"
    type AttrOrigin CollectionLockedPropertyInfo = Collection
    attrGet = getCollectionLocked
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "modified"
   -- Type: TBasicType TUInt64
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@modified@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' collection #modified
-- @
getCollectionModified :: (MonadIO m, IsCollection o) => o -> m Word64
getCollectionModified :: o -> m Word64
getCollectionModified o
obj = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word64
forall a. GObject a => a -> String -> IO Word64
B.Properties.getObjectPropertyUInt64 o
obj String
"modified"

-- | Set the value of the “@modified@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' collection [ #modified 'Data.GI.Base.Attributes.:=' value ]
-- @
setCollectionModified :: (MonadIO m, IsCollection o) => o -> Word64 -> m ()
setCollectionModified :: o -> Word64 -> m ()
setCollectionModified o
obj Word64
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Word64 -> IO ()
forall a. GObject a => a -> String -> Word64 -> IO ()
B.Properties.setObjectPropertyUInt64 o
obj String
"modified" Word64
val

-- | Construct a `GValueConstruct` with valid value for the “@modified@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCollectionModified :: (IsCollection o, MIO.MonadIO m) => Word64 -> m (GValueConstruct o)
constructCollectionModified :: Word64 -> m (GValueConstruct o)
constructCollectionModified Word64
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word64 -> IO (GValueConstruct o)
forall o. String -> Word64 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt64 String
"modified" Word64
val

#if defined(ENABLE_OVERLOADING)
data CollectionModifiedPropertyInfo
instance AttrInfo CollectionModifiedPropertyInfo where
    type AttrAllowedOps CollectionModifiedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint CollectionModifiedPropertyInfo = IsCollection
    type AttrSetTypeConstraint CollectionModifiedPropertyInfo = (~) Word64
    type AttrTransferTypeConstraint CollectionModifiedPropertyInfo = (~) Word64
    type AttrTransferType CollectionModifiedPropertyInfo = Word64
    type AttrGetType CollectionModifiedPropertyInfo = Word64
    type AttrLabel CollectionModifiedPropertyInfo = "modified"
    type AttrOrigin CollectionModifiedPropertyInfo = Collection
    attrGet = getCollectionModified
    attrSet = setCollectionModified
    attrTransfer _ v = do
        return v
    attrConstruct = constructCollectionModified
    attrClear = undefined
#endif

-- VVV Prop "service"
   -- Type: TInterface (Name {namespace = "Secret", name = "Service"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@service@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' collection #service
-- @
getCollectionService :: (MonadIO m, IsCollection o) => o -> m Secret.Service.Service
getCollectionService :: o -> m Service
getCollectionService o
obj = IO Service -> m Service
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Service -> m Service) -> IO Service -> m Service
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Service) -> IO Service
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getCollectionService" (IO (Maybe Service) -> IO Service)
-> IO (Maybe Service) -> IO Service
forall a b. (a -> b) -> a -> b
$ o
-> String -> (ManagedPtr Service -> Service) -> IO (Maybe Service)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"service" ManagedPtr Service -> Service
Secret.Service.Service

-- | Construct a `GValueConstruct` with valid value for the “@service@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCollectionService :: (IsCollection o, MIO.MonadIO m, Secret.Service.IsService a) => a -> m (GValueConstruct o)
constructCollectionService :: a -> m (GValueConstruct o)
constructCollectionService a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"service" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data CollectionServicePropertyInfo
instance AttrInfo CollectionServicePropertyInfo where
    type AttrAllowedOps CollectionServicePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint CollectionServicePropertyInfo = IsCollection
    type AttrSetTypeConstraint CollectionServicePropertyInfo = Secret.Service.IsService
    type AttrTransferTypeConstraint CollectionServicePropertyInfo = Secret.Service.IsService
    type AttrTransferType CollectionServicePropertyInfo = Secret.Service.Service
    type AttrGetType CollectionServicePropertyInfo = Secret.Service.Service
    type AttrLabel CollectionServicePropertyInfo = "service"
    type AttrOrigin CollectionServicePropertyInfo = Collection
    attrGet = getCollectionService
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Secret.Service.Service v
    attrConstruct = constructCollectionService
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Collection
type instance O.AttributeList Collection = CollectionAttributeList
type CollectionAttributeList = ('[ '("created", CollectionCreatedPropertyInfo), '("flags", CollectionFlagsPropertyInfo), '("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), '("label", CollectionLabelPropertyInfo), '("locked", CollectionLockedPropertyInfo), '("modified", CollectionModifiedPropertyInfo), '("service", CollectionServicePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
collectionCreated :: AttrLabelProxy "created"
collectionCreated = AttrLabelProxy

collectionFlags :: AttrLabelProxy "flags"
collectionFlags = AttrLabelProxy

collectionLabel :: AttrLabelProxy "label"
collectionLabel = AttrLabelProxy

collectionLocked :: AttrLabelProxy "locked"
collectionLocked = AttrLabelProxy

collectionModified :: AttrLabelProxy "modified"
collectionModified = AttrLabelProxy

collectionService :: AttrLabelProxy "service"
collectionService = AttrLabelProxy

#endif

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

#endif

-- method Collection::delete
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Collection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a collection" , 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 = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass 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_collection_delete" secret_collection_delete :: 
    Ptr Collection ->                       -- self : TInterface (Name {namespace = "Secret", name = "Collection"})
    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 ()

-- | Delete this collection.
-- 
-- This method returns immediately and completes asynchronously. The secret
-- service may prompt the user. 'GI.Secret.Objects.Service.servicePrompt' will be used to handle
-- any prompts that show up.
collectionDelete ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: a collection
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: called when the operation completes
    -> m ()
collectionDelete :: a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
collectionDelete a
self Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Collection
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
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 (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 (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 (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 Collection
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
secret_collection_delete Ptr Collection
self' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    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
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CollectionDeleteMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) => O.MethodInfo CollectionDeleteMethodInfo a signature where
    overloadedMethod = collectionDelete

#endif

-- method Collection::delete_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Collection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a collection" , 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 "asynchronous result passed to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

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

-- | Complete operation to delete this collection.
collectionDeleteFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a collection
    -> b
    -- ^ /@result@/: asynchronous result passed to the callback
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
collectionDeleteFinish :: a -> b -> m ()
collectionDeleteFinish a
self b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Collection
self' <- a -> IO (Ptr Collection)
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 () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Collection -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
secret_collection_delete_finish Ptr Collection
self' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data CollectionDeleteFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsCollection a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo CollectionDeleteFinishMethodInfo a signature where
    overloadedMethod = collectionDeleteFinish

#endif

-- method Collection::delete_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Collection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a collection" , 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "secret_collection_delete_sync" secret_collection_delete_sync :: 
    Ptr Collection ->                       -- self : TInterface (Name {namespace = "Secret", name = "Collection"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Delete this collection.
-- 
-- This method may block indefinitely and should not be used in user
-- interface threads. The secret service may prompt the user.
-- 'GI.Secret.Objects.Service.servicePrompt' will be used to handle any prompts that show up.
collectionDeleteSync ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: a collection
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
collectionDeleteSync :: a -> Maybe b -> m ()
collectionDeleteSync a
self Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Collection
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
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 (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Collection -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
secret_collection_delete_sync Ptr Collection
self' Ptr Cancellable
maybeCancellable
        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
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data CollectionDeleteSyncMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) => O.MethodInfo CollectionDeleteSyncMethodInfo a signature where
    overloadedMethod = collectionDeleteSync

#endif

-- method Collection::get_created
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Collection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a collection" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "secret_collection_get_created" secret_collection_get_created :: 
    Ptr Collection ->                       -- self : TInterface (Name {namespace = "Secret", name = "Collection"})
    IO Word64

-- | Get the created date and time of the collection. The return value is
-- the number of seconds since the unix epoch, January 1st 1970.
collectionGetCreated ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollection a) =>
    a
    -- ^ /@self@/: a collection
    -> m Word64
    -- ^ __Returns:__ the created date and time
collectionGetCreated :: a -> m Word64
collectionGetCreated a
self = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Collection
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word64
result <- Ptr Collection -> IO Word64
secret_collection_get_created Ptr Collection
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data CollectionGetCreatedMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsCollection a) => O.MethodInfo CollectionGetCreatedMethodInfo a signature where
    overloadedMethod = collectionGetCreated

#endif

-- method Collection::get_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Collection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret collection proxy"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Secret" , name = "CollectionFlags" })
-- throws : False
-- Skip return : False

foreign import ccall "secret_collection_get_flags" secret_collection_get_flags :: 
    Ptr Collection ->                       -- self : TInterface (Name {namespace = "Secret", name = "Collection"})
    IO CUInt

-- | Get the flags representing what features of the t'GI.Secret.Objects.Collection.Collection' proxy
-- have been initialized.
-- 
-- Use 'GI.Secret.Objects.Collection.collectionLoadItems'  to initialize further features
-- and change the flags.
collectionGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollection a) =>
    a
    -- ^ /@self@/: the secret collection proxy
    -> m [Secret.Flags.CollectionFlags]
    -- ^ __Returns:__ the flags for features initialized
collectionGetFlags :: a -> m [CollectionFlags]
collectionGetFlags a
self = IO [CollectionFlags] -> m [CollectionFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [CollectionFlags] -> m [CollectionFlags])
-> IO [CollectionFlags] -> m [CollectionFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Collection
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr Collection -> IO CUInt
secret_collection_get_flags Ptr Collection
self'
    let result' :: [CollectionFlags]
result' = CUInt -> [CollectionFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    [CollectionFlags] -> IO [CollectionFlags]
forall (m :: * -> *) a. Monad m => a -> m a
return [CollectionFlags]
result'

#if defined(ENABLE_OVERLOADING)
data CollectionGetFlagsMethodInfo
instance (signature ~ (m [Secret.Flags.CollectionFlags]), MonadIO m, IsCollection a) => O.MethodInfo CollectionGetFlagsMethodInfo a signature where
    overloadedMethod = collectionGetFlags

#endif

-- method Collection::get_items
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Collection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a collection" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList (TInterface Name { namespace = "Secret" , name = "Item" }))
-- throws : False
-- Skip return : False

foreign import ccall "secret_collection_get_items" secret_collection_get_items :: 
    Ptr Collection ->                       -- self : TInterface (Name {namespace = "Secret", name = "Collection"})
    IO (Ptr (GList (Ptr Secret.Item.Item)))

-- | Get the list of items in this collection.
collectionGetItems ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollection a) =>
    a
    -- ^ /@self@/: a collection
    -> m [Secret.Item.Item]
    -- ^ __Returns:__ a list of items,
    -- when done, the list should be freed with g_list_free, and each item should
    -- be released with 'GI.GObject.Objects.Object.objectUnref'
collectionGetItems :: a -> m [Item]
collectionGetItems a
self = IO [Item] -> m [Item]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Item] -> m [Item]) -> IO [Item] -> m [Item]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Collection
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr (GList (Ptr Item))
result <- Ptr Collection -> IO (Ptr (GList (Ptr Item)))
secret_collection_get_items Ptr Collection
self'
    [Ptr Item]
result' <- Ptr (GList (Ptr Item)) -> IO [Ptr Item]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Item))
result
    [Item]
result'' <- (Ptr Item -> IO Item) -> [Ptr Item] -> IO [Item]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Item -> Item) -> Ptr Item -> IO Item
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Item -> Item
Secret.Item.Item) [Ptr Item]
result'
    Ptr (GList (Ptr Item)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Item))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    [Item] -> IO [Item]
forall (m :: * -> *) a. Monad m => a -> m a
return [Item]
result''

#if defined(ENABLE_OVERLOADING)
data CollectionGetItemsMethodInfo
instance (signature ~ (m [Secret.Item.Item]), MonadIO m, IsCollection a) => O.MethodInfo CollectionGetItemsMethodInfo a signature where
    overloadedMethod = collectionGetItems

#endif

-- method Collection::get_label
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Collection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a collection" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "secret_collection_get_label" secret_collection_get_label :: 
    Ptr Collection ->                       -- self : TInterface (Name {namespace = "Secret", name = "Collection"})
    IO CString

-- | Get the label of this collection.
collectionGetLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollection a) =>
    a
    -- ^ /@self@/: a collection
    -> m T.Text
    -- ^ __Returns:__ the label, which should be freed with 'GI.GLib.Functions.free'
collectionGetLabel :: a -> m Text
collectionGetLabel a
self = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Collection
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Collection -> IO CString
secret_collection_get_label Ptr Collection
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"collectionGetLabel" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data CollectionGetLabelMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsCollection a) => O.MethodInfo CollectionGetLabelMethodInfo a signature where
    overloadedMethod = collectionGetLabel

#endif

-- method Collection::get_locked
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Collection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a collection" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "secret_collection_get_locked" secret_collection_get_locked :: 
    Ptr Collection ->                       -- self : TInterface (Name {namespace = "Secret", name = "Collection"})
    IO CInt

-- | Get whether the collection is locked or not.
-- 
-- Use 'GI.Secret.Objects.Service.serviceLock' or 'GI.Secret.Objects.Service.serviceUnlock' to lock or unlock the
-- collection.
collectionGetLocked ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollection a) =>
    a
    -- ^ /@self@/: a collection
    -> m Bool
    -- ^ __Returns:__ whether the collection is locked or not
collectionGetLocked :: a -> m Bool
collectionGetLocked a
self = IO Bool -> m Bool
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 Collection
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr Collection -> IO CInt
secret_collection_get_locked Ptr Collection
self'
    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
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CollectionGetLockedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsCollection a) => O.MethodInfo CollectionGetLockedMethodInfo a signature where
    overloadedMethod = collectionGetLocked

#endif

-- method Collection::get_modified
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Collection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a collection" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "secret_collection_get_modified" secret_collection_get_modified :: 
    Ptr Collection ->                       -- self : TInterface (Name {namespace = "Secret", name = "Collection"})
    IO Word64

-- | Get the modified date and time of the collection. The return value is
-- the number of seconds since the unix epoch, January 1st 1970.
collectionGetModified ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollection a) =>
    a
    -- ^ /@self@/: a collection
    -> m Word64
    -- ^ __Returns:__ the modified date and time
collectionGetModified :: a -> m Word64
collectionGetModified a
self = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Collection
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word64
result <- Ptr Collection -> IO Word64
secret_collection_get_modified Ptr Collection
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data CollectionGetModifiedMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsCollection a) => O.MethodInfo CollectionGetModifiedMethodInfo a signature where
    overloadedMethod = collectionGetModified

#endif

-- method Collection::get_service
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Collection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a collection" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Secret" , name = "Service" })
-- throws : False
-- Skip return : False

foreign import ccall "secret_collection_get_service" secret_collection_get_service :: 
    Ptr Collection ->                       -- self : TInterface (Name {namespace = "Secret", name = "Collection"})
    IO (Ptr Secret.Service.Service)

-- | Get the Secret Service object that this collection was created with.
collectionGetService ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollection a) =>
    a
    -- ^ /@self@/: a collection
    -> m Secret.Service.Service
    -- ^ __Returns:__ the Secret Service object
collectionGetService :: a -> m Service
collectionGetService a
self = IO Service -> m Service
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Service -> m Service) -> IO Service -> m Service
forall a b. (a -> b) -> a -> b
$ do
    Ptr Collection
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Service
result <- Ptr Collection -> IO (Ptr Service)
secret_collection_get_service Ptr Collection
self'
    Text -> Ptr Service -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"collectionGetService" Ptr Service
result
    Service
result' <- ((ManagedPtr Service -> Service) -> Ptr Service -> IO Service
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Service -> Service
Secret.Service.Service) Ptr Service
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Service -> IO Service
forall (m :: * -> *) a. Monad m => a -> m a
return Service
result'

#if defined(ENABLE_OVERLOADING)
data CollectionGetServiceMethodInfo
instance (signature ~ (m Secret.Service.Service), MonadIO m, IsCollection a) => O.MethodInfo CollectionGetServiceMethodInfo a signature where
    overloadedMethod = collectionGetService

#endif

-- method Collection::load_items
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Collection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret collection"
--                 , 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 = 3
--           , 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_collection_load_items" secret_collection_load_items :: 
    Ptr Collection ->                       -- self : TInterface (Name {namespace = "Secret", name = "Collection"})
    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 ()

-- | Ensure that the t'GI.Secret.Objects.Collection.Collection' proxy has loaded all the items present
-- in the Secret Service. This affects the result of
-- 'GI.Secret.Objects.Collection.collectionGetItems'.
-- 
-- For collections returned from 'GI.Secret.Objects.Service.serviceGetCollections' the items
-- will have already been loaded.
-- 
-- This method will return immediately and complete asynchronously.
collectionLoadItems ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: the secret collection
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: called when the operation completes
    -> m ()
collectionLoadItems :: a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
collectionLoadItems a
self Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Collection
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
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 (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 (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 (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 Collection
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
secret_collection_load_items Ptr Collection
self' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    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
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CollectionLoadItemsMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) => O.MethodInfo CollectionLoadItemsMethodInfo a signature where
    overloadedMethod = collectionLoadItems

#endif

-- method Collection::load_items_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Collection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret collection"
--                 , 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 (TBasicType TBoolean)
-- throws : True
-- Skip return : False

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

-- | Complete an asynchronous operation to ensure that the t'GI.Secret.Objects.Collection.Collection' proxy
-- has loaded all the items present in the Secret Service.
collectionLoadItemsFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: the secret collection
    -> b
    -- ^ /@result@/: the asynchronous result passed to the callback
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
collectionLoadItemsFinish :: a -> b -> m ()
collectionLoadItemsFinish a
self b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Collection
self' <- a -> IO (Ptr Collection)
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 () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Collection -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
secret_collection_load_items_finish Ptr Collection
self' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data CollectionLoadItemsFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsCollection a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo CollectionLoadItemsFinishMethodInfo a signature where
    overloadedMethod = collectionLoadItemsFinish

#endif

-- method Collection::load_items_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Collection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret collection"
--                 , 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "secret_collection_load_items_sync" secret_collection_load_items_sync :: 
    Ptr Collection ->                       -- self : TInterface (Name {namespace = "Secret", name = "Collection"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Ensure that the t'GI.Secret.Objects.Collection.Collection' proxy has loaded all the items present
-- in the Secret Service. This affects the result of
-- 'GI.Secret.Objects.Collection.collectionGetItems'.
-- 
-- For collections returned from 'GI.Secret.Objects.Service.serviceGetCollections' the items
-- will have already been loaded.
-- 
-- This method may block indefinitely and should not be used in user interface
-- threads.
collectionLoadItemsSync ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: the secret collection
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
collectionLoadItemsSync :: a -> Maybe b -> m ()
collectionLoadItemsSync a
self Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Collection
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
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 (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Collection -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
secret_collection_load_items_sync Ptr Collection
self' Ptr Cancellable
maybeCancellable
        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
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data CollectionLoadItemsSyncMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) => O.MethodInfo CollectionLoadItemsSyncMethodInfo a signature where
    overloadedMethod = collectionLoadItemsSync

#endif

-- method Collection::refresh
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Collection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collection" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "secret_collection_refresh" secret_collection_refresh :: 
    Ptr Collection ->                       -- self : TInterface (Name {namespace = "Secret", name = "Collection"})
    IO ()

-- | Refresh the properties on this collection. This fires off a request to
-- refresh, and the properties will be updated later.
-- 
-- Calling this method is not normally necessary, as the secret service
-- will notify the client when properties change.
collectionRefresh ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollection a) =>
    a
    -- ^ /@self@/: the collection
    -> m ()
collectionRefresh :: a -> m ()
collectionRefresh a
self = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Collection
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Collection -> IO ()
secret_collection_refresh Ptr Collection
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CollectionRefreshMethodInfo
instance (signature ~ (m ()), MonadIO m, IsCollection a) => O.MethodInfo CollectionRefreshMethodInfo a signature where
    overloadedMethod = collectionRefresh

#endif

-- method Collection::search
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Collection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a secret collection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "schema"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Schema" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the schema for the attributes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attributes"
--           , argType = TGHash (TBasicType TUTF8) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "search for items matching these attributes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "SearchFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "search option flags"
--                 , 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 = 6
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass 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_collection_search" secret_collection_search :: 
    Ptr Collection ->                       -- self : TInterface (Name {namespace = "Secret", name = "Collection"})
    Ptr Secret.Schema.Schema ->             -- schema : TInterface (Name {namespace = "Secret", name = "Schema"})
    Ptr (GHashTable CString CString) ->     -- attributes : TGHash (TBasicType TUTF8) (TBasicType TUTF8)
    CUInt ->                                -- flags : TInterface (Name {namespace = "Secret", name = "SearchFlags"})
    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 ()

-- | Search for items matching the /@attributes@/ in the /@collection@/.
-- The /@attributes@/ should be a table of string keys and string values.
-- 
-- If 'GI.Secret.Flags.SearchFlagsAll' is set in /@flags@/, then all the items matching the
-- search will be returned. Otherwise only the first item will be returned.
-- This is almost always the unlocked item that was most recently stored.
-- 
-- If 'GI.Secret.Flags.SearchFlagsUnlock' is set in /@flags@/, then items will be unlocked
-- if necessary. In either case, locked and unlocked items will match the
-- search and be returned. If the unlock fails, the search does not fail.
-- 
-- If 'GI.Secret.Flags.SearchFlagsLoadSecrets' is set in /@flags@/, then the items will have
-- their secret values loaded and available via 'GI.Secret.Objects.Item.itemGetSecret'.
-- 
-- This function returns immediately and completes asynchronously.
collectionSearch ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: a secret collection
    -> Maybe (Secret.Schema.Schema)
    -- ^ /@schema@/: the schema for the attributes
    -> Map.Map T.Text T.Text
    -- ^ /@attributes@/: search for items matching these attributes
    -> [Secret.Flags.SearchFlags]
    -- ^ /@flags@/: search option flags
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: called when the operation completes
    -> m ()
collectionSearch :: a
-> Maybe Schema
-> Map Text Text
-> [SearchFlags]
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
collectionSearch a
self Maybe Schema
schema Map Text Text
attributes [SearchFlags]
flags Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Collection
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Schema
maybeSchema <- case Maybe Schema
schema of
        Maybe Schema
Nothing -> Ptr Schema -> IO (Ptr Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
forall a. Ptr a
nullPtr
        Just Schema
jSchema -> do
            Ptr Schema
jSchema' <- Schema -> IO (Ptr Schema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Schema
jSchema
            Ptr Schema -> IO (Ptr Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
jSchema'
    let attributes' :: [(Text, Text)]
attributes' = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
attributes
    [(CString, Text)]
attributes'' <- (Text -> IO CString) -> [(Text, Text)] -> IO [(CString, Text)]
forall (f :: * -> *) a c b.
Applicative f =>
(a -> f c) -> [(a, b)] -> f [(c, b)]
mapFirstA Text -> IO CString
textToCString [(Text, Text)]
attributes'
    [(CString, CString)]
attributes''' <- (Text -> IO CString)
-> [(CString, Text)] -> IO [(CString, CString)]
forall (f :: * -> *) b c a.
Applicative f =>
(b -> f c) -> [(a, b)] -> f [(a, c)]
mapSecondA Text -> IO CString
textToCString [(CString, Text)]
attributes''
    let attributes'''' :: [(PtrWrapped CString, CString)]
attributes'''' = (CString -> PtrWrapped CString)
-> [(CString, CString)] -> [(PtrWrapped CString, CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst CString -> PtrWrapped CString
cstringPackPtr [(CString, CString)]
attributes'''
    let attributes''''' :: [(PtrWrapped CString, PtrWrapped CString)]
attributes''''' = (CString -> PtrWrapped CString)
-> [(PtrWrapped CString, CString)]
-> [(PtrWrapped CString, PtrWrapped CString)]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond CString -> PtrWrapped CString
cstringPackPtr [(PtrWrapped CString, CString)]
attributes''''
    Ptr (GHashTable CString CString)
attributes'''''' <- GHashFunc CString
-> GEqualFunc CString
-> Maybe (GDestroyNotify CString)
-> Maybe (GDestroyNotify CString)
-> [(PtrWrapped CString, PtrWrapped CString)]
-> IO (Ptr (GHashTable CString CString))
forall a b.
GHashFunc a
-> GEqualFunc a
-> Maybe (GDestroyNotify a)
-> Maybe (GDestroyNotify b)
-> [(PtrWrapped a, PtrWrapped b)]
-> IO (Ptr (GHashTable a b))
packGHashTable GHashFunc CString
gStrHash GEqualFunc CString
gStrEqual (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) [(PtrWrapped CString, PtrWrapped CString)]
attributes'''''
    let flags' :: CUInt
flags' = [SearchFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SearchFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
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 (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 (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 (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 Collection
-> Ptr Schema
-> Ptr (GHashTable CString CString)
-> CUInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
secret_collection_search Ptr Collection
self' Ptr Schema
maybeSchema Ptr (GHashTable CString CString)
attributes'''''' CUInt
flags' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Schema -> (Schema -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Schema
schema Schema -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr (GHashTable CString CString) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable CString CString)
attributes''''''
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CollectionSearchMethodInfo
instance (signature ~ (Maybe (Secret.Schema.Schema) -> Map.Map T.Text T.Text -> [Secret.Flags.SearchFlags] -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) => O.MethodInfo CollectionSearchMethodInfo a signature where
    overloadedMethod = collectionSearch

#endif

-- method Collection::search_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Collection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret collection"
--                 , 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 "asynchronous result passed to callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList (TInterface Name { namespace = "Secret" , name = "Item" }))
-- throws : True
-- Skip return : False

foreign import ccall "secret_collection_search_finish" secret_collection_search_finish :: 
    Ptr Collection ->                       -- self : TInterface (Name {namespace = "Secret", name = "Collection"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr (GList (Ptr Secret.Item.Item)))

-- | Complete asynchronous operation to search for items in a collection.
collectionSearchFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: the secret collection
    -> b
    -- ^ /@result@/: asynchronous result passed to callback
    -> m [Secret.Item.Item]
    -- ^ __Returns:__ 
    --          a list of items that matched the search /(Can throw 'Data.GI.Base.GError.GError')/
collectionSearchFinish :: a -> b -> m [Item]
collectionSearchFinish a
self b
result_ = IO [Item] -> m [Item]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Item] -> m [Item]) -> IO [Item] -> m [Item]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Collection
self' <- a -> IO (Ptr Collection)
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 [Item] -> IO () -> IO [Item]
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr (GList (Ptr Item))
result <- (Ptr (Ptr GError) -> IO (Ptr (GList (Ptr Item))))
-> IO (Ptr (GList (Ptr Item)))
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr (GList (Ptr Item))))
 -> IO (Ptr (GList (Ptr Item))))
-> (Ptr (Ptr GError) -> IO (Ptr (GList (Ptr Item))))
-> IO (Ptr (GList (Ptr Item)))
forall a b. (a -> b) -> a -> b
$ Ptr Collection
-> Ptr AsyncResult
-> Ptr (Ptr GError)
-> IO (Ptr (GList (Ptr Item)))
secret_collection_search_finish Ptr Collection
self' Ptr AsyncResult
result_'
        [Ptr Item]
result' <- Ptr (GList (Ptr Item)) -> IO [Ptr Item]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Item))
result
        [Item]
result'' <- (Ptr Item -> IO Item) -> [Ptr Item] -> IO [Item]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Item -> Item) -> Ptr Item -> IO Item
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Item -> Item
Secret.Item.Item) [Ptr Item]
result'
        Ptr (GList (Ptr Item)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Item))
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        [Item] -> IO [Item]
forall (m :: * -> *) a. Monad m => a -> m a
return [Item]
result''
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data CollectionSearchFinishMethodInfo
instance (signature ~ (b -> m [Secret.Item.Item]), MonadIO m, IsCollection a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo CollectionSearchFinishMethodInfo a signature where
    overloadedMethod = collectionSearchFinish

#endif

-- method Collection::search_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Collection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a secret collection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "schema"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Schema" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the schema for the attributes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attributes"
--           , argType = TGHash (TBasicType TUTF8) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "search for items matching these attributes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "SearchFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "search option flags"
--                 , 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
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList (TInterface Name { namespace = "Secret" , name = "Item" }))
-- throws : True
-- Skip return : False

foreign import ccall "secret_collection_search_sync" secret_collection_search_sync :: 
    Ptr Collection ->                       -- self : TInterface (Name {namespace = "Secret", name = "Collection"})
    Ptr Secret.Schema.Schema ->             -- schema : TInterface (Name {namespace = "Secret", name = "Schema"})
    Ptr (GHashTable CString CString) ->     -- attributes : TGHash (TBasicType TUTF8) (TBasicType TUTF8)
    CUInt ->                                -- flags : TInterface (Name {namespace = "Secret", name = "SearchFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr (GList (Ptr Secret.Item.Item)))

-- | Search for items matching the /@attributes@/ in the /@collection@/.
-- The /@attributes@/ should be a table of string keys and string values.
-- 
-- If 'GI.Secret.Flags.SearchFlagsAll' is set in /@flags@/, then all the items matching the
-- search will be returned. Otherwise only the first item will be returned.
-- This is almost always the unlocked item that was most recently stored.
-- 
-- If 'GI.Secret.Flags.SearchFlagsUnlock' is set in /@flags@/, then items will be unlocked
-- if necessary. In either case, locked and unlocked items will match the
-- search and be returned. If the unlock fails, the search does not fail.
-- 
-- If 'GI.Secret.Flags.SearchFlagsLoadSecrets' is set in /@flags@/, then the items will have
-- their secret values loaded and available via 'GI.Secret.Objects.Item.itemGetSecret'.
-- 
-- This function may block indefinitely. Use the asynchronous version
-- in user interface threads.
collectionSearchSync ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: a secret collection
    -> Maybe (Secret.Schema.Schema)
    -- ^ /@schema@/: the schema for the attributes
    -> Map.Map T.Text T.Text
    -- ^ /@attributes@/: search for items matching these attributes
    -> [Secret.Flags.SearchFlags]
    -- ^ /@flags@/: search option flags
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> m [Secret.Item.Item]
    -- ^ __Returns:__ 
    --          a list of items that matched the search /(Can throw 'Data.GI.Base.GError.GError')/
collectionSearchSync :: a
-> Maybe Schema
-> Map Text Text
-> [SearchFlags]
-> Maybe b
-> m [Item]
collectionSearchSync a
self Maybe Schema
schema Map Text Text
attributes [SearchFlags]
flags Maybe b
cancellable = IO [Item] -> m [Item]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Item] -> m [Item]) -> IO [Item] -> m [Item]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Collection
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Schema
maybeSchema <- case Maybe Schema
schema of
        Maybe Schema
Nothing -> Ptr Schema -> IO (Ptr Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
forall a. Ptr a
nullPtr
        Just Schema
jSchema -> do
            Ptr Schema
jSchema' <- Schema -> IO (Ptr Schema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Schema
jSchema
            Ptr Schema -> IO (Ptr Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
jSchema'
    let attributes' :: [(Text, Text)]
attributes' = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
attributes
    [(CString, Text)]
attributes'' <- (Text -> IO CString) -> [(Text, Text)] -> IO [(CString, Text)]
forall (f :: * -> *) a c b.
Applicative f =>
(a -> f c) -> [(a, b)] -> f [(c, b)]
mapFirstA Text -> IO CString
textToCString [(Text, Text)]
attributes'
    [(CString, CString)]
attributes''' <- (Text -> IO CString)
-> [(CString, Text)] -> IO [(CString, CString)]
forall (f :: * -> *) b c a.
Applicative f =>
(b -> f c) -> [(a, b)] -> f [(a, c)]
mapSecondA Text -> IO CString
textToCString [(CString, Text)]
attributes''
    let attributes'''' :: [(PtrWrapped CString, CString)]
attributes'''' = (CString -> PtrWrapped CString)
-> [(CString, CString)] -> [(PtrWrapped CString, CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst CString -> PtrWrapped CString
cstringPackPtr [(CString, CString)]
attributes'''
    let attributes''''' :: [(PtrWrapped CString, PtrWrapped CString)]
attributes''''' = (CString -> PtrWrapped CString)
-> [(PtrWrapped CString, CString)]
-> [(PtrWrapped CString, PtrWrapped CString)]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond CString -> PtrWrapped CString
cstringPackPtr [(PtrWrapped CString, CString)]
attributes''''
    Ptr (GHashTable CString CString)
attributes'''''' <- GHashFunc CString
-> GEqualFunc CString
-> Maybe (GDestroyNotify CString)
-> Maybe (GDestroyNotify CString)
-> [(PtrWrapped CString, PtrWrapped CString)]
-> IO (Ptr (GHashTable CString CString))
forall a b.
GHashFunc a
-> GEqualFunc a
-> Maybe (GDestroyNotify a)
-> Maybe (GDestroyNotify b)
-> [(PtrWrapped a, PtrWrapped b)]
-> IO (Ptr (GHashTable a b))
packGHashTable GHashFunc CString
gStrHash GEqualFunc CString
gStrEqual (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) [(PtrWrapped CString, PtrWrapped CString)]
attributes'''''
    let flags' :: CUInt
flags' = [SearchFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SearchFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
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 (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO [Item] -> IO () -> IO [Item]
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr (GList (Ptr Item))
result <- (Ptr (Ptr GError) -> IO (Ptr (GList (Ptr Item))))
-> IO (Ptr (GList (Ptr Item)))
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr (GList (Ptr Item))))
 -> IO (Ptr (GList (Ptr Item))))
-> (Ptr (Ptr GError) -> IO (Ptr (GList (Ptr Item))))
-> IO (Ptr (GList (Ptr Item)))
forall a b. (a -> b) -> a -> b
$ Ptr Collection
-> Ptr Schema
-> Ptr (GHashTable CString CString)
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr (GList (Ptr Item)))
secret_collection_search_sync Ptr Collection
self' Ptr Schema
maybeSchema Ptr (GHashTable CString CString)
attributes'''''' CUInt
flags' Ptr Cancellable
maybeCancellable
        [Ptr Item]
result' <- Ptr (GList (Ptr Item)) -> IO [Ptr Item]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Item))
result
        [Item]
result'' <- (Ptr Item -> IO Item) -> [Ptr Item] -> IO [Item]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Item -> Item) -> Ptr Item -> IO Item
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Item -> Item
Secret.Item.Item) [Ptr Item]
result'
        Ptr (GList (Ptr Item)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Item))
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe Schema -> (Schema -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Schema
schema Schema -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr (GHashTable CString CString) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable CString CString)
attributes''''''
        [Item] -> IO [Item]
forall (m :: * -> *) a. Monad m => a -> m a
return [Item]
result''
     ) (do
        Ptr (GHashTable CString CString) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable CString CString)
attributes''''''
     )

#if defined(ENABLE_OVERLOADING)
data CollectionSearchSyncMethodInfo
instance (signature ~ (Maybe (Secret.Schema.Schema) -> Map.Map T.Text T.Text -> [Secret.Flags.SearchFlags] -> Maybe (b) -> m [Secret.Item.Item]), MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) => O.MethodInfo CollectionSearchSyncMethodInfo a signature where
    overloadedMethod = collectionSearchSync

#endif

-- method Collection::set_label
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Collection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a collection" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a new label" , 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 = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass 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_collection_set_label" secret_collection_set_label :: 
    Ptr Collection ->                       -- self : TInterface (Name {namespace = "Secret", name = "Collection"})
    CString ->                              -- label : TBasicType TUTF8
    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 ()

-- | Set the label of this collection.
-- 
-- This function returns immediately and completes asynchronously.
collectionSetLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: a collection
    -> T.Text
    -- ^ /@label@/: a new label
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: called when the operation completes
    -> m ()
collectionSetLabel :: a -> Text -> Maybe b -> Maybe AsyncReadyCallback -> m ()
collectionSetLabel a
self Text
label Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Collection
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
label' <- Text -> IO CString
textToCString Text
label
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
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 (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 (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 (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 Collection
-> CString
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
secret_collection_set_label Ptr Collection
self' CString
label' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    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
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
label'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CollectionSetLabelMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) => O.MethodInfo CollectionSetLabelMethodInfo a signature where
    overloadedMethod = collectionSetLabel

#endif

-- method Collection::set_label_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Collection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a collection" , 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 "asynchronous result passed to callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

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

-- | Complete asynchronous operation to set the label of this collection.
collectionSetLabelFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a collection
    -> b
    -- ^ /@result@/: asynchronous result passed to callback
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
collectionSetLabelFinish :: a -> b -> m ()
collectionSetLabelFinish a
self b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Collection
self' <- a -> IO (Ptr Collection)
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 () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Collection -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
secret_collection_set_label_finish Ptr Collection
self' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data CollectionSetLabelFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsCollection a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo CollectionSetLabelFinishMethodInfo a signature where
    overloadedMethod = collectionSetLabelFinish

#endif

-- method Collection::set_label_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Collection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a collection" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a new label" , 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "secret_collection_set_label_sync" secret_collection_set_label_sync :: 
    Ptr Collection ->                       -- self : TInterface (Name {namespace = "Secret", name = "Collection"})
    CString ->                              -- label : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Set the label of this collection.
-- 
-- This function may block indefinitely. Use the asynchronous version
-- in user interface threads.
collectionSetLabelSync ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: a collection
    -> T.Text
    -- ^ /@label@/: a new label
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
collectionSetLabelSync :: a -> Text -> Maybe b -> m ()
collectionSetLabelSync a
self Text
label Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Collection
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
label' <- Text -> IO CString
textToCString Text
label
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
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 (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Collection
-> CString -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
secret_collection_set_label_sync Ptr Collection
self' CString
label' Ptr Cancellable
maybeCancellable
        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
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
label'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
label'
     )

#if defined(ENABLE_OVERLOADING)
data CollectionSetLabelSyncMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> m ()), MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) => O.MethodInfo CollectionSetLabelSyncMethodInfo a signature where
    overloadedMethod = collectionSetLabelSync

#endif

-- method Collection::create
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a secret service object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "label for the new collection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alias"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "alias to assign to the collection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Secret" , name = "CollectionCreateFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "currently unused" , 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 = 6
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass 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_collection_create" secret_collection_create :: 
    Ptr Secret.Service.Service ->           -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    CString ->                              -- label : TBasicType TUTF8
    CString ->                              -- alias : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "Secret", name = "CollectionCreateFlags"})
    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 ()

-- | Create a new collection in the secret service.
-- 
-- This method returns immediately and completes asynchronously. The secret
-- service may prompt the user. 'GI.Secret.Objects.Service.servicePrompt' will be used to handle
-- any prompts that are required.
-- 
-- An /@alias@/ is a well-known tag for a collection, such as \'default\' (ie: the
-- default collection to store items in). This allows other applications to
-- easily identify and share a collection. If you specify an /@alias@/, and a
-- collection with that alias already exists, then a new collection will not
-- be created. The previous one will be returned instead.
-- 
-- If /@service@/ is NULL, then 'GI.Secret.Objects.Service.serviceGet' will be called to get
-- the default t'GI.Secret.Objects.Service.Service' proxy.
collectionCreate ::
    (B.CallStack.HasCallStack, MonadIO m, Secret.Service.IsService a, Gio.Cancellable.IsCancellable b) =>
    Maybe (a)
    -- ^ /@service@/: a secret service object
    -> T.Text
    -- ^ /@label@/: label for the new collection
    -> Maybe (T.Text)
    -- ^ /@alias@/: alias to assign to the collection
    -> [Secret.Flags.CollectionCreateFlags]
    -- ^ /@flags@/: currently unused
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: called when the operation completes
    -> m ()
collectionCreate :: Maybe a
-> Text
-> Maybe Text
-> [CollectionCreateFlags]
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
collectionCreate Maybe a
service Text
label Maybe Text
alias [CollectionCreateFlags]
flags Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Service
maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
nullPtr
        Just a
jService -> do
            Ptr Service
jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            Ptr Service -> IO (Ptr Service)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
jService'
    CString
label' <- Text -> IO CString
textToCString Text
label
    CString
maybeAlias <- case Maybe Text
alias of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jAlias -> do
            CString
jAlias' <- Text -> IO CString
textToCString Text
jAlias
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jAlias'
    let flags' :: CUInt
flags' = [CollectionCreateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [CollectionCreateFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
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 (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 (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 (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 Service
-> CString
-> CString
-> CUInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
secret_collection_create Ptr Service
maybeService CString
label' CString
maybeAlias CUInt
flags' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
service a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
label'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeAlias
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method Collection::create_finish
-- method type : MemberFunction
-- Args: [ 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
--               (TInterface Name { namespace = "Secret" , name = "Collection" })
-- throws : True
-- Skip return : False

foreign import ccall "secret_collection_create_finish" secret_collection_create_finish :: 
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Collection)

-- | Finish operation to create a new collection in the secret service.
collectionCreateFinish ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.AsyncResult.IsAsyncResult a) =>
    a
    -- ^ /@result@/: the asynchronous result passed to the callback
    -> m Collection
    -- ^ __Returns:__ the new collection, which should be unreferenced
    --          with 'GI.GObject.Objects.Object.objectUnref' /(Can throw 'Data.GI.Base.GError.GError')/
collectionCreateFinish :: a -> m Collection
collectionCreateFinish a
result_ = IO Collection -> m Collection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Collection -> m Collection) -> IO Collection -> m Collection
forall a b. (a -> b) -> a -> b
$ do
    Ptr AsyncResult
result_' <- a -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
result_
    IO Collection -> IO () -> IO Collection
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Collection
result <- (Ptr (Ptr GError) -> IO (Ptr Collection)) -> IO (Ptr Collection)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Collection)) -> IO (Ptr Collection))
-> (Ptr (Ptr GError) -> IO (Ptr Collection)) -> IO (Ptr Collection)
forall a b. (a -> b) -> a -> b
$ Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr Collection)
secret_collection_create_finish Ptr AsyncResult
result_'
        Text -> Ptr Collection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"collectionCreateFinish" Ptr Collection
result
        Collection
result' <- ((ManagedPtr Collection -> Collection)
-> Ptr Collection -> IO Collection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Collection -> Collection
Collection) Ptr Collection
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
result_
        Collection -> IO Collection
forall (m :: * -> *) a. Monad m => a -> m a
return Collection
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Collection::create_sync
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a secret service object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "label for the new collection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alias"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "alias to assign to the collection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Secret" , name = "CollectionCreateFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "currently unused" , 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
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Secret" , name = "Collection" })
-- throws : True
-- Skip return : False

foreign import ccall "secret_collection_create_sync" secret_collection_create_sync :: 
    Ptr Secret.Service.Service ->           -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    CString ->                              -- label : TBasicType TUTF8
    CString ->                              -- alias : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "Secret", name = "CollectionCreateFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Collection)

-- | Create a new collection in the secret service.
-- 
-- This method may block indefinitely and should not be used in user interface
-- threads. The secret service may prompt the user. 'GI.Secret.Objects.Service.servicePrompt'
-- will be used to handle any prompts that are required.
-- 
-- An /@alias@/ is a well-known tag for a collection, such as \'default\' (ie: the
-- default collection to store items in). This allows other applications to
-- easily identify and share a collection. If you specify an /@alias@/, and a
-- collection with that alias already exists, then a new collection will not
-- be created. The previous one will be returned instead.
-- 
-- If /@service@/ is NULL, then 'GI.Secret.Objects.Service.serviceGetSync' will be called to get
-- the default t'GI.Secret.Objects.Service.Service' proxy.
collectionCreateSync ::
    (B.CallStack.HasCallStack, MonadIO m, Secret.Service.IsService a, Gio.Cancellable.IsCancellable b) =>
    Maybe (a)
    -- ^ /@service@/: a secret service object
    -> T.Text
    -- ^ /@label@/: label for the new collection
    -> Maybe (T.Text)
    -- ^ /@alias@/: alias to assign to the collection
    -> [Secret.Flags.CollectionCreateFlags]
    -- ^ /@flags@/: currently unused
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> m Collection
    -- ^ __Returns:__ the new collection, which should be unreferenced
    --          with 'GI.GObject.Objects.Object.objectUnref' /(Can throw 'Data.GI.Base.GError.GError')/
collectionCreateSync :: Maybe a
-> Text
-> Maybe Text
-> [CollectionCreateFlags]
-> Maybe b
-> m Collection
collectionCreateSync Maybe a
service Text
label Maybe Text
alias [CollectionCreateFlags]
flags Maybe b
cancellable = IO Collection -> m Collection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Collection -> m Collection) -> IO Collection -> m Collection
forall a b. (a -> b) -> a -> b
$ do
    Ptr Service
maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
nullPtr
        Just a
jService -> do
            Ptr Service
jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            Ptr Service -> IO (Ptr Service)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
jService'
    CString
label' <- Text -> IO CString
textToCString Text
label
    CString
maybeAlias <- case Maybe Text
alias of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jAlias -> do
            CString
jAlias' <- Text -> IO CString
textToCString Text
jAlias
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jAlias'
    let flags' :: CUInt
flags' = [CollectionCreateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [CollectionCreateFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
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 (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Collection -> IO () -> IO Collection
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Collection
result <- (Ptr (Ptr GError) -> IO (Ptr Collection)) -> IO (Ptr Collection)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Collection)) -> IO (Ptr Collection))
-> (Ptr (Ptr GError) -> IO (Ptr Collection)) -> IO (Ptr Collection)
forall a b. (a -> b) -> a -> b
$ Ptr Service
-> CString
-> CString
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr Collection)
secret_collection_create_sync Ptr Service
maybeService CString
label' CString
maybeAlias CUInt
flags' Ptr Cancellable
maybeCancellable
        Text -> Ptr Collection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"collectionCreateSync" Ptr Collection
result
        Collection
result' <- ((ManagedPtr Collection -> Collection)
-> Ptr Collection -> IO Collection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Collection -> Collection
Collection) Ptr Collection
result
        Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
service a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
label'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeAlias
        Collection -> IO Collection
forall (m :: * -> *) a. Monad m => a -> m a
return Collection
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
label'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeAlias
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Collection::for_alias
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a secret service object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alias"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the alias to lookup"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "CollectionFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "options for the collection initialization"
--                 , 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 pass 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_collection_for_alias" secret_collection_for_alias :: 
    Ptr Secret.Service.Service ->           -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    CString ->                              -- alias : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "Secret", name = "CollectionFlags"})
    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 ()

-- | Lookup which collection is assigned to this alias. Aliases help determine
-- well known collections, such as \'default\'.
-- 
-- If /@service@/ is NULL, then 'GI.Secret.Objects.Service.serviceGet' will be called to get
-- the default t'GI.Secret.Objects.Service.Service' proxy.
-- 
-- This method will return immediately and complete asynchronously.
collectionForAlias ::
    (B.CallStack.HasCallStack, MonadIO m, Secret.Service.IsService a, Gio.Cancellable.IsCancellable b) =>
    Maybe (a)
    -- ^ /@service@/: a secret service object
    -> T.Text
    -- ^ /@alias@/: the alias to lookup
    -> [Secret.Flags.CollectionFlags]
    -- ^ /@flags@/: options for the collection initialization
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: called when the operation completes
    -> m ()
collectionForAlias :: Maybe a
-> Text
-> [CollectionFlags]
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
collectionForAlias Maybe a
service Text
alias [CollectionFlags]
flags Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Service
maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
nullPtr
        Just a
jService -> do
            Ptr Service
jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            Ptr Service -> IO (Ptr Service)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
jService'
    CString
alias' <- Text -> IO CString
textToCString Text
alias
    let flags' :: CUInt
flags' = [CollectionFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [CollectionFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
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 (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 (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 (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 Service
-> CString
-> CUInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
secret_collection_for_alias Ptr Service
maybeService CString
alias' CUInt
flags' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
service a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
alias'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method Collection::for_alias_finish
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "asynchronous result passed to callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Secret" , name = "Collection" })
-- throws : True
-- Skip return : False

foreign import ccall "secret_collection_for_alias_finish" secret_collection_for_alias_finish :: 
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Collection)

-- | Finish an asynchronous operation to lookup which collection is assigned
-- to an alias.
collectionForAliasFinish ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.AsyncResult.IsAsyncResult a) =>
    a
    -- ^ /@result@/: asynchronous result passed to callback
    -> m Collection
    -- ^ __Returns:__ the collection, or 'P.Nothing' if none assigned to the alias /(Can throw 'Data.GI.Base.GError.GError')/
collectionForAliasFinish :: a -> m Collection
collectionForAliasFinish a
result_ = IO Collection -> m Collection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Collection -> m Collection) -> IO Collection -> m Collection
forall a b. (a -> b) -> a -> b
$ do
    Ptr AsyncResult
result_' <- a -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
result_
    IO Collection -> IO () -> IO Collection
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Collection
result <- (Ptr (Ptr GError) -> IO (Ptr Collection)) -> IO (Ptr Collection)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Collection)) -> IO (Ptr Collection))
-> (Ptr (Ptr GError) -> IO (Ptr Collection)) -> IO (Ptr Collection)
forall a b. (a -> b) -> a -> b
$ Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr Collection)
secret_collection_for_alias_finish Ptr AsyncResult
result_'
        Text -> Ptr Collection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"collectionForAliasFinish" Ptr Collection
result
        Collection
result' <- ((ManagedPtr Collection -> Collection)
-> Ptr Collection -> IO Collection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Collection -> Collection
Collection) Ptr Collection
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
result_
        Collection -> IO Collection
forall (m :: * -> *) a. Monad m => a -> m a
return Collection
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Collection::for_alias_sync
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "service"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Service" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a secret service object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alias"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the alias to lookup"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "CollectionFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "options for the collection initialization"
--                 , 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
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Secret" , name = "Collection" })
-- throws : True
-- Skip return : False

foreign import ccall "secret_collection_for_alias_sync" secret_collection_for_alias_sync :: 
    Ptr Secret.Service.Service ->           -- service : TInterface (Name {namespace = "Secret", name = "Service"})
    CString ->                              -- alias : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "Secret", name = "CollectionFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Collection)

-- | Lookup which collection is assigned to this alias. Aliases help determine
-- well known collections, such as \'default\'.
-- 
-- If /@service@/ is NULL, then 'GI.Secret.Objects.Service.serviceGetSync' will be called to get
-- the default t'GI.Secret.Objects.Service.Service' proxy.
-- 
-- This method may block and should not be used in user interface threads.
collectionForAliasSync ::
    (B.CallStack.HasCallStack, MonadIO m, Secret.Service.IsService a, Gio.Cancellable.IsCancellable b) =>
    Maybe (a)
    -- ^ /@service@/: a secret service object
    -> T.Text
    -- ^ /@alias@/: the alias to lookup
    -> [Secret.Flags.CollectionFlags]
    -- ^ /@flags@/: options for the collection initialization
    -> Maybe (b)
    -- ^ /@cancellable@/: optional cancellation object
    -> m Collection
    -- ^ __Returns:__ the collection, or 'P.Nothing' if none assigned to the alias /(Can throw 'Data.GI.Base.GError.GError')/
collectionForAliasSync :: Maybe a -> Text -> [CollectionFlags] -> Maybe b -> m Collection
collectionForAliasSync Maybe a
service Text
alias [CollectionFlags]
flags Maybe b
cancellable = IO Collection -> m Collection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Collection -> m Collection) -> IO Collection -> m Collection
forall a b. (a -> b) -> a -> b
$ do
    Ptr Service
maybeService <- case Maybe a
service of
        Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
nullPtr
        Just a
jService -> do
            Ptr Service
jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
            Ptr Service -> IO (Ptr Service)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
jService'
    CString
alias' <- Text -> IO CString
textToCString Text
alias
    let flags' :: CUInt
flags' = [CollectionFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [CollectionFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
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 (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Collection -> IO () -> IO Collection
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Collection
result <- (Ptr (Ptr GError) -> IO (Ptr Collection)) -> IO (Ptr Collection)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Collection)) -> IO (Ptr Collection))
-> (Ptr (Ptr GError) -> IO (Ptr Collection)) -> IO (Ptr Collection)
forall a b. (a -> b) -> a -> b
$ Ptr Service
-> CString
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr Collection)
secret_collection_for_alias_sync Ptr Service
maybeService CString
alias' CUInt
flags' Ptr Cancellable
maybeCancellable
        Text -> Ptr Collection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"collectionForAliasSync" Ptr Collection
result
        Collection
result' <- ((ManagedPtr Collection -> Collection)
-> Ptr Collection -> IO Collection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Collection -> Collection
Collection) Ptr Collection
result
        Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
service a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
alias'
        Collection -> IO Collection
forall (m :: * -> *) a. Monad m => a -> m a
return Collection
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
alias'
     )

#if defined(ENABLE_OVERLOADING)
#endif