{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Secret.Objects.Collection
(
Collection(..) ,
IsCollection ,
toCollection ,
#if defined(ENABLE_OVERLOADING)
ResolveCollectionMethod ,
#endif
collectionCreate ,
collectionCreateFinish ,
collectionCreateSync ,
#if defined(ENABLE_OVERLOADING)
CollectionDeleteMethodInfo ,
#endif
collectionDelete ,
#if defined(ENABLE_OVERLOADING)
CollectionDeleteFinishMethodInfo ,
#endif
collectionDeleteFinish ,
#if defined(ENABLE_OVERLOADING)
CollectionDeleteSyncMethodInfo ,
#endif
collectionDeleteSync ,
collectionForAlias ,
collectionForAliasFinish ,
collectionForAliasSync ,
#if defined(ENABLE_OVERLOADING)
CollectionGetCreatedMethodInfo ,
#endif
collectionGetCreated ,
#if defined(ENABLE_OVERLOADING)
CollectionGetFlagsMethodInfo ,
#endif
collectionGetFlags ,
#if defined(ENABLE_OVERLOADING)
CollectionGetItemsMethodInfo ,
#endif
collectionGetItems ,
#if defined(ENABLE_OVERLOADING)
CollectionGetLabelMethodInfo ,
#endif
collectionGetLabel ,
#if defined(ENABLE_OVERLOADING)
CollectionGetLockedMethodInfo ,
#endif
collectionGetLocked ,
#if defined(ENABLE_OVERLOADING)
CollectionGetModifiedMethodInfo ,
#endif
collectionGetModified ,
#if defined(ENABLE_OVERLOADING)
CollectionGetServiceMethodInfo ,
#endif
collectionGetService ,
#if defined(ENABLE_OVERLOADING)
CollectionLoadItemsMethodInfo ,
#endif
collectionLoadItems ,
#if defined(ENABLE_OVERLOADING)
CollectionLoadItemsFinishMethodInfo ,
#endif
collectionLoadItemsFinish ,
#if defined(ENABLE_OVERLOADING)
CollectionLoadItemsSyncMethodInfo ,
#endif
collectionLoadItemsSync ,
#if defined(ENABLE_OVERLOADING)
CollectionRefreshMethodInfo ,
#endif
collectionRefresh ,
#if defined(ENABLE_OVERLOADING)
CollectionSearchMethodInfo ,
#endif
collectionSearch ,
#if defined(ENABLE_OVERLOADING)
CollectionSearchFinishMethodInfo ,
#endif
collectionSearchFinish ,
#if defined(ENABLE_OVERLOADING)
CollectionSearchSyncMethodInfo ,
#endif
collectionSearchSync ,
#if defined(ENABLE_OVERLOADING)
CollectionSetLabelMethodInfo ,
#endif
collectionSetLabel ,
#if defined(ENABLE_OVERLOADING)
CollectionSetLabelFinishMethodInfo ,
#endif
collectionSetLabelFinish ,
#if defined(ENABLE_OVERLOADING)
CollectionSetLabelSyncMethodInfo ,
#endif
collectionSetLabelSync ,
#if defined(ENABLE_OVERLOADING)
CollectionCreatedPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
collectionCreated ,
#endif
constructCollectionCreated ,
getCollectionCreated ,
setCollectionCreated ,
#if defined(ENABLE_OVERLOADING)
CollectionFlagsPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
collectionFlags ,
#endif
constructCollectionFlags ,
getCollectionFlags ,
#if defined(ENABLE_OVERLOADING)
CollectionLabelPropertyInfo ,
#endif
clearCollectionLabel ,
#if defined(ENABLE_OVERLOADING)
collectionLabel ,
#endif
constructCollectionLabel ,
getCollectionLabel ,
setCollectionLabel ,
#if defined(ENABLE_OVERLOADING)
CollectionLockedPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
collectionLocked ,
#endif
getCollectionLocked ,
#if defined(ENABLE_OVERLOADING)
CollectionModifiedPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
collectionModified ,
#endif
constructCollectionModified ,
getCollectionModified ,
setCollectionModified ,
#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.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Structs.VariantType as GLib.VariantType
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncInitable as Gio.AsyncInitable
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.DBusInterface as Gio.DBusInterface
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.DBusProxy as Gio.DBusProxy
import {-# SOURCE #-} qualified GI.Secret.Enums as Secret.Enums
import {-# SOURCE #-} qualified GI.Secret.Flags as Secret.Flags
import {-# SOURCE #-} qualified GI.Secret.Interfaces.Backend as Secret.Backend
import {-# SOURCE #-} qualified GI.Secret.Interfaces.Retrievable as Secret.Retrievable
import {-# SOURCE #-} qualified GI.Secret.Objects.Item as Secret.Item
import {-# SOURCE #-} qualified GI.Secret.Objects.Prompt as Secret.Prompt
import {-# SOURCE #-} qualified GI.Secret.Objects.Service as Secret.Service
import {-# SOURCE #-} qualified GI.Secret.Structs.Schema as Secret.Schema
import {-# SOURCE #-} qualified GI.Secret.Structs.Value as Secret.Value
#else
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
#endif
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
$c== :: Collection -> Collection -> Bool
== :: Collection -> Collection -> Bool
$c/= :: Collection -> Collection -> Bool
/= :: 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
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]
toCollection :: (MIO.MonadIO m, IsCollection o) => o -> m Collection
toCollection :: forall (m :: * -> *) o.
(MonadIO m, IsCollection o) =>
o -> m Collection
toCollection = IO Collection -> m Collection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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'
B.ManagedPtr.unsafeCastTo ManagedPtr Collection -> Collection
Collection
instance B.GValue.IsGValue (Maybe Collection) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_secret_collection_get_type
gvalueSet_ :: Ptr GValue -> Maybe Collection -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Collection
P.Nothing = Ptr GValue -> Ptr Collection -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Collection
forall a. Ptr a
FP.nullPtr :: FP.Ptr Collection)
gvalueSet_ Ptr GValue
gv (P.Just Collection
obj) = Collection -> (Ptr Collection -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Collection
obj (Ptr GValue -> Ptr Collection -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe Collection)
gvalueGet_ Ptr GValue
gv = do
ptr <- Ptr GValue -> IO (Ptr Collection)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Collection)
if ptr /= FP.nullPtr
then P.Just <$> B.ManagedPtr.newObject Collection ptr
else return P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveCollectionMethod (t :: Symbol) (o :: DK.Type) :: DK.Type 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.OverloadedMethod info Collection p) => OL.IsLabel t (Collection -> p) where
#if MIN_VERSION_base(4,10,0)
fromLabel :: Collection -> p
fromLabel = forall {k} (i :: k) o s. OverloadedMethod i o s => o -> s
forall i o s. OverloadedMethod i o s => o -> s
O.overloadedMethod @info
#else
fromLabel _ = O.overloadedMethod @info
#endif
#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveCollectionMethod t Collection, O.OverloadedMethod info Collection p, R.HasField t Collection p) => R.HasField t Collection p where
getField :: Collection -> p
getField = forall {k} (i :: k) o s. OverloadedMethod i o s => o -> s
forall i o s. OverloadedMethod i o s => o -> s
O.overloadedMethod @info
#endif
instance (info ~ ResolveCollectionMethod t Collection, O.OverloadedMethodInfo info Collection) => OL.IsLabel t (O.MethodProxy info Collection) where
#if MIN_VERSION_base(4,10,0)
fromLabel :: MethodProxy info Collection
fromLabel = MethodProxy info Collection
forall info obj. MethodProxy info obj
O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
getCollectionCreated :: (MonadIO m, IsCollection o) => o -> m Word64
getCollectionCreated :: forall (m :: * -> *) o.
(MonadIO m, IsCollection o) =>
o -> m Word64
getCollectionCreated o
obj = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word64
forall a. GObject a => a -> String -> IO Word64
B.Properties.getObjectPropertyUInt64 o
obj String
"created"
setCollectionCreated :: (MonadIO m, IsCollection o) => o -> Word64 -> m ()
setCollectionCreated :: forall (m :: * -> *) o.
(MonadIO m, IsCollection o) =>
o -> Word64 -> m ()
setCollectionCreated o
obj Word64
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Word64 -> IO ()
forall a. GObject a => a -> String -> Word64 -> IO ()
B.Properties.setObjectPropertyUInt64 o
obj String
"created" Word64
val
constructCollectionCreated :: (IsCollection o, MIO.MonadIO m) => Word64 -> m (GValueConstruct o)
constructCollectionCreated :: forall o (m :: * -> *).
(IsCollection o, MonadIO m) =>
Word64 -> m (GValueConstruct o)
constructCollectionCreated Word64
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (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 :: forall o.
AttrBaseTypeConstraint CollectionCreatedPropertyInfo o =>
o -> IO (AttrGetType CollectionCreatedPropertyInfo)
attrGet = o -> IO Word64
o -> IO (AttrGetType CollectionCreatedPropertyInfo)
forall (m :: * -> *) o.
(MonadIO m, IsCollection o) =>
o -> m Word64
getCollectionCreated
attrSet :: forall o b.
(AttrBaseTypeConstraint CollectionCreatedPropertyInfo o,
AttrSetTypeConstraint CollectionCreatedPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
o -> Word64 -> IO ()
forall (m :: * -> *) o.
(MonadIO m, IsCollection o) =>
o -> Word64 -> m ()
setCollectionCreated
attrTransfer :: forall o b.
(AttrBaseTypeConstraint CollectionCreatedPropertyInfo o,
AttrTransferTypeConstraint CollectionCreatedPropertyInfo b) =>
Proxy o -> b -> IO (AttrTransferType CollectionCreatedPropertyInfo)
attrTransfer Proxy o
_ b
v = do
b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
v
attrConstruct :: forall o b.
(AttrBaseTypeConstraint CollectionCreatedPropertyInfo o,
AttrSetTypeConstraint CollectionCreatedPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
Word64 -> IO (GValueConstruct o)
forall o (m :: * -> *).
(IsCollection o, MonadIO m) =>
Word64 -> m (GValueConstruct o)
constructCollectionCreated
attrClear :: forall o.
AttrBaseTypeConstraint CollectionCreatedPropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.created"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#g:attr:created"
})
#endif
getCollectionFlags :: (MonadIO m, IsCollection o) => o -> m [Secret.Flags.CollectionFlags]
getCollectionFlags :: forall (m :: * -> *) o.
(MonadIO m, IsCollection o) =>
o -> m [CollectionFlags]
getCollectionFlags o
obj = IO [CollectionFlags] -> m [CollectionFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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"
constructCollectionFlags :: (IsCollection o, MIO.MonadIO m) => [Secret.Flags.CollectionFlags] -> m (GValueConstruct o)
constructCollectionFlags :: forall o (m :: * -> *).
(IsCollection o, MonadIO m) =>
[CollectionFlags] -> m (GValueConstruct o)
constructCollectionFlags [CollectionFlags]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (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 :: forall o.
AttrBaseTypeConstraint CollectionFlagsPropertyInfo o =>
o -> IO (AttrGetType CollectionFlagsPropertyInfo)
attrGet = o -> IO [CollectionFlags]
o -> IO (AttrGetType CollectionFlagsPropertyInfo)
forall (m :: * -> *) o.
(MonadIO m, IsCollection o) =>
o -> m [CollectionFlags]
getCollectionFlags
attrSet :: forall o b.
(AttrBaseTypeConstraint CollectionFlagsPropertyInfo o,
AttrSetTypeConstraint CollectionFlagsPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
attrTransfer :: forall o b.
(AttrBaseTypeConstraint CollectionFlagsPropertyInfo o,
AttrTransferTypeConstraint CollectionFlagsPropertyInfo b) =>
Proxy o -> b -> IO (AttrTransferType CollectionFlagsPropertyInfo)
attrTransfer Proxy o
_ b
v = do
b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
v
attrConstruct :: forall o b.
(AttrBaseTypeConstraint CollectionFlagsPropertyInfo o,
AttrSetTypeConstraint CollectionFlagsPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
[CollectionFlags] -> IO (GValueConstruct o)
forall o (m :: * -> *).
(IsCollection o, MonadIO m) =>
[CollectionFlags] -> m (GValueConstruct o)
constructCollectionFlags
attrClear :: forall o.
AttrBaseTypeConstraint CollectionFlagsPropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.flags"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#g:attr:flags"
})
#endif
getCollectionLabel :: (MonadIO m, IsCollection o) => o -> m (Maybe T.Text)
getCollectionLabel :: forall (m :: * -> *) o.
(MonadIO m, IsCollection o) =>
o -> m (Maybe Text)
getCollectionLabel o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"label"
setCollectionLabel :: (MonadIO m, IsCollection o) => o -> T.Text -> m ()
setCollectionLabel :: forall (m :: * -> *) o.
(MonadIO m, IsCollection o) =>
o -> Text -> m ()
setCollectionLabel o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
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)
constructCollectionLabel :: (IsCollection o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructCollectionLabel :: forall o (m :: * -> *).
(IsCollection o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructCollectionLabel Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (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)
clearCollectionLabel :: (MonadIO m, IsCollection o) => o -> m ()
clearCollectionLabel :: forall (m :: * -> *) o. (MonadIO m, IsCollection o) => o -> m ()
clearCollectionLabel o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ 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 :: forall o.
AttrBaseTypeConstraint CollectionLabelPropertyInfo o =>
o -> IO (AttrGetType CollectionLabelPropertyInfo)
attrGet = o -> IO (Maybe Text)
o -> IO (AttrGetType CollectionLabelPropertyInfo)
forall (m :: * -> *) o.
(MonadIO m, IsCollection o) =>
o -> m (Maybe Text)
getCollectionLabel
attrSet :: forall o b.
(AttrBaseTypeConstraint CollectionLabelPropertyInfo o,
AttrSetTypeConstraint CollectionLabelPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
o -> Text -> IO ()
forall (m :: * -> *) o.
(MonadIO m, IsCollection o) =>
o -> Text -> m ()
setCollectionLabel
attrTransfer :: forall o b.
(AttrBaseTypeConstraint CollectionLabelPropertyInfo o,
AttrTransferTypeConstraint CollectionLabelPropertyInfo b) =>
Proxy o -> b -> IO (AttrTransferType CollectionLabelPropertyInfo)
attrTransfer Proxy o
_ b
v = do
b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
v
attrConstruct :: forall o b.
(AttrBaseTypeConstraint CollectionLabelPropertyInfo o,
AttrSetTypeConstraint CollectionLabelPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
Text -> IO (GValueConstruct o)
forall o (m :: * -> *).
(IsCollection o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructCollectionLabel
attrClear :: forall o.
AttrBaseTypeConstraint CollectionLabelPropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall (m :: * -> *) o. (MonadIO m, IsCollection o) => o -> m ()
clearCollectionLabel
dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.label"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#g:attr:label"
})
#endif
getCollectionLocked :: (MonadIO m, IsCollection o) => o -> m Bool
getCollectionLocked :: forall (m :: * -> *) o. (MonadIO m, IsCollection o) => o -> m Bool
getCollectionLocked o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"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 :: forall o.
AttrBaseTypeConstraint CollectionLockedPropertyInfo o =>
o -> IO (AttrGetType CollectionLockedPropertyInfo)
attrGet = o -> IO Bool
o -> IO (AttrGetType CollectionLockedPropertyInfo)
forall (m :: * -> *) o. (MonadIO m, IsCollection o) => o -> m Bool
getCollectionLocked
attrSet :: forall o b.
(AttrBaseTypeConstraint CollectionLockedPropertyInfo o,
AttrSetTypeConstraint CollectionLockedPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
attrTransfer :: forall o b.
(AttrBaseTypeConstraint CollectionLockedPropertyInfo o,
AttrTransferTypeConstraint CollectionLockedPropertyInfo b) =>
Proxy o -> b -> IO (AttrTransferType CollectionLockedPropertyInfo)
attrTransfer Proxy o
_ = b -> IO (AttrTransferType CollectionLockedPropertyInfo)
() -> IO ()
forall a. HasCallStack => a
undefined
attrConstruct :: forall o b.
(AttrBaseTypeConstraint CollectionLockedPropertyInfo o,
AttrSetTypeConstraint CollectionLockedPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
forall a. HasCallStack => a
undefined
attrClear :: forall o.
AttrBaseTypeConstraint CollectionLockedPropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.locked"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#g:attr:locked"
})
#endif
getCollectionModified :: (MonadIO m, IsCollection o) => o -> m Word64
getCollectionModified :: forall (m :: * -> *) o.
(MonadIO m, IsCollection o) =>
o -> m Word64
getCollectionModified o
obj = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word64
forall a. GObject a => a -> String -> IO Word64
B.Properties.getObjectPropertyUInt64 o
obj String
"modified"
setCollectionModified :: (MonadIO m, IsCollection o) => o -> Word64 -> m ()
setCollectionModified :: forall (m :: * -> *) o.
(MonadIO m, IsCollection o) =>
o -> Word64 -> m ()
setCollectionModified o
obj Word64
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Word64 -> IO ()
forall a. GObject a => a -> String -> Word64 -> IO ()
B.Properties.setObjectPropertyUInt64 o
obj String
"modified" Word64
val
constructCollectionModified :: (IsCollection o, MIO.MonadIO m) => Word64 -> m (GValueConstruct o)
constructCollectionModified :: forall o (m :: * -> *).
(IsCollection o, MonadIO m) =>
Word64 -> m (GValueConstruct o)
constructCollectionModified Word64
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (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 :: forall o.
AttrBaseTypeConstraint CollectionModifiedPropertyInfo o =>
o -> IO (AttrGetType CollectionModifiedPropertyInfo)
attrGet = o -> IO Word64
o -> IO (AttrGetType CollectionModifiedPropertyInfo)
forall (m :: * -> *) o.
(MonadIO m, IsCollection o) =>
o -> m Word64
getCollectionModified
attrSet :: forall o b.
(AttrBaseTypeConstraint CollectionModifiedPropertyInfo o,
AttrSetTypeConstraint CollectionModifiedPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
o -> Word64 -> IO ()
forall (m :: * -> *) o.
(MonadIO m, IsCollection o) =>
o -> Word64 -> m ()
setCollectionModified
attrTransfer :: forall o b.
(AttrBaseTypeConstraint CollectionModifiedPropertyInfo o,
AttrTransferTypeConstraint CollectionModifiedPropertyInfo b) =>
Proxy o
-> b -> IO (AttrTransferType CollectionModifiedPropertyInfo)
attrTransfer Proxy o
_ b
v = do
b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
v
attrConstruct :: forall o b.
(AttrBaseTypeConstraint CollectionModifiedPropertyInfo o,
AttrSetTypeConstraint CollectionModifiedPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
Word64 -> IO (GValueConstruct o)
forall o (m :: * -> *).
(IsCollection o, MonadIO m) =>
Word64 -> m (GValueConstruct o)
constructCollectionModified
attrClear :: forall o.
AttrBaseTypeConstraint CollectionModifiedPropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.modified"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#g:attr:modified"
})
#endif
getCollectionService :: (MonadIO m, IsCollection o) => o -> m Secret.Service.Service
getCollectionService :: forall (m :: * -> *) o.
(MonadIO m, IsCollection o) =>
o -> m Service
getCollectionService o
obj = IO Service -> m Service
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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
constructCollectionService :: (IsCollection o, MIO.MonadIO m, Secret.Service.IsService a) => a -> m (GValueConstruct o)
constructCollectionService :: forall o (m :: * -> *) a.
(IsCollection o, MonadIO m, IsService a) =>
a -> m (GValueConstruct o)
constructCollectionService a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (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 :: forall o.
AttrBaseTypeConstraint CollectionServicePropertyInfo o =>
o -> IO (AttrGetType CollectionServicePropertyInfo)
attrGet = o -> IO (AttrGetType CollectionServicePropertyInfo)
o -> IO Service
forall (m :: * -> *) o.
(MonadIO m, IsCollection o) =>
o -> m Service
getCollectionService
attrSet :: forall o b.
(AttrBaseTypeConstraint CollectionServicePropertyInfo o,
AttrSetTypeConstraint CollectionServicePropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
attrTransfer :: forall o b.
(AttrBaseTypeConstraint CollectionServicePropertyInfo o,
AttrTransferTypeConstraint CollectionServicePropertyInfo b) =>
Proxy o -> b -> IO (AttrTransferType CollectionServicePropertyInfo)
attrTransfer Proxy o
_ b
v = do
(ManagedPtr Service -> Service) -> b -> IO Service
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr Service -> Service
Secret.Service.Service b
v
attrConstruct :: forall o b.
(AttrBaseTypeConstraint CollectionServicePropertyInfo o,
AttrSetTypeConstraint CollectionServicePropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
forall o (m :: * -> *) a.
(IsCollection o, MonadIO m, IsService a) =>
a -> m (GValueConstruct o)
constructCollectionService
attrClear :: forall o.
AttrBaseTypeConstraint CollectionServicePropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.service"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#g:attr:service"
})
#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, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
collectionCreated :: AttrLabelProxy "created"
collectionCreated :: AttrLabelProxy "created"
collectionCreated = AttrLabelProxy "created"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
collectionFlags :: AttrLabelProxy "flags"
collectionFlags :: AttrLabelProxy "flags"
collectionFlags = AttrLabelProxy "flags"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
collectionLabel :: AttrLabelProxy "label"
collectionLabel :: AttrLabelProxy "label"
collectionLabel = AttrLabelProxy "label"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
collectionLocked :: AttrLabelProxy "locked"
collectionLocked :: AttrLabelProxy "locked"
collectionLocked = AttrLabelProxy "locked"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
collectionModified :: AttrLabelProxy "modified"
collectionModified :: AttrLabelProxy "modified"
collectionModified = AttrLabelProxy "modified"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
collectionService :: AttrLabelProxy "service"
collectionService :: AttrLabelProxy "service"
collectionService = AttrLabelProxy "service"
forall (a :: Symbol). AttrLabelProxy a
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, DK.Type)])
#endif
foreign import ccall "secret_collection_delete" secret_collection_delete ::
Ptr Collection ->
Ptr Gio.Cancellable.Cancellable ->
FunPtr Gio.Callbacks.C_AsyncReadyCallback ->
Ptr () ->
IO ()
collectionDelete ::
(B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) =>
a
-> Maybe (b)
-> Maybe (Gio.Callbacks.AsyncReadyCallback)
-> m ()
collectionDelete :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
collectionDelete a
self Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
maybeCancellable <- case cancellable of
Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
Just b
jCancellable -> do
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
return jCancellable'
maybeCallback <- case callback of
Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
Just AsyncReadyCallback
jCallback -> do
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
poke ptrcallback jCallback'
return jCallback'
let userData = Ptr a
forall a. Ptr a
nullPtr
secret_collection_delete self' maybeCancellable maybeCallback userData
touchManagedPtr self
whenJust cancellable touchManagedPtr
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.OverloadedMethod CollectionDeleteMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
collectionDelete
instance O.OverloadedMethodInfo CollectionDeleteMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.collectionDelete",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#v:collectionDelete"
})
#endif
foreign import ccall "secret_collection_delete_finish" secret_collection_delete_finish ::
Ptr Collection ->
Ptr Gio.AsyncResult.AsyncResult ->
Ptr (Ptr GError) ->
IO CInt
collectionDeleteFinish ::
(B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.AsyncResult.IsAsyncResult b) =>
a
-> b
-> m ()
collectionDeleteFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsAsyncResult b) =>
a -> b -> m ()
collectionDeleteFinish a
self b
result_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result_' <- unsafeManagedPtrCastPtr result_
onException (do
_ <- propagateGError $ secret_collection_delete_finish self' result_'
touchManagedPtr self
touchManagedPtr result_
return ()
) (do
return ()
)
#if defined(ENABLE_OVERLOADING)
data CollectionDeleteFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsCollection a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod CollectionDeleteFinishMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> b -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsAsyncResult b) =>
a -> b -> m ()
collectionDeleteFinish
instance O.OverloadedMethodInfo CollectionDeleteFinishMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.collectionDeleteFinish",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#v:collectionDeleteFinish"
})
#endif
foreign import ccall "secret_collection_delete_sync" secret_collection_delete_sync ::
Ptr Collection ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO CInt
collectionDeleteSync ::
(B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) =>
a
-> Maybe (b)
-> m ()
collectionDeleteSync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsCancellable b) =>
a -> Maybe b -> m ()
collectionDeleteSync a
self Maybe b
cancellable = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
maybeCancellable <- case cancellable of
Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
Just b
jCancellable -> do
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
return jCancellable'
onException (do
_ <- propagateGError $ secret_collection_delete_sync self' maybeCancellable
touchManagedPtr self
whenJust cancellable touchManagedPtr
return ()
) (do
return ()
)
#if defined(ENABLE_OVERLOADING)
data CollectionDeleteSyncMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod CollectionDeleteSyncMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> Maybe b -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsCancellable b) =>
a -> Maybe b -> m ()
collectionDeleteSync
instance O.OverloadedMethodInfo CollectionDeleteSyncMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.collectionDeleteSync",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#v:collectionDeleteSync"
})
#endif
foreign import ccall "secret_collection_get_created" secret_collection_get_created ::
Ptr Collection ->
IO Word64
collectionGetCreated ::
(B.CallStack.HasCallStack, MonadIO m, IsCollection a) =>
a
-> m Word64
collectionGetCreated :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCollection a) =>
a -> m Word64
collectionGetCreated a
self = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- secret_collection_get_created self'
touchManagedPtr self
return result
#if defined(ENABLE_OVERLOADING)
data CollectionGetCreatedMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsCollection a) => O.OverloadedMethod CollectionGetCreatedMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m Word64
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCollection a) =>
a -> m Word64
collectionGetCreated
instance O.OverloadedMethodInfo CollectionGetCreatedMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.collectionGetCreated",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#v:collectionGetCreated"
})
#endif
foreign import ccall "secret_collection_get_flags" secret_collection_get_flags ::
Ptr Collection ->
IO CUInt
collectionGetFlags ::
(B.CallStack.HasCallStack, MonadIO m, IsCollection a) =>
a
-> m [Secret.Flags.CollectionFlags]
collectionGetFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCollection a) =>
a -> m [CollectionFlags]
collectionGetFlags a
self = IO [CollectionFlags] -> m [CollectionFlags]
forall a. IO a -> m a
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
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- secret_collection_get_flags self'
let result' = CUInt -> [CollectionFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
touchManagedPtr self
return result'
#if defined(ENABLE_OVERLOADING)
data CollectionGetFlagsMethodInfo
instance (signature ~ (m [Secret.Flags.CollectionFlags]), MonadIO m, IsCollection a) => O.OverloadedMethod CollectionGetFlagsMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m [CollectionFlags]
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCollection a) =>
a -> m [CollectionFlags]
collectionGetFlags
instance O.OverloadedMethodInfo CollectionGetFlagsMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.collectionGetFlags",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#v:collectionGetFlags"
})
#endif
foreign import ccall "secret_collection_get_items" secret_collection_get_items ::
Ptr Collection ->
IO (Ptr (GList (Ptr Secret.Item.Item)))
collectionGetItems ::
(B.CallStack.HasCallStack, MonadIO m, IsCollection a) =>
a
-> m [Secret.Item.Item]
collectionGetItems :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCollection a) =>
a -> m [Item]
collectionGetItems a
self = IO [Item] -> m [Item]
forall a. IO a -> m a
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
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- secret_collection_get_items self'
result' <- unpackGList result
result'' <- mapM (wrapObject Secret.Item.Item) result'
g_list_free result
touchManagedPtr self
return result''
#if defined(ENABLE_OVERLOADING)
data CollectionGetItemsMethodInfo
instance (signature ~ (m [Secret.Item.Item]), MonadIO m, IsCollection a) => O.OverloadedMethod CollectionGetItemsMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m [Item]
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCollection a) =>
a -> m [Item]
collectionGetItems
instance O.OverloadedMethodInfo CollectionGetItemsMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.collectionGetItems",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#v:collectionGetItems"
})
#endif
foreign import ccall "secret_collection_get_label" secret_collection_get_label ::
Ptr Collection ->
IO CString
collectionGetLabel ::
(B.CallStack.HasCallStack, MonadIO m, IsCollection a) =>
a
-> m T.Text
collectionGetLabel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCollection a) =>
a -> m Text
collectionGetLabel a
self = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- secret_collection_get_label self'
checkUnexpectedReturnNULL "collectionGetLabel" result
result' <- cstringToText result
freeMem result
touchManagedPtr self
return result'
#if defined(ENABLE_OVERLOADING)
data CollectionGetLabelMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsCollection a) => O.OverloadedMethod CollectionGetLabelMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m Text
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCollection a) =>
a -> m Text
collectionGetLabel
instance O.OverloadedMethodInfo CollectionGetLabelMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.collectionGetLabel",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#v:collectionGetLabel"
})
#endif
foreign import ccall "secret_collection_get_locked" secret_collection_get_locked ::
Ptr Collection ->
IO CInt
collectionGetLocked ::
(B.CallStack.HasCallStack, MonadIO m, IsCollection a) =>
a
-> m Bool
collectionGetLocked :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCollection a) =>
a -> m Bool
collectionGetLocked a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- secret_collection_get_locked self'
let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
touchManagedPtr self
return result'
#if defined(ENABLE_OVERLOADING)
data CollectionGetLockedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsCollection a) => O.OverloadedMethod CollectionGetLockedMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m Bool
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCollection a) =>
a -> m Bool
collectionGetLocked
instance O.OverloadedMethodInfo CollectionGetLockedMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.collectionGetLocked",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#v:collectionGetLocked"
})
#endif
foreign import ccall "secret_collection_get_modified" secret_collection_get_modified ::
Ptr Collection ->
IO Word64
collectionGetModified ::
(B.CallStack.HasCallStack, MonadIO m, IsCollection a) =>
a
-> m Word64
collectionGetModified :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCollection a) =>
a -> m Word64
collectionGetModified a
self = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- secret_collection_get_modified self'
touchManagedPtr self
return result
#if defined(ENABLE_OVERLOADING)
data CollectionGetModifiedMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsCollection a) => O.OverloadedMethod CollectionGetModifiedMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m Word64
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCollection a) =>
a -> m Word64
collectionGetModified
instance O.OverloadedMethodInfo CollectionGetModifiedMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.collectionGetModified",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#v:collectionGetModified"
})
#endif
foreign import ccall "secret_collection_get_service" secret_collection_get_service ::
Ptr Collection ->
IO (Ptr Secret.Service.Service)
collectionGetService ::
(B.CallStack.HasCallStack, MonadIO m, IsCollection a) =>
a
-> m Secret.Service.Service
collectionGetService :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCollection a) =>
a -> m Service
collectionGetService a
self = IO Service -> m Service
forall a. IO a -> m a
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
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- secret_collection_get_service self'
checkUnexpectedReturnNULL "collectionGetService" result
result' <- (newObject Secret.Service.Service) result
touchManagedPtr self
return result'
#if defined(ENABLE_OVERLOADING)
data CollectionGetServiceMethodInfo
instance (signature ~ (m Secret.Service.Service), MonadIO m, IsCollection a) => O.OverloadedMethod CollectionGetServiceMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m Service
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCollection a) =>
a -> m Service
collectionGetService
instance O.OverloadedMethodInfo CollectionGetServiceMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.collectionGetService",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#v:collectionGetService"
})
#endif
foreign import ccall "secret_collection_load_items" secret_collection_load_items ::
Ptr Collection ->
Ptr Gio.Cancellable.Cancellable ->
FunPtr Gio.Callbacks.C_AsyncReadyCallback ->
Ptr () ->
IO ()
collectionLoadItems ::
(B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) =>
a
-> Maybe (b)
-> Maybe (Gio.Callbacks.AsyncReadyCallback)
-> m ()
collectionLoadItems :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
collectionLoadItems a
self Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
maybeCancellable <- case cancellable of
Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
Just b
jCancellable -> do
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
return jCancellable'
maybeCallback <- case callback of
Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
Just AsyncReadyCallback
jCallback -> do
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
poke ptrcallback jCallback'
return jCallback'
let userData = Ptr a
forall a. Ptr a
nullPtr
secret_collection_load_items self' maybeCancellable maybeCallback userData
touchManagedPtr self
whenJust cancellable touchManagedPtr
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.OverloadedMethod CollectionLoadItemsMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
collectionLoadItems
instance O.OverloadedMethodInfo CollectionLoadItemsMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.collectionLoadItems",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#v:collectionLoadItems"
})
#endif
foreign import ccall "secret_collection_load_items_finish" secret_collection_load_items_finish ::
Ptr Collection ->
Ptr Gio.AsyncResult.AsyncResult ->
Ptr (Ptr GError) ->
IO CInt
collectionLoadItemsFinish ::
(B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.AsyncResult.IsAsyncResult b) =>
a
-> b
-> m ()
collectionLoadItemsFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsAsyncResult b) =>
a -> b -> m ()
collectionLoadItemsFinish a
self b
result_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result_' <- unsafeManagedPtrCastPtr result_
onException (do
_ <- propagateGError $ secret_collection_load_items_finish self' result_'
touchManagedPtr self
touchManagedPtr result_
return ()
) (do
return ()
)
#if defined(ENABLE_OVERLOADING)
data CollectionLoadItemsFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsCollection a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod CollectionLoadItemsFinishMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> b -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsAsyncResult b) =>
a -> b -> m ()
collectionLoadItemsFinish
instance O.OverloadedMethodInfo CollectionLoadItemsFinishMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.collectionLoadItemsFinish",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#v:collectionLoadItemsFinish"
})
#endif
foreign import ccall "secret_collection_load_items_sync" secret_collection_load_items_sync ::
Ptr Collection ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO CInt
collectionLoadItemsSync ::
(B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) =>
a
-> Maybe (b)
-> m ()
collectionLoadItemsSync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsCancellable b) =>
a -> Maybe b -> m ()
collectionLoadItemsSync a
self Maybe b
cancellable = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
maybeCancellable <- case cancellable of
Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
Just b
jCancellable -> do
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
return jCancellable'
onException (do
_ <- propagateGError $ secret_collection_load_items_sync self' maybeCancellable
touchManagedPtr self
whenJust cancellable touchManagedPtr
return ()
) (do
return ()
)
#if defined(ENABLE_OVERLOADING)
data CollectionLoadItemsSyncMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod CollectionLoadItemsSyncMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> Maybe b -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsCancellable b) =>
a -> Maybe b -> m ()
collectionLoadItemsSync
instance O.OverloadedMethodInfo CollectionLoadItemsSyncMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.collectionLoadItemsSync",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#v:collectionLoadItemsSync"
})
#endif
foreign import ccall "secret_collection_refresh" secret_collection_refresh ::
Ptr Collection ->
IO ()
collectionRefresh ::
(B.CallStack.HasCallStack, MonadIO m, IsCollection a) =>
a
-> m ()
collectionRefresh :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCollection a) =>
a -> m ()
collectionRefresh a
self = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
secret_collection_refresh self'
touchManagedPtr self
return ()
#if defined(ENABLE_OVERLOADING)
data CollectionRefreshMethodInfo
instance (signature ~ (m ()), MonadIO m, IsCollection a) => O.OverloadedMethod CollectionRefreshMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCollection a) =>
a -> m ()
collectionRefresh
instance O.OverloadedMethodInfo CollectionRefreshMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.collectionRefresh",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#v:collectionRefresh"
})
#endif
foreign import ccall "secret_collection_search" secret_collection_search ::
Ptr Collection ->
Ptr Secret.Schema.Schema ->
Ptr (GHashTable CString CString) ->
CUInt ->
Ptr Gio.Cancellable.Cancellable ->
FunPtr Gio.Callbacks.C_AsyncReadyCallback ->
Ptr () ->
IO ()
collectionSearch ::
(B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) =>
a
-> Maybe (Secret.Schema.Schema)
-> Map.Map T.Text T.Text
-> [Secret.Flags.SearchFlags]
-> Maybe (b)
-> Maybe (Gio.Callbacks.AsyncReadyCallback)
-> m ()
collectionSearch :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsCancellable b) =>
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 a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
maybeSchema <- case schema of
Maybe Schema
Nothing -> Ptr Schema -> IO (Ptr Schema)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
forall a. Ptr a
FP.nullPtr
Just Schema
jSchema -> do
jSchema' <- Schema -> IO (Ptr Schema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Schema
jSchema
return jSchema'
let attributes' = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
attributes
attributes'' <- mapFirstA textToCString attributes'
attributes''' <- mapSecondA textToCString attributes''
let attributes'''' = (CString -> PtrWrapped CString)
-> [(CString, CString)] -> [(PtrWrapped CString, CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst CString -> PtrWrapped CString
B.GHT.cstringPackPtr [(CString, CString)]
attributes'''
let 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
B.GHT.cstringPackPtr [(PtrWrapped CString, CString)]
attributes''''
attributes'''''' <- packGHashTable gStrHash gStrEqual (Just ptr_to_g_free) (Just ptr_to_g_free) attributes'''''
let flags' = [SearchFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SearchFlags]
flags
maybeCancellable <- case cancellable of
Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
Just b
jCancellable -> do
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
return jCancellable'
maybeCallback <- case callback of
Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
Just AsyncReadyCallback
jCallback -> do
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
poke ptrcallback jCallback'
return jCallback'
let userData = Ptr a
forall a. Ptr a
nullPtr
secret_collection_search self' maybeSchema attributes'''''' flags' maybeCancellable maybeCallback userData
touchManagedPtr self
whenJust schema touchManagedPtr
whenJust cancellable touchManagedPtr
unrefGHashTable attributes''''''
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.OverloadedMethod CollectionSearchMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a
-> Maybe Schema
-> Map Text Text
-> [SearchFlags]
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsCancellable b) =>
a
-> Maybe Schema
-> Map Text Text
-> [SearchFlags]
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
collectionSearch
instance O.OverloadedMethodInfo CollectionSearchMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.collectionSearch",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#v:collectionSearch"
})
#endif
foreign import ccall "secret_collection_search_finish" secret_collection_search_finish ::
Ptr Collection ->
Ptr Gio.AsyncResult.AsyncResult ->
Ptr (Ptr GError) ->
IO (Ptr (GList (Ptr Secret.Item.Item)))
collectionSearchFinish ::
(B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.AsyncResult.IsAsyncResult b) =>
a
-> b
-> m [Secret.Item.Item]
collectionSearchFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsAsyncResult b) =>
a -> b -> m [Item]
collectionSearchFinish a
self b
result_ = IO [Item] -> m [Item]
forall a. IO a -> m a
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
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result_' <- unsafeManagedPtrCastPtr result_
onException (do
result <- propagateGError $ secret_collection_search_finish self' result_'
result' <- unpackGList result
result'' <- mapM (wrapObject Secret.Item.Item) result'
g_list_free result
touchManagedPtr self
touchManagedPtr result_
return result''
) (do
return ()
)
#if defined(ENABLE_OVERLOADING)
data CollectionSearchFinishMethodInfo
instance (signature ~ (b -> m [Secret.Item.Item]), MonadIO m, IsCollection a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod CollectionSearchFinishMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> b -> m [Item]
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsAsyncResult b) =>
a -> b -> m [Item]
collectionSearchFinish
instance O.OverloadedMethodInfo CollectionSearchFinishMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.collectionSearchFinish",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#v:collectionSearchFinish"
})
#endif
foreign import ccall "secret_collection_search_sync" secret_collection_search_sync ::
Ptr Collection ->
Ptr Secret.Schema.Schema ->
Ptr (GHashTable CString CString) ->
CUInt ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO (Ptr (GList (Ptr Secret.Item.Item)))
collectionSearchSync ::
(B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) =>
a
-> Maybe (Secret.Schema.Schema)
-> Map.Map T.Text T.Text
-> [Secret.Flags.SearchFlags]
-> Maybe (b)
-> m [Secret.Item.Item]
collectionSearchSync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsCancellable b) =>
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 a. IO a -> m a
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
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
maybeSchema <- case schema of
Maybe Schema
Nothing -> Ptr Schema -> IO (Ptr Schema)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Schema
forall a. Ptr a
FP.nullPtr
Just Schema
jSchema -> do
jSchema' <- Schema -> IO (Ptr Schema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Schema
jSchema
return jSchema'
let attributes' = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
attributes
attributes'' <- mapFirstA textToCString attributes'
attributes''' <- mapSecondA textToCString attributes''
let attributes'''' = (CString -> PtrWrapped CString)
-> [(CString, CString)] -> [(PtrWrapped CString, CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst CString -> PtrWrapped CString
B.GHT.cstringPackPtr [(CString, CString)]
attributes'''
let 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
B.GHT.cstringPackPtr [(PtrWrapped CString, CString)]
attributes''''
attributes'''''' <- packGHashTable gStrHash gStrEqual (Just ptr_to_g_free) (Just ptr_to_g_free) attributes'''''
let flags' = [SearchFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SearchFlags]
flags
maybeCancellable <- case cancellable of
Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
Just b
jCancellable -> do
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
return jCancellable'
onException (do
result <- propagateGError $ secret_collection_search_sync self' maybeSchema attributes'''''' flags' maybeCancellable
result' <- unpackGList result
result'' <- mapM (wrapObject Secret.Item.Item) result'
g_list_free result
touchManagedPtr self
whenJust schema touchManagedPtr
whenJust cancellable touchManagedPtr
unrefGHashTable attributes''''''
return result''
) (do
unrefGHashTable 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.OverloadedMethod CollectionSearchSyncMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a
-> Maybe Schema
-> Map Text Text
-> [SearchFlags]
-> Maybe b
-> m [Item]
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsCancellable b) =>
a
-> Maybe Schema
-> Map Text Text
-> [SearchFlags]
-> Maybe b
-> m [Item]
collectionSearchSync
instance O.OverloadedMethodInfo CollectionSearchSyncMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.collectionSearchSync",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#v:collectionSearchSync"
})
#endif
foreign import ccall "secret_collection_set_label" secret_collection_set_label ::
Ptr Collection ->
CString ->
Ptr Gio.Cancellable.Cancellable ->
FunPtr Gio.Callbacks.C_AsyncReadyCallback ->
Ptr () ->
IO ()
collectionSetLabel ::
(B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) =>
a
-> T.Text
-> Maybe (b)
-> Maybe (Gio.Callbacks.AsyncReadyCallback)
-> m ()
collectionSetLabel :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsCancellable b) =>
a -> Text -> Maybe b -> Maybe AsyncReadyCallback -> m ()
collectionSetLabel a
self Text
label Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
label' <- textToCString label
maybeCancellable <- case cancellable of
Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
Just b
jCancellable -> do
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
return jCancellable'
maybeCallback <- case callback of
Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
Just AsyncReadyCallback
jCallback -> do
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
poke ptrcallback jCallback'
return jCallback'
let userData = Ptr a
forall a. Ptr a
nullPtr
secret_collection_set_label self' label' maybeCancellable maybeCallback userData
touchManagedPtr self
whenJust cancellable touchManagedPtr
freeMem label'
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.OverloadedMethod CollectionSetLabelMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> Text -> Maybe b -> Maybe AsyncReadyCallback -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsCancellable b) =>
a -> Text -> Maybe b -> Maybe AsyncReadyCallback -> m ()
collectionSetLabel
instance O.OverloadedMethodInfo CollectionSetLabelMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.collectionSetLabel",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#v:collectionSetLabel"
})
#endif
foreign import ccall "secret_collection_set_label_finish" secret_collection_set_label_finish ::
Ptr Collection ->
Ptr Gio.AsyncResult.AsyncResult ->
Ptr (Ptr GError) ->
IO CInt
collectionSetLabelFinish ::
(B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.AsyncResult.IsAsyncResult b) =>
a
-> b
-> m ()
collectionSetLabelFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsAsyncResult b) =>
a -> b -> m ()
collectionSetLabelFinish a
self b
result_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result_' <- unsafeManagedPtrCastPtr result_
onException (do
_ <- propagateGError $ secret_collection_set_label_finish self' result_'
touchManagedPtr self
touchManagedPtr result_
return ()
) (do
return ()
)
#if defined(ENABLE_OVERLOADING)
data CollectionSetLabelFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsCollection a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod CollectionSetLabelFinishMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> b -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsAsyncResult b) =>
a -> b -> m ()
collectionSetLabelFinish
instance O.OverloadedMethodInfo CollectionSetLabelFinishMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.collectionSetLabelFinish",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#v:collectionSetLabelFinish"
})
#endif
foreign import ccall "secret_collection_set_label_sync" secret_collection_set_label_sync ::
Ptr Collection ->
CString ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO CInt
collectionSetLabelSync ::
(B.CallStack.HasCallStack, MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) =>
a
-> T.Text
-> Maybe (b)
-> m ()
collectionSetLabelSync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsCancellable b) =>
a -> Text -> Maybe b -> m ()
collectionSetLabelSync a
self Text
label Maybe b
cancellable = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
label' <- textToCString label
maybeCancellable <- case cancellable of
Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
Just b
jCancellable -> do
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
return jCancellable'
onException (do
_ <- propagateGError $ secret_collection_set_label_sync self' label' maybeCancellable
touchManagedPtr self
whenJust cancellable touchManagedPtr
freeMem label'
return ()
) (do
freeMem label'
)
#if defined(ENABLE_OVERLOADING)
data CollectionSetLabelSyncMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> m ()), MonadIO m, IsCollection a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod CollectionSetLabelSyncMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> Text -> Maybe b -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsCancellable b) =>
a -> Text -> Maybe b -> m ()
collectionSetLabelSync
instance O.OverloadedMethodInfo CollectionSetLabelSyncMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Objects.Collection.collectionSetLabelSync",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Collection.html#v:collectionSetLabelSync"
})
#endif
foreign import ccall "secret_collection_create" secret_collection_create ::
Ptr Secret.Service.Service ->
CString ->
CString ->
CUInt ->
Ptr Gio.Cancellable.Cancellable ->
FunPtr Gio.Callbacks.C_AsyncReadyCallback ->
Ptr () ->
IO ()
collectionCreate ::
(B.CallStack.HasCallStack, MonadIO m, Secret.Service.IsService a, Gio.Cancellable.IsCancellable b) =>
Maybe (a)
-> T.Text
-> Maybe (T.Text)
-> [Secret.Flags.CollectionCreateFlags]
-> Maybe (b)
-> Maybe (Gio.Callbacks.AsyncReadyCallback)
-> m ()
collectionCreate :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
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 a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
maybeService <- case Maybe a
service of
Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
Just a
jService -> do
jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
return jService'
label' <- textToCString label
maybeAlias <- case alias of
Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
FP.nullPtr
Just Text
jAlias -> do
jAlias' <- Text -> IO CString
textToCString Text
jAlias
return jAlias'
let flags' = [CollectionCreateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [CollectionCreateFlags]
flags
maybeCancellable <- case cancellable of
Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
Just b
jCancellable -> do
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
return jCancellable'
maybeCallback <- case callback of
Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
Just AsyncReadyCallback
jCallback -> do
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
poke ptrcallback jCallback'
return jCallback'
let userData = Ptr a
forall a. Ptr a
nullPtr
secret_collection_create maybeService label' maybeAlias flags' maybeCancellable maybeCallback userData
whenJust service touchManagedPtr
whenJust cancellable touchManagedPtr
freeMem label'
freeMem maybeAlias
return ()
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "secret_collection_create_finish" secret_collection_create_finish ::
Ptr Gio.AsyncResult.AsyncResult ->
Ptr (Ptr GError) ->
IO (Ptr Collection)
collectionCreateFinish ::
(B.CallStack.HasCallStack, MonadIO m, Gio.AsyncResult.IsAsyncResult a) =>
a
-> m Collection
collectionCreateFinish :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsyncResult a) =>
a -> m Collection
collectionCreateFinish a
result_ = IO Collection -> m Collection
forall a. IO a -> m a
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
result_' <- a -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
result_
onException (do
result <- propagateGError $ secret_collection_create_finish result_'
checkUnexpectedReturnNULL "collectionCreateFinish" result
result' <- (wrapObject Collection) result
touchManagedPtr result_
return result'
) (do
return ()
)
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "secret_collection_create_sync" secret_collection_create_sync ::
Ptr Secret.Service.Service ->
CString ->
CString ->
CUInt ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO (Ptr Collection)
collectionCreateSync ::
(B.CallStack.HasCallStack, MonadIO m, Secret.Service.IsService a, Gio.Cancellable.IsCancellable b) =>
Maybe (a)
-> T.Text
-> Maybe (T.Text)
-> [Secret.Flags.CollectionCreateFlags]
-> Maybe (b)
-> m Collection
collectionCreateSync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
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 a. IO a -> m a
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
maybeService <- case Maybe a
service of
Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
Just a
jService -> do
jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
return jService'
label' <- textToCString label
maybeAlias <- case alias of
Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
FP.nullPtr
Just Text
jAlias -> do
jAlias' <- Text -> IO CString
textToCString Text
jAlias
return jAlias'
let flags' = [CollectionCreateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [CollectionCreateFlags]
flags
maybeCancellable <- case cancellable of
Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
Just b
jCancellable -> do
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
return jCancellable'
onException (do
result <- propagateGError $ secret_collection_create_sync maybeService label' maybeAlias flags' maybeCancellable
checkUnexpectedReturnNULL "collectionCreateSync" result
result' <- (wrapObject Collection) result
whenJust service touchManagedPtr
whenJust cancellable touchManagedPtr
freeMem label'
freeMem maybeAlias
return result'
) (do
freeMem label'
freeMem maybeAlias
)
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "secret_collection_for_alias" secret_collection_for_alias ::
Ptr Secret.Service.Service ->
CString ->
CUInt ->
Ptr Gio.Cancellable.Cancellable ->
FunPtr Gio.Callbacks.C_AsyncReadyCallback ->
Ptr () ->
IO ()
collectionForAlias ::
(B.CallStack.HasCallStack, MonadIO m, Secret.Service.IsService a, Gio.Cancellable.IsCancellable b) =>
Maybe (a)
-> T.Text
-> [Secret.Flags.CollectionFlags]
-> Maybe (b)
-> Maybe (Gio.Callbacks.AsyncReadyCallback)
-> m ()
collectionForAlias :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
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 a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
maybeService <- case Maybe a
service of
Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
Just a
jService -> do
jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
return jService'
alias' <- textToCString alias
let flags' = [CollectionFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [CollectionFlags]
flags
maybeCancellable <- case cancellable of
Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
Just b
jCancellable -> do
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
return jCancellable'
maybeCallback <- case callback of
Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
Just AsyncReadyCallback
jCallback -> do
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
poke ptrcallback jCallback'
return jCallback'
let userData = Ptr a
forall a. Ptr a
nullPtr
secret_collection_for_alias maybeService alias' flags' maybeCancellable maybeCallback userData
whenJust service touchManagedPtr
whenJust cancellable touchManagedPtr
freeMem alias'
return ()
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "secret_collection_for_alias_finish" secret_collection_for_alias_finish ::
Ptr Gio.AsyncResult.AsyncResult ->
Ptr (Ptr GError) ->
IO (Ptr Collection)
collectionForAliasFinish ::
(B.CallStack.HasCallStack, MonadIO m, Gio.AsyncResult.IsAsyncResult a) =>
a
-> m (Maybe Collection)
collectionForAliasFinish :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsyncResult a) =>
a -> m (Maybe Collection)
collectionForAliasFinish a
result_ = IO (Maybe Collection) -> m (Maybe Collection)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Collection) -> m (Maybe Collection))
-> IO (Maybe Collection) -> m (Maybe Collection)
forall a b. (a -> b) -> a -> b
$ do
result_' <- a -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
result_
onException (do
result <- propagateGError $ secret_collection_for_alias_finish result_'
maybeResult <- convertIfNonNull result $ \Ptr Collection
result' -> do
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'
return result''
touchManagedPtr result_
return maybeResult
) (do
return ()
)
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "secret_collection_for_alias_sync" secret_collection_for_alias_sync ::
Ptr Secret.Service.Service ->
CString ->
CUInt ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO (Ptr Collection)
collectionForAliasSync ::
(B.CallStack.HasCallStack, MonadIO m, Secret.Service.IsService a, Gio.Cancellable.IsCancellable b) =>
Maybe (a)
-> T.Text
-> [Secret.Flags.CollectionFlags]
-> Maybe (b)
-> m (Maybe Collection)
collectionForAliasSync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsService a, IsCancellable b) =>
Maybe a
-> Text -> [CollectionFlags] -> Maybe b -> m (Maybe Collection)
collectionForAliasSync Maybe a
service Text
alias [CollectionFlags]
flags Maybe b
cancellable = IO (Maybe Collection) -> m (Maybe Collection)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Collection) -> m (Maybe Collection))
-> IO (Maybe Collection) -> m (Maybe Collection)
forall a b. (a -> b) -> a -> b
$ do
maybeService <- case Maybe a
service of
Maybe a
Nothing -> Ptr Service -> IO (Ptr Service)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Service
forall a. Ptr a
FP.nullPtr
Just a
jService -> do
jService' <- a -> IO (Ptr Service)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jService
return jService'
alias' <- textToCString alias
let flags' = [CollectionFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [CollectionFlags]
flags
maybeCancellable <- case cancellable of
Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
Just b
jCancellable -> do
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
return jCancellable'
onException (do
result <- propagateGError $ secret_collection_for_alias_sync maybeService alias' flags' maybeCancellable
maybeResult <- convertIfNonNull result $ \Ptr Collection
result' -> do
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'
return result''
whenJust service touchManagedPtr
whenJust cancellable touchManagedPtr
freeMem alias'
return maybeResult
) (do
freeMem alias'
)
#if defined(ENABLE_OVERLOADING)
#endif