{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Secret.Objects.Item
(
Item(..) ,
IsItem ,
toItem ,
#if defined(ENABLE_OVERLOADING)
ResolveItemMethod ,
#endif
itemCreate ,
itemCreateFinish ,
itemCreateSync ,
#if defined(ENABLE_OVERLOADING)
ItemDeleteMethodInfo ,
#endif
itemDelete ,
#if defined(ENABLE_OVERLOADING)
ItemDeleteFinishMethodInfo ,
#endif
itemDeleteFinish ,
#if defined(ENABLE_OVERLOADING)
ItemDeleteSyncMethodInfo ,
#endif
itemDeleteSync ,
#if defined(ENABLE_OVERLOADING)
ItemGetAttributesMethodInfo ,
#endif
itemGetAttributes ,
#if defined(ENABLE_OVERLOADING)
ItemGetCreatedMethodInfo ,
#endif
itemGetCreated ,
#if defined(ENABLE_OVERLOADING)
ItemGetFlagsMethodInfo ,
#endif
itemGetFlags ,
#if defined(ENABLE_OVERLOADING)
ItemGetLabelMethodInfo ,
#endif
itemGetLabel ,
#if defined(ENABLE_OVERLOADING)
ItemGetLockedMethodInfo ,
#endif
itemGetLocked ,
#if defined(ENABLE_OVERLOADING)
ItemGetModifiedMethodInfo ,
#endif
itemGetModified ,
#if defined(ENABLE_OVERLOADING)
ItemGetSchemaNameMethodInfo ,
#endif
itemGetSchemaName ,
#if defined(ENABLE_OVERLOADING)
ItemGetSecretMethodInfo ,
#endif
itemGetSecret ,
#if defined(ENABLE_OVERLOADING)
ItemGetServiceMethodInfo ,
#endif
itemGetService ,
#if defined(ENABLE_OVERLOADING)
ItemLoadSecretMethodInfo ,
#endif
itemLoadSecret ,
#if defined(ENABLE_OVERLOADING)
ItemLoadSecretFinishMethodInfo ,
#endif
itemLoadSecretFinish ,
#if defined(ENABLE_OVERLOADING)
ItemLoadSecretSyncMethodInfo ,
#endif
itemLoadSecretSync ,
itemLoadSecrets ,
itemLoadSecretsFinish ,
itemLoadSecretsSync ,
#if defined(ENABLE_OVERLOADING)
ItemRefreshMethodInfo ,
#endif
itemRefresh ,
#if defined(ENABLE_OVERLOADING)
ItemSetAttributesMethodInfo ,
#endif
itemSetAttributes ,
#if defined(ENABLE_OVERLOADING)
ItemSetAttributesFinishMethodInfo ,
#endif
itemSetAttributesFinish ,
#if defined(ENABLE_OVERLOADING)
ItemSetAttributesSyncMethodInfo ,
#endif
itemSetAttributesSync ,
#if defined(ENABLE_OVERLOADING)
ItemSetLabelMethodInfo ,
#endif
itemSetLabel ,
#if defined(ENABLE_OVERLOADING)
ItemSetLabelFinishMethodInfo ,
#endif
itemSetLabelFinish ,
#if defined(ENABLE_OVERLOADING)
ItemSetLabelSyncMethodInfo ,
#endif
itemSetLabelSync ,
#if defined(ENABLE_OVERLOADING)
ItemSetSecretMethodInfo ,
#endif
itemSetSecret ,
#if defined(ENABLE_OVERLOADING)
ItemSetSecretFinishMethodInfo ,
#endif
itemSetSecretFinish ,
#if defined(ENABLE_OVERLOADING)
ItemSetSecretSyncMethodInfo ,
#endif
itemSetSecretSync ,
#if defined(ENABLE_OVERLOADING)
ItemFlagsPropertyInfo ,
#endif
constructItemFlags ,
getItemFlags ,
#if defined(ENABLE_OVERLOADING)
itemFlags ,
#endif
#if defined(ENABLE_OVERLOADING)
ItemLockedPropertyInfo ,
#endif
getItemLocked ,
#if defined(ENABLE_OVERLOADING)
itemLocked ,
#endif
#if defined(ENABLE_OVERLOADING)
ItemServicePropertyInfo ,
#endif
constructItemService ,
getItemService ,
#if defined(ENABLE_OVERLOADING)
itemService ,
#endif
) where
import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P
import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.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.Collection as Secret.Collection
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.Interfaces.Retrievable as Secret.Retrievable
import {-# SOURCE #-} qualified GI.Secret.Objects.Collection as Secret.Collection
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
#endif
newtype Item = Item (SP.ManagedPtr Item)
deriving (Item -> Item -> Bool
(Item -> Item -> Bool) -> (Item -> Item -> Bool) -> Eq Item
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Item -> Item -> Bool
== :: Item -> Item -> Bool
$c/= :: Item -> Item -> Bool
/= :: Item -> Item -> Bool
Eq)
instance SP.ManagedPtrNewtype Item where
toManagedPtr :: Item -> ManagedPtr Item
toManagedPtr (Item ManagedPtr Item
p) = ManagedPtr Item
p
foreign import ccall "secret_item_get_type"
c_secret_item_get_type :: IO B.Types.GType
instance B.Types.TypedObject Item where
glibType :: IO GType
glibType = IO GType
c_secret_item_get_type
instance B.Types.GObject Item
class (SP.GObject o, O.IsDescendantOf Item o) => IsItem o
instance (SP.GObject o, O.IsDescendantOf Item o) => IsItem o
instance O.HasParentTypes Item
type instance O.ParentTypes Item = '[Gio.DBusProxy.DBusProxy, GObject.Object.Object, Gio.AsyncInitable.AsyncInitable, Gio.DBusInterface.DBusInterface, Gio.Initable.Initable, Secret.Retrievable.Retrievable]
toItem :: (MIO.MonadIO m, IsItem o) => o -> m Item
toItem :: forall (m :: * -> *) o. (MonadIO m, IsItem o) => o -> m Item
toItem = IO Item -> m Item
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Item -> m Item) -> (o -> IO Item) -> o -> m Item
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Item -> Item) -> o -> IO Item
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Item -> Item
Item
instance B.GValue.IsGValue (Maybe Item) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_secret_item_get_type
gvalueSet_ :: Ptr GValue -> Maybe Item -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Item
P.Nothing = Ptr GValue -> Ptr Item -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Item
forall a. Ptr a
FP.nullPtr :: FP.Ptr Item)
gvalueSet_ Ptr GValue
gv (P.Just Item
obj) = Item -> (Ptr Item -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Item
obj (Ptr GValue -> Ptr Item -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe Item)
gvalueGet_ Ptr GValue
gv = do
ptr <- Ptr GValue -> IO (Ptr Item)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Item)
if ptr /= FP.nullPtr
then P.Just <$> B.ManagedPtr.newObject Item ptr
else return P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveItemMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveItemMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveItemMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveItemMethod "call" o = Gio.DBusProxy.DBusProxyCallMethodInfo
ResolveItemMethod "callFinish" o = Gio.DBusProxy.DBusProxyCallFinishMethodInfo
ResolveItemMethod "callSync" o = Gio.DBusProxy.DBusProxyCallSyncMethodInfo
ResolveItemMethod "callWithUnixFdList" o = Gio.DBusProxy.DBusProxyCallWithUnixFdListMethodInfo
ResolveItemMethod "callWithUnixFdListFinish" o = Gio.DBusProxy.DBusProxyCallWithUnixFdListFinishMethodInfo
ResolveItemMethod "callWithUnixFdListSync" o = Gio.DBusProxy.DBusProxyCallWithUnixFdListSyncMethodInfo
ResolveItemMethod "delete" o = ItemDeleteMethodInfo
ResolveItemMethod "deleteFinish" o = ItemDeleteFinishMethodInfo
ResolveItemMethod "deleteSync" o = ItemDeleteSyncMethodInfo
ResolveItemMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveItemMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveItemMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveItemMethod "init" o = Gio.Initable.InitableInitMethodInfo
ResolveItemMethod "initAsync" o = Gio.AsyncInitable.AsyncInitableInitAsyncMethodInfo
ResolveItemMethod "initFinish" o = Gio.AsyncInitable.AsyncInitableInitFinishMethodInfo
ResolveItemMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveItemMethod "loadSecret" o = ItemLoadSecretMethodInfo
ResolveItemMethod "loadSecretFinish" o = ItemLoadSecretFinishMethodInfo
ResolveItemMethod "loadSecretSync" o = ItemLoadSecretSyncMethodInfo
ResolveItemMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveItemMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveItemMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveItemMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveItemMethod "refresh" o = ItemRefreshMethodInfo
ResolveItemMethod "retrieveSecret" o = Secret.Retrievable.RetrievableRetrieveSecretMethodInfo
ResolveItemMethod "retrieveSecretFinish" o = Secret.Retrievable.RetrievableRetrieveSecretFinishMethodInfo
ResolveItemMethod "retrieveSecretSync" o = Secret.Retrievable.RetrievableRetrieveSecretSyncMethodInfo
ResolveItemMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveItemMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveItemMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveItemMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveItemMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveItemMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveItemMethod "getAttributes" o = ItemGetAttributesMethodInfo
ResolveItemMethod "getCachedProperty" o = Gio.DBusProxy.DBusProxyGetCachedPropertyMethodInfo
ResolveItemMethod "getCachedPropertyNames" o = Gio.DBusProxy.DBusProxyGetCachedPropertyNamesMethodInfo
ResolveItemMethod "getConnection" o = Gio.DBusProxy.DBusProxyGetConnectionMethodInfo
ResolveItemMethod "getCreated" o = ItemGetCreatedMethodInfo
ResolveItemMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveItemMethod "getDefaultTimeout" o = Gio.DBusProxy.DBusProxyGetDefaultTimeoutMethodInfo
ResolveItemMethod "getFlags" o = ItemGetFlagsMethodInfo
ResolveItemMethod "getInfo" o = Gio.DBusInterface.DBusInterfaceGetInfoMethodInfo
ResolveItemMethod "getInterfaceInfo" o = Gio.DBusProxy.DBusProxyGetInterfaceInfoMethodInfo
ResolveItemMethod "getInterfaceName" o = Gio.DBusProxy.DBusProxyGetInterfaceNameMethodInfo
ResolveItemMethod "getLabel" o = ItemGetLabelMethodInfo
ResolveItemMethod "getLocked" o = ItemGetLockedMethodInfo
ResolveItemMethod "getModified" o = ItemGetModifiedMethodInfo
ResolveItemMethod "getName" o = Gio.DBusProxy.DBusProxyGetNameMethodInfo
ResolveItemMethod "getNameOwner" o = Gio.DBusProxy.DBusProxyGetNameOwnerMethodInfo
ResolveItemMethod "getObject" o = Gio.DBusInterface.DBusInterfaceGetObjectMethodInfo
ResolveItemMethod "getObjectPath" o = Gio.DBusProxy.DBusProxyGetObjectPathMethodInfo
ResolveItemMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveItemMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveItemMethod "getSchemaName" o = ItemGetSchemaNameMethodInfo
ResolveItemMethod "getSecret" o = ItemGetSecretMethodInfo
ResolveItemMethod "getService" o = ItemGetServiceMethodInfo
ResolveItemMethod "setAttributes" o = ItemSetAttributesMethodInfo
ResolveItemMethod "setAttributesFinish" o = ItemSetAttributesFinishMethodInfo
ResolveItemMethod "setAttributesSync" o = ItemSetAttributesSyncMethodInfo
ResolveItemMethod "setCachedProperty" o = Gio.DBusProxy.DBusProxySetCachedPropertyMethodInfo
ResolveItemMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveItemMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveItemMethod "setDefaultTimeout" o = Gio.DBusProxy.DBusProxySetDefaultTimeoutMethodInfo
ResolveItemMethod "setInterfaceInfo" o = Gio.DBusProxy.DBusProxySetInterfaceInfoMethodInfo
ResolveItemMethod "setLabel" o = ItemSetLabelMethodInfo
ResolveItemMethod "setLabelFinish" o = ItemSetLabelFinishMethodInfo
ResolveItemMethod "setLabelSync" o = ItemSetLabelSyncMethodInfo
ResolveItemMethod "setObject" o = Gio.DBusInterface.DBusInterfaceSetObjectMethodInfo
ResolveItemMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveItemMethod "setSecret" o = ItemSetSecretMethodInfo
ResolveItemMethod "setSecretFinish" o = ItemSetSecretFinishMethodInfo
ResolveItemMethod "setSecretSync" o = ItemSetSecretSyncMethodInfo
ResolveItemMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveItemMethod t Item, O.OverloadedMethod info Item p) => OL.IsLabel t (Item -> p) where
#if MIN_VERSION_base(4,10,0)
fromLabel :: Item -> 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 ~ ResolveItemMethod t Item, O.OverloadedMethod info Item p, R.HasField t Item p) => R.HasField t Item p where
getField :: Item -> 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 ~ ResolveItemMethod t Item, O.OverloadedMethodInfo info Item) => OL.IsLabel t (O.MethodProxy info Item) where
#if MIN_VERSION_base(4,10,0)
fromLabel :: MethodProxy info Item
fromLabel = MethodProxy info Item
forall info obj. MethodProxy info obj
O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
getItemFlags :: (MonadIO m, IsItem o) => o -> m [Secret.Flags.ItemFlags]
getItemFlags :: forall (m :: * -> *) o. (MonadIO m, IsItem o) => o -> m [ItemFlags]
getItemFlags o
obj = IO [ItemFlags] -> m [ItemFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO [ItemFlags] -> m [ItemFlags])
-> IO [ItemFlags] -> m [ItemFlags]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [ItemFlags]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"flags"
constructItemFlags :: (IsItem o, MIO.MonadIO m) => [Secret.Flags.ItemFlags] -> m (GValueConstruct o)
constructItemFlags :: forall o (m :: * -> *).
(IsItem o, MonadIO m) =>
[ItemFlags] -> m (GValueConstruct o)
constructItemFlags [ItemFlags]
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 -> [ItemFlags] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"flags" [ItemFlags]
val
#if defined(ENABLE_OVERLOADING)
data ItemFlagsPropertyInfo
instance AttrInfo ItemFlagsPropertyInfo where
type AttrAllowedOps ItemFlagsPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint ItemFlagsPropertyInfo = IsItem
type AttrSetTypeConstraint ItemFlagsPropertyInfo = (~) [Secret.Flags.ItemFlags]
type AttrTransferTypeConstraint ItemFlagsPropertyInfo = (~) [Secret.Flags.ItemFlags]
type AttrTransferType ItemFlagsPropertyInfo = [Secret.Flags.ItemFlags]
type AttrGetType ItemFlagsPropertyInfo = [Secret.Flags.ItemFlags]
type AttrLabel ItemFlagsPropertyInfo = "flags"
type AttrOrigin ItemFlagsPropertyInfo = Item
attrGet :: forall o.
AttrBaseTypeConstraint ItemFlagsPropertyInfo o =>
o -> IO (AttrGetType ItemFlagsPropertyInfo)
attrGet = o -> IO [ItemFlags]
o -> IO (AttrGetType ItemFlagsPropertyInfo)
forall (m :: * -> *) o. (MonadIO m, IsItem o) => o -> m [ItemFlags]
getItemFlags
attrSet :: forall o b.
(AttrBaseTypeConstraint ItemFlagsPropertyInfo o,
AttrSetTypeConstraint ItemFlagsPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
attrTransfer :: forall o b.
(AttrBaseTypeConstraint ItemFlagsPropertyInfo o,
AttrTransferTypeConstraint ItemFlagsPropertyInfo b) =>
Proxy o -> b -> IO (AttrTransferType ItemFlagsPropertyInfo)
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 ItemFlagsPropertyInfo o,
AttrSetTypeConstraint ItemFlagsPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
[ItemFlags] -> IO (GValueConstruct o)
forall o (m :: * -> *).
(IsItem o, MonadIO m) =>
[ItemFlags] -> m (GValueConstruct o)
constructItemFlags
attrClear :: forall o.
AttrBaseTypeConstraint ItemFlagsPropertyInfo 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.Item.flags"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#g:attr:flags"
})
#endif
getItemLocked :: (MonadIO m, IsItem o) => o -> m Bool
getItemLocked :: forall (m :: * -> *) o. (MonadIO m, IsItem o) => o -> m Bool
getItemLocked 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 ItemLockedPropertyInfo
instance AttrInfo ItemLockedPropertyInfo where
type AttrAllowedOps ItemLockedPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint ItemLockedPropertyInfo = IsItem
type AttrSetTypeConstraint ItemLockedPropertyInfo = (~) ()
type AttrTransferTypeConstraint ItemLockedPropertyInfo = (~) ()
type AttrTransferType ItemLockedPropertyInfo = ()
type AttrGetType ItemLockedPropertyInfo = Bool
type AttrLabel ItemLockedPropertyInfo = "locked"
type AttrOrigin ItemLockedPropertyInfo = Item
attrGet :: forall o.
AttrBaseTypeConstraint ItemLockedPropertyInfo o =>
o -> IO (AttrGetType ItemLockedPropertyInfo)
attrGet = o -> IO Bool
o -> IO (AttrGetType ItemLockedPropertyInfo)
forall (m :: * -> *) o. (MonadIO m, IsItem o) => o -> m Bool
getItemLocked
attrSet :: forall o b.
(AttrBaseTypeConstraint ItemLockedPropertyInfo o,
AttrSetTypeConstraint ItemLockedPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
attrTransfer :: forall o b.
(AttrBaseTypeConstraint ItemLockedPropertyInfo o,
AttrTransferTypeConstraint ItemLockedPropertyInfo b) =>
Proxy o -> b -> IO (AttrTransferType ItemLockedPropertyInfo)
attrTransfer Proxy o
_ = b -> IO (AttrTransferType ItemLockedPropertyInfo)
() -> IO ()
forall a. HasCallStack => a
undefined
attrConstruct :: forall o b.
(AttrBaseTypeConstraint ItemLockedPropertyInfo o,
AttrSetTypeConstraint ItemLockedPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
forall a. HasCallStack => a
undefined
attrClear :: forall o.
AttrBaseTypeConstraint ItemLockedPropertyInfo 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.Item.locked"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#g:attr:locked"
})
#endif
getItemService :: (MonadIO m, IsItem o) => o -> m Secret.Service.Service
getItemService :: forall (m :: * -> *) o. (MonadIO m, IsItem o) => o -> m Service
getItemService 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
"getItemService" (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
constructItemService :: (IsItem o, MIO.MonadIO m, Secret.Service.IsService a) => a -> m (GValueConstruct o)
constructItemService :: forall o (m :: * -> *) a.
(IsItem o, MonadIO m, IsService a) =>
a -> m (GValueConstruct o)
constructItemService 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 ItemServicePropertyInfo
instance AttrInfo ItemServicePropertyInfo where
type AttrAllowedOps ItemServicePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint ItemServicePropertyInfo = IsItem
type AttrSetTypeConstraint ItemServicePropertyInfo = Secret.Service.IsService
type AttrTransferTypeConstraint ItemServicePropertyInfo = Secret.Service.IsService
type AttrTransferType ItemServicePropertyInfo = Secret.Service.Service
type AttrGetType ItemServicePropertyInfo = Secret.Service.Service
type AttrLabel ItemServicePropertyInfo = "service"
type AttrOrigin ItemServicePropertyInfo = Item
attrGet :: forall o.
AttrBaseTypeConstraint ItemServicePropertyInfo o =>
o -> IO (AttrGetType ItemServicePropertyInfo)
attrGet = o -> IO (AttrGetType ItemServicePropertyInfo)
o -> IO Service
forall (m :: * -> *) o. (MonadIO m, IsItem o) => o -> m Service
getItemService
attrSet :: forall o b.
(AttrBaseTypeConstraint ItemServicePropertyInfo o,
AttrSetTypeConstraint ItemServicePropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
attrTransfer :: forall o b.
(AttrBaseTypeConstraint ItemServicePropertyInfo o,
AttrTransferTypeConstraint ItemServicePropertyInfo b) =>
Proxy o -> b -> IO (AttrTransferType ItemServicePropertyInfo)
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 ItemServicePropertyInfo o,
AttrSetTypeConstraint ItemServicePropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
forall o (m :: * -> *) a.
(IsItem o, MonadIO m, IsService a) =>
a -> m (GValueConstruct o)
constructItemService
attrClear :: forall o.
AttrBaseTypeConstraint ItemServicePropertyInfo 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.Item.service"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#g:attr:service"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Item
type instance O.AttributeList Item = ItemAttributeList
type ItemAttributeList = ('[ '("attributes", Secret.Retrievable.RetrievableAttributesPropertyInfo), '("created", Secret.Retrievable.RetrievableCreatedPropertyInfo), '("flags", ItemFlagsPropertyInfo), '("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", Secret.Retrievable.RetrievableLabelPropertyInfo), '("locked", ItemLockedPropertyInfo), '("modified", Secret.Retrievable.RetrievableModifiedPropertyInfo), '("service", ItemServicePropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
itemFlags :: AttrLabelProxy "flags"
itemFlags :: AttrLabelProxy "flags"
itemFlags = AttrLabelProxy "flags"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
itemLocked :: AttrLabelProxy "locked"
itemLocked :: AttrLabelProxy "locked"
itemLocked = AttrLabelProxy "locked"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
itemService :: AttrLabelProxy "service"
itemService :: AttrLabelProxy "service"
itemService = AttrLabelProxy "service"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Item = ItemSignalList
type ItemSignalList = ('[ '("gPropertiesChanged", Gio.DBusProxy.DBusProxyGPropertiesChangedSignalInfo), '("gSignal", Gio.DBusProxy.DBusProxyGSignalSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "secret_item_delete" secret_item_delete ::
Ptr Item ->
Ptr Gio.Cancellable.Cancellable ->
FunPtr Gio.Callbacks.C_AsyncReadyCallback ->
Ptr () ->
IO ()
itemDelete ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a, Gio.Cancellable.IsCancellable b) =>
a
-> Maybe (b)
-> Maybe (Gio.Callbacks.AsyncReadyCallback)
-> m ()
itemDelete :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
itemDelete 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 Item)
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_item_delete self' maybeCancellable maybeCallback userData
touchManagedPtr self
whenJust cancellable touchManagedPtr
return ()
#if defined(ENABLE_OVERLOADING)
data ItemDeleteMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsItem a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ItemDeleteMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
itemDelete
instance O.OverloadedMethodInfo ItemDeleteMethodInfo 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.Item.itemDelete",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemDelete"
})
#endif
foreign import ccall "secret_item_delete_finish" secret_item_delete_finish ::
Ptr Item ->
Ptr Gio.AsyncResult.AsyncResult ->
Ptr (Ptr GError) ->
IO CInt
itemDeleteFinish ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a, Gio.AsyncResult.IsAsyncResult b) =>
a
-> b
-> m ()
itemDeleteFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsAsyncResult b) =>
a -> b -> m ()
itemDeleteFinish 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 Item)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result_' <- unsafeManagedPtrCastPtr result_
onException (do
_ <- propagateGError $ secret_item_delete_finish self' result_'
touchManagedPtr self
touchManagedPtr result_
return ()
) (do
return ()
)
#if defined(ENABLE_OVERLOADING)
data ItemDeleteFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsItem a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ItemDeleteFinishMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> b -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsAsyncResult b) =>
a -> b -> m ()
itemDeleteFinish
instance O.OverloadedMethodInfo ItemDeleteFinishMethodInfo 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.Item.itemDeleteFinish",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemDeleteFinish"
})
#endif
foreign import ccall "secret_item_delete_sync" secret_item_delete_sync ::
Ptr Item ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO CInt
itemDeleteSync ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a, Gio.Cancellable.IsCancellable b) =>
a
-> Maybe (b)
-> m ()
itemDeleteSync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsCancellable b) =>
a -> Maybe b -> m ()
itemDeleteSync 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 Item)
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_item_delete_sync self' maybeCancellable
touchManagedPtr self
whenJust cancellable touchManagedPtr
return ()
) (do
return ()
)
#if defined(ENABLE_OVERLOADING)
data ItemDeleteSyncMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsItem a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ItemDeleteSyncMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> Maybe b -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsCancellable b) =>
a -> Maybe b -> m ()
itemDeleteSync
instance O.OverloadedMethodInfo ItemDeleteSyncMethodInfo 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.Item.itemDeleteSync",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemDeleteSync"
})
#endif
foreign import ccall "secret_item_get_attributes" secret_item_get_attributes ::
Ptr Item ->
IO (Ptr (GHashTable CString CString))
itemGetAttributes ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a) =>
a
-> m (Map.Map T.Text T.Text)
itemGetAttributes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsItem a) =>
a -> m (Map Text Text)
itemGetAttributes a
self = IO (Map Text Text) -> m (Map Text Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map Text Text) -> m (Map Text Text))
-> IO (Map Text Text) -> m (Map Text Text)
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr Item)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- secret_item_get_attributes self'
checkUnexpectedReturnNULL "itemGetAttributes" result
result' <- unpackGHashTable result
let result'' = (PtrWrapped CString -> CString)
-> [(PtrWrapped CString, PtrWrapped CString)]
-> [(CString, PtrWrapped CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst PtrWrapped CString -> CString
B.GHT.cstringUnpackPtr [(PtrWrapped CString, PtrWrapped CString)]
result'
result''' <- mapFirstA cstringToText result''
let result'''' = (PtrWrapped CString -> CString)
-> [(Text, PtrWrapped CString)] -> [(Text, CString)]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond PtrWrapped CString -> CString
B.GHT.cstringUnpackPtr [(Text, PtrWrapped CString)]
result'''
result''''' <- mapSecondA cstringToText result''''
let result'''''' = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Text)]
result'''''
unrefGHashTable result
touchManagedPtr self
return result''''''
#if defined(ENABLE_OVERLOADING)
data ItemGetAttributesMethodInfo
instance (signature ~ (m (Map.Map T.Text T.Text)), MonadIO m, IsItem a) => O.OverloadedMethod ItemGetAttributesMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m (Map Text Text)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsItem a) =>
a -> m (Map Text Text)
itemGetAttributes
instance O.OverloadedMethodInfo ItemGetAttributesMethodInfo 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.Item.itemGetAttributes",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemGetAttributes"
})
#endif
foreign import ccall "secret_item_get_created" secret_item_get_created ::
Ptr Item ->
IO Word64
itemGetCreated ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a) =>
a
-> m Word64
itemGetCreated :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsItem a) =>
a -> m Word64
itemGetCreated 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 Item)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- secret_item_get_created self'
touchManagedPtr self
return result
#if defined(ENABLE_OVERLOADING)
data ItemGetCreatedMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsItem a) => O.OverloadedMethod ItemGetCreatedMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m Word64
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsItem a) =>
a -> m Word64
itemGetCreated
instance O.OverloadedMethodInfo ItemGetCreatedMethodInfo 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.Item.itemGetCreated",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemGetCreated"
})
#endif
foreign import ccall "secret_item_get_flags" secret_item_get_flags ::
Ptr Item ->
IO CUInt
itemGetFlags ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a) =>
a
-> m [Secret.Flags.ItemFlags]
itemGetFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsItem a) =>
a -> m [ItemFlags]
itemGetFlags a
self = IO [ItemFlags] -> m [ItemFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ItemFlags] -> m [ItemFlags])
-> IO [ItemFlags] -> m [ItemFlags]
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr Item)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- secret_item_get_flags self'
let result' = CUInt -> [ItemFlags]
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 ItemGetFlagsMethodInfo
instance (signature ~ (m [Secret.Flags.ItemFlags]), MonadIO m, IsItem a) => O.OverloadedMethod ItemGetFlagsMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m [ItemFlags]
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsItem a) =>
a -> m [ItemFlags]
itemGetFlags
instance O.OverloadedMethodInfo ItemGetFlagsMethodInfo 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.Item.itemGetFlags",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemGetFlags"
})
#endif
foreign import ccall "secret_item_get_label" secret_item_get_label ::
Ptr Item ->
IO CString
itemGetLabel ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a) =>
a
-> m T.Text
itemGetLabel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsItem a) =>
a -> m Text
itemGetLabel 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 Item)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- secret_item_get_label self'
checkUnexpectedReturnNULL "itemGetLabel" result
result' <- cstringToText result
freeMem result
touchManagedPtr self
return result'
#if defined(ENABLE_OVERLOADING)
data ItemGetLabelMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsItem a) => O.OverloadedMethod ItemGetLabelMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m Text
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsItem a) =>
a -> m Text
itemGetLabel
instance O.OverloadedMethodInfo ItemGetLabelMethodInfo 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.Item.itemGetLabel",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemGetLabel"
})
#endif
foreign import ccall "secret_item_get_locked" secret_item_get_locked ::
Ptr Item ->
IO CInt
itemGetLocked ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a) =>
a
-> m Bool
itemGetLocked :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsItem a) =>
a -> m Bool
itemGetLocked 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 Item)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- secret_item_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 ItemGetLockedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsItem a) => O.OverloadedMethod ItemGetLockedMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m Bool
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsItem a) =>
a -> m Bool
itemGetLocked
instance O.OverloadedMethodInfo ItemGetLockedMethodInfo 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.Item.itemGetLocked",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemGetLocked"
})
#endif
foreign import ccall "secret_item_get_modified" secret_item_get_modified ::
Ptr Item ->
IO Word64
itemGetModified ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a) =>
a
-> m Word64
itemGetModified :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsItem a) =>
a -> m Word64
itemGetModified 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 Item)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- secret_item_get_modified self'
touchManagedPtr self
return result
#if defined(ENABLE_OVERLOADING)
data ItemGetModifiedMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsItem a) => O.OverloadedMethod ItemGetModifiedMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m Word64
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsItem a) =>
a -> m Word64
itemGetModified
instance O.OverloadedMethodInfo ItemGetModifiedMethodInfo 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.Item.itemGetModified",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemGetModified"
})
#endif
foreign import ccall "secret_item_get_schema_name" secret_item_get_schema_name ::
Ptr Item ->
IO CString
itemGetSchemaName ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a) =>
a
-> m (Maybe T.Text)
itemGetSchemaName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsItem a) =>
a -> m (Maybe Text)
itemGetSchemaName a
self = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr Item)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- secret_item_get_schema_name self'
maybeResult <- convertIfNonNull result $ \CString
result' -> do
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
freeMem result'
return result''
touchManagedPtr self
return maybeResult
#if defined(ENABLE_OVERLOADING)
data ItemGetSchemaNameMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsItem a) => O.OverloadedMethod ItemGetSchemaNameMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m (Maybe Text)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsItem a) =>
a -> m (Maybe Text)
itemGetSchemaName
instance O.OverloadedMethodInfo ItemGetSchemaNameMethodInfo 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.Item.itemGetSchemaName",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemGetSchemaName"
})
#endif
foreign import ccall "secret_item_get_secret" secret_item_get_secret ::
Ptr Item ->
IO (Ptr Secret.Value.Value)
itemGetSecret ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a) =>
a
-> m (Maybe Secret.Value.Value)
itemGetSecret :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsItem a) =>
a -> m (Maybe Value)
itemGetSecret a
self = IO (Maybe Value) -> m (Maybe Value)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Value) -> m (Maybe Value))
-> IO (Maybe Value) -> m (Maybe Value)
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr Item)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- secret_item_get_secret self'
maybeResult <- convertIfNonNull result $ \Ptr Value
result' -> do
result'' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Value -> Value
Secret.Value.Value) Ptr Value
result'
return result''
touchManagedPtr self
return maybeResult
#if defined(ENABLE_OVERLOADING)
data ItemGetSecretMethodInfo
instance (signature ~ (m (Maybe Secret.Value.Value)), MonadIO m, IsItem a) => O.OverloadedMethod ItemGetSecretMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m (Maybe Value)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsItem a) =>
a -> m (Maybe Value)
itemGetSecret
instance O.OverloadedMethodInfo ItemGetSecretMethodInfo 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.Item.itemGetSecret",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemGetSecret"
})
#endif
foreign import ccall "secret_item_get_service" secret_item_get_service ::
Ptr Item ->
IO (Ptr Secret.Service.Service)
itemGetService ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a) =>
a
-> m Secret.Service.Service
itemGetService :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsItem a) =>
a -> m Service
itemGetService 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 Item)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- secret_item_get_service self'
checkUnexpectedReturnNULL "itemGetService" result
result' <- (newObject Secret.Service.Service) result
touchManagedPtr self
return result'
#if defined(ENABLE_OVERLOADING)
data ItemGetServiceMethodInfo
instance (signature ~ (m Secret.Service.Service), MonadIO m, IsItem a) => O.OverloadedMethod ItemGetServiceMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m Service
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsItem a) =>
a -> m Service
itemGetService
instance O.OverloadedMethodInfo ItemGetServiceMethodInfo 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.Item.itemGetService",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemGetService"
})
#endif
foreign import ccall "secret_item_load_secret" secret_item_load_secret ::
Ptr Item ->
Ptr Gio.Cancellable.Cancellable ->
FunPtr Gio.Callbacks.C_AsyncReadyCallback ->
Ptr () ->
IO ()
itemLoadSecret ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a, Gio.Cancellable.IsCancellable b) =>
a
-> Maybe (b)
-> Maybe (Gio.Callbacks.AsyncReadyCallback)
-> m ()
itemLoadSecret :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
itemLoadSecret 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 Item)
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_item_load_secret self' maybeCancellable maybeCallback userData
touchManagedPtr self
whenJust cancellable touchManagedPtr
return ()
#if defined(ENABLE_OVERLOADING)
data ItemLoadSecretMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsItem a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ItemLoadSecretMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
itemLoadSecret
instance O.OverloadedMethodInfo ItemLoadSecretMethodInfo 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.Item.itemLoadSecret",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemLoadSecret"
})
#endif
foreign import ccall "secret_item_load_secret_finish" secret_item_load_secret_finish ::
Ptr Item ->
Ptr Gio.AsyncResult.AsyncResult ->
Ptr (Ptr GError) ->
IO CInt
itemLoadSecretFinish ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a, Gio.AsyncResult.IsAsyncResult b) =>
a
-> b
-> m ()
itemLoadSecretFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsAsyncResult b) =>
a -> b -> m ()
itemLoadSecretFinish 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 Item)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result_' <- unsafeManagedPtrCastPtr result_
onException (do
_ <- propagateGError $ secret_item_load_secret_finish self' result_'
touchManagedPtr self
touchManagedPtr result_
return ()
) (do
return ()
)
#if defined(ENABLE_OVERLOADING)
data ItemLoadSecretFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsItem a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ItemLoadSecretFinishMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> b -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsAsyncResult b) =>
a -> b -> m ()
itemLoadSecretFinish
instance O.OverloadedMethodInfo ItemLoadSecretFinishMethodInfo 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.Item.itemLoadSecretFinish",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemLoadSecretFinish"
})
#endif
foreign import ccall "secret_item_load_secret_sync" secret_item_load_secret_sync ::
Ptr Item ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO CInt
itemLoadSecretSync ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a, Gio.Cancellable.IsCancellable b) =>
a
-> Maybe (b)
-> m ()
itemLoadSecretSync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsCancellable b) =>
a -> Maybe b -> m ()
itemLoadSecretSync 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 Item)
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_item_load_secret_sync self' maybeCancellable
touchManagedPtr self
whenJust cancellable touchManagedPtr
return ()
) (do
return ()
)
#if defined(ENABLE_OVERLOADING)
data ItemLoadSecretSyncMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsItem a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ItemLoadSecretSyncMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> Maybe b -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsCancellable b) =>
a -> Maybe b -> m ()
itemLoadSecretSync
instance O.OverloadedMethodInfo ItemLoadSecretSyncMethodInfo 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.Item.itemLoadSecretSync",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemLoadSecretSync"
})
#endif
foreign import ccall "secret_item_refresh" secret_item_refresh ::
Ptr Item ->
IO ()
itemRefresh ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a) =>
a
-> m ()
itemRefresh :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsItem a) =>
a -> m ()
itemRefresh 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 Item)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
secret_item_refresh self'
touchManagedPtr self
return ()
#if defined(ENABLE_OVERLOADING)
data ItemRefreshMethodInfo
instance (signature ~ (m ()), MonadIO m, IsItem a) => O.OverloadedMethod ItemRefreshMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsItem a) =>
a -> m ()
itemRefresh
instance O.OverloadedMethodInfo ItemRefreshMethodInfo 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.Item.itemRefresh",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemRefresh"
})
#endif
foreign import ccall "secret_item_set_attributes" secret_item_set_attributes ::
Ptr Item ->
Ptr Secret.Schema.Schema ->
Ptr (GHashTable CString CString) ->
Ptr Gio.Cancellable.Cancellable ->
FunPtr Gio.Callbacks.C_AsyncReadyCallback ->
Ptr () ->
IO ()
itemSetAttributes ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a, Gio.Cancellable.IsCancellable b) =>
a
-> Maybe (Secret.Schema.Schema)
-> Map.Map T.Text T.Text
-> Maybe (b)
-> Maybe (Gio.Callbacks.AsyncReadyCallback)
-> m ()
itemSetAttributes :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsCancellable b) =>
a
-> Maybe Schema
-> Map Text Text
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
itemSetAttributes a
self Maybe Schema
schema Map Text Text
attributes 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 Item)
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'''''
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_item_set_attributes self' maybeSchema attributes'''''' maybeCancellable maybeCallback userData
touchManagedPtr self
whenJust schema touchManagedPtr
whenJust cancellable touchManagedPtr
unrefGHashTable attributes''''''
return ()
#if defined(ENABLE_OVERLOADING)
data ItemSetAttributesMethodInfo
instance (signature ~ (Maybe (Secret.Schema.Schema) -> Map.Map T.Text T.Text -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsItem a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ItemSetAttributesMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a
-> Maybe Schema
-> Map Text Text
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsCancellable b) =>
a
-> Maybe Schema
-> Map Text Text
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
itemSetAttributes
instance O.OverloadedMethodInfo ItemSetAttributesMethodInfo 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.Item.itemSetAttributes",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemSetAttributes"
})
#endif
foreign import ccall "secret_item_set_attributes_finish" secret_item_set_attributes_finish ::
Ptr Item ->
Ptr Gio.AsyncResult.AsyncResult ->
Ptr (Ptr GError) ->
IO CInt
itemSetAttributesFinish ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a, Gio.AsyncResult.IsAsyncResult b) =>
a
-> b
-> m ()
itemSetAttributesFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsAsyncResult b) =>
a -> b -> m ()
itemSetAttributesFinish 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 Item)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result_' <- unsafeManagedPtrCastPtr result_
onException (do
_ <- propagateGError $ secret_item_set_attributes_finish self' result_'
touchManagedPtr self
touchManagedPtr result_
return ()
) (do
return ()
)
#if defined(ENABLE_OVERLOADING)
data ItemSetAttributesFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsItem a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ItemSetAttributesFinishMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> b -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsAsyncResult b) =>
a -> b -> m ()
itemSetAttributesFinish
instance O.OverloadedMethodInfo ItemSetAttributesFinishMethodInfo 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.Item.itemSetAttributesFinish",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemSetAttributesFinish"
})
#endif
foreign import ccall "secret_item_set_attributes_sync" secret_item_set_attributes_sync ::
Ptr Item ->
Ptr Secret.Schema.Schema ->
Ptr (GHashTable CString CString) ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO CInt
itemSetAttributesSync ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a, Gio.Cancellable.IsCancellable b) =>
a
-> Maybe (Secret.Schema.Schema)
-> Map.Map T.Text T.Text
-> Maybe (b)
-> m ()
itemSetAttributesSync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsCancellable b) =>
a -> Maybe Schema -> Map Text Text -> Maybe b -> m ()
itemSetAttributesSync a
self Maybe Schema
schema Map Text Text
attributes 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 Item)
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'''''
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_item_set_attributes_sync self' maybeSchema attributes'''''' maybeCancellable
touchManagedPtr self
whenJust schema touchManagedPtr
whenJust cancellable touchManagedPtr
unrefGHashTable attributes''''''
return ()
) (do
unrefGHashTable attributes''''''
)
#if defined(ENABLE_OVERLOADING)
data ItemSetAttributesSyncMethodInfo
instance (signature ~ (Maybe (Secret.Schema.Schema) -> Map.Map T.Text T.Text -> Maybe (b) -> m ()), MonadIO m, IsItem a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ItemSetAttributesSyncMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> Maybe Schema -> Map Text Text -> Maybe b -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsCancellable b) =>
a -> Maybe Schema -> Map Text Text -> Maybe b -> m ()
itemSetAttributesSync
instance O.OverloadedMethodInfo ItemSetAttributesSyncMethodInfo 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.Item.itemSetAttributesSync",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemSetAttributesSync"
})
#endif
foreign import ccall "secret_item_set_label" secret_item_set_label ::
Ptr Item ->
CString ->
Ptr Gio.Cancellable.Cancellable ->
FunPtr Gio.Callbacks.C_AsyncReadyCallback ->
Ptr () ->
IO ()
itemSetLabel ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a, Gio.Cancellable.IsCancellable b) =>
a
-> T.Text
-> Maybe (b)
-> Maybe (Gio.Callbacks.AsyncReadyCallback)
-> m ()
itemSetLabel :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsCancellable b) =>
a -> Text -> Maybe b -> Maybe AsyncReadyCallback -> m ()
itemSetLabel 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 Item)
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_item_set_label self' label' maybeCancellable maybeCallback userData
touchManagedPtr self
whenJust cancellable touchManagedPtr
freeMem label'
return ()
#if defined(ENABLE_OVERLOADING)
data ItemSetLabelMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsItem a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ItemSetLabelMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> Text -> Maybe b -> Maybe AsyncReadyCallback -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsCancellable b) =>
a -> Text -> Maybe b -> Maybe AsyncReadyCallback -> m ()
itemSetLabel
instance O.OverloadedMethodInfo ItemSetLabelMethodInfo 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.Item.itemSetLabel",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemSetLabel"
})
#endif
foreign import ccall "secret_item_set_label_finish" secret_item_set_label_finish ::
Ptr Item ->
Ptr Gio.AsyncResult.AsyncResult ->
Ptr (Ptr GError) ->
IO CInt
itemSetLabelFinish ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a, Gio.AsyncResult.IsAsyncResult b) =>
a
-> b
-> m ()
itemSetLabelFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsAsyncResult b) =>
a -> b -> m ()
itemSetLabelFinish 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 Item)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result_' <- unsafeManagedPtrCastPtr result_
onException (do
_ <- propagateGError $ secret_item_set_label_finish self' result_'
touchManagedPtr self
touchManagedPtr result_
return ()
) (do
return ()
)
#if defined(ENABLE_OVERLOADING)
data ItemSetLabelFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsItem a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ItemSetLabelFinishMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> b -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsAsyncResult b) =>
a -> b -> m ()
itemSetLabelFinish
instance O.OverloadedMethodInfo ItemSetLabelFinishMethodInfo 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.Item.itemSetLabelFinish",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemSetLabelFinish"
})
#endif
foreign import ccall "secret_item_set_label_sync" secret_item_set_label_sync ::
Ptr Item ->
CString ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO CInt
itemSetLabelSync ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a, Gio.Cancellable.IsCancellable b) =>
a
-> T.Text
-> Maybe (b)
-> m ()
itemSetLabelSync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsCancellable b) =>
a -> Text -> Maybe b -> m ()
itemSetLabelSync 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 Item)
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_item_set_label_sync self' label' maybeCancellable
touchManagedPtr self
whenJust cancellable touchManagedPtr
freeMem label'
return ()
) (do
freeMem label'
)
#if defined(ENABLE_OVERLOADING)
data ItemSetLabelSyncMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> m ()), MonadIO m, IsItem a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ItemSetLabelSyncMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> Text -> Maybe b -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsCancellable b) =>
a -> Text -> Maybe b -> m ()
itemSetLabelSync
instance O.OverloadedMethodInfo ItemSetLabelSyncMethodInfo 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.Item.itemSetLabelSync",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemSetLabelSync"
})
#endif
foreign import ccall "secret_item_set_secret" secret_item_set_secret ::
Ptr Item ->
Ptr Secret.Value.Value ->
Ptr Gio.Cancellable.Cancellable ->
FunPtr Gio.Callbacks.C_AsyncReadyCallback ->
Ptr () ->
IO ()
itemSetSecret ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a, Gio.Cancellable.IsCancellable b) =>
a
-> Secret.Value.Value
-> Maybe (b)
-> Maybe (Gio.Callbacks.AsyncReadyCallback)
-> m ()
itemSetSecret :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsCancellable b) =>
a -> Value -> Maybe b -> Maybe AsyncReadyCallback -> m ()
itemSetSecret a
self Value
value 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 Item)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
value' <- unsafeManagedPtrGetPtr value
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_item_set_secret self' value' maybeCancellable maybeCallback userData
touchManagedPtr self
touchManagedPtr value
whenJust cancellable touchManagedPtr
return ()
#if defined(ENABLE_OVERLOADING)
data ItemSetSecretMethodInfo
instance (signature ~ (Secret.Value.Value -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsItem a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ItemSetSecretMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> Value -> Maybe b -> Maybe AsyncReadyCallback -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsCancellable b) =>
a -> Value -> Maybe b -> Maybe AsyncReadyCallback -> m ()
itemSetSecret
instance O.OverloadedMethodInfo ItemSetSecretMethodInfo 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.Item.itemSetSecret",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemSetSecret"
})
#endif
foreign import ccall "secret_item_set_secret_finish" secret_item_set_secret_finish ::
Ptr Item ->
Ptr Gio.AsyncResult.AsyncResult ->
Ptr (Ptr GError) ->
IO CInt
itemSetSecretFinish ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a, Gio.AsyncResult.IsAsyncResult b) =>
a
-> b
-> m ()
itemSetSecretFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsAsyncResult b) =>
a -> b -> m ()
itemSetSecretFinish 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 Item)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result_' <- unsafeManagedPtrCastPtr result_
onException (do
_ <- propagateGError $ secret_item_set_secret_finish self' result_'
touchManagedPtr self
touchManagedPtr result_
return ()
) (do
return ()
)
#if defined(ENABLE_OVERLOADING)
data ItemSetSecretFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsItem a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ItemSetSecretFinishMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> b -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsAsyncResult b) =>
a -> b -> m ()
itemSetSecretFinish
instance O.OverloadedMethodInfo ItemSetSecretFinishMethodInfo 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.Item.itemSetSecretFinish",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemSetSecretFinish"
})
#endif
foreign import ccall "secret_item_set_secret_sync" secret_item_set_secret_sync ::
Ptr Item ->
Ptr Secret.Value.Value ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO CInt
itemSetSecretSync ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a, Gio.Cancellable.IsCancellable b) =>
a
-> Secret.Value.Value
-> Maybe (b)
-> m ()
itemSetSecretSync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsCancellable b) =>
a -> Value -> Maybe b -> m ()
itemSetSecretSync a
self Value
value 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 Item)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
value' <- unsafeManagedPtrGetPtr value
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_item_set_secret_sync self' value' maybeCancellable
touchManagedPtr self
touchManagedPtr value
whenJust cancellable touchManagedPtr
return ()
) (do
return ()
)
#if defined(ENABLE_OVERLOADING)
data ItemSetSecretSyncMethodInfo
instance (signature ~ (Secret.Value.Value -> Maybe (b) -> m ()), MonadIO m, IsItem a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ItemSetSecretSyncMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> Value -> Maybe b -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsCancellable b) =>
a -> Value -> Maybe b -> m ()
itemSetSecretSync
instance O.OverloadedMethodInfo ItemSetSecretSyncMethodInfo 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.Item.itemSetSecretSync",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Objects-Item.html#v:itemSetSecretSync"
})
#endif
foreign import ccall "secret_item_create" secret_item_create ::
Ptr Secret.Collection.Collection ->
Ptr Secret.Schema.Schema ->
Ptr (GHashTable CString CString) ->
CString ->
Ptr Secret.Value.Value ->
CUInt ->
Ptr Gio.Cancellable.Cancellable ->
FunPtr Gio.Callbacks.C_AsyncReadyCallback ->
Ptr () ->
IO ()
itemCreate ::
(B.CallStack.HasCallStack, MonadIO m, Secret.Collection.IsCollection a, Gio.Cancellable.IsCancellable b) =>
a
-> Maybe (Secret.Schema.Schema)
-> Map.Map T.Text T.Text
-> T.Text
-> Secret.Value.Value
-> [Secret.Flags.ItemCreateFlags]
-> Maybe (b)
-> Maybe (Gio.Callbacks.AsyncReadyCallback)
-> m ()
itemCreate :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsCancellable b) =>
a
-> Maybe Schema
-> Map Text Text
-> Text
-> Value
-> [ItemCreateFlags]
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
itemCreate a
collection Maybe Schema
schema Map Text Text
attributes Text
label Value
value [ItemCreateFlags]
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
collection' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
collection
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'''''
label' <- textToCString label
value' <- unsafeManagedPtrGetPtr value
let flags' = [ItemCreateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ItemCreateFlags]
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_item_create collection' maybeSchema attributes'''''' label' value' flags' maybeCancellable maybeCallback userData
touchManagedPtr collection
whenJust schema touchManagedPtr
touchManagedPtr value
whenJust cancellable touchManagedPtr
unrefGHashTable attributes''''''
freeMem label'
return ()
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "secret_item_create_finish" secret_item_create_finish ::
Ptr Gio.AsyncResult.AsyncResult ->
Ptr (Ptr GError) ->
IO (Ptr Item)
itemCreateFinish ::
(B.CallStack.HasCallStack, MonadIO m, Gio.AsyncResult.IsAsyncResult a) =>
a
-> m Item
itemCreateFinish :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsyncResult a) =>
a -> m Item
itemCreateFinish a
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
result_' <- a -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
result_
onException (do
result <- propagateGError $ secret_item_create_finish result_'
checkUnexpectedReturnNULL "itemCreateFinish" result
result' <- (wrapObject Item) result
touchManagedPtr result_
return result'
) (do
return ()
)
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "secret_item_create_sync" secret_item_create_sync ::
Ptr Secret.Collection.Collection ->
Ptr Secret.Schema.Schema ->
Ptr (GHashTable CString CString) ->
CString ->
Ptr Secret.Value.Value ->
CUInt ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO (Ptr Item)
itemCreateSync ::
(B.CallStack.HasCallStack, MonadIO m, Secret.Collection.IsCollection a, Gio.Cancellable.IsCancellable b) =>
a
-> Maybe (Secret.Schema.Schema)
-> Map.Map T.Text T.Text
-> T.Text
-> Secret.Value.Value
-> [Secret.Flags.ItemCreateFlags]
-> Maybe (b)
-> m Item
itemCreateSync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCollection a, IsCancellable b) =>
a
-> Maybe Schema
-> Map Text Text
-> Text
-> Value
-> [ItemCreateFlags]
-> Maybe b
-> m Item
itemCreateSync a
collection Maybe Schema
schema Map Text Text
attributes Text
label Value
value [ItemCreateFlags]
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
collection' <- a -> IO (Ptr Collection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
collection
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'''''
label' <- textToCString label
value' <- unsafeManagedPtrGetPtr value
let flags' = [ItemCreateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ItemCreateFlags]
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_item_create_sync collection' maybeSchema attributes'''''' label' value' flags' maybeCancellable
checkUnexpectedReturnNULL "itemCreateSync" result
result' <- (wrapObject Item) result
touchManagedPtr collection
whenJust schema touchManagedPtr
touchManagedPtr value
whenJust cancellable touchManagedPtr
unrefGHashTable attributes''''''
freeMem label'
return result'
) (do
unrefGHashTable attributes''''''
freeMem label'
)
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "secret_item_load_secrets" secret_item_load_secrets ::
Ptr (GList (Ptr Item)) ->
Ptr Gio.Cancellable.Cancellable ->
FunPtr Gio.Callbacks.C_AsyncReadyCallback ->
Ptr () ->
IO ()
itemLoadSecrets ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a, Gio.Cancellable.IsCancellable b) =>
[a]
-> Maybe (b)
-> Maybe (Gio.Callbacks.AsyncReadyCallback)
-> m ()
itemLoadSecrets :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsCancellable b) =>
[a] -> Maybe b -> Maybe AsyncReadyCallback -> m ()
itemLoadSecrets [a]
items 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
items' <- (a -> IO (Ptr Item)) -> [a] -> IO [Ptr Item]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> IO (Ptr Item)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [a]
items
items'' <- packGList items'
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_item_load_secrets items'' maybeCancellable maybeCallback userData
mapM_ touchManagedPtr items
whenJust cancellable touchManagedPtr
g_list_free items''
return ()
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "secret_item_load_secrets_finish" secret_item_load_secrets_finish ::
Ptr Gio.AsyncResult.AsyncResult ->
Ptr (Ptr GError) ->
IO CInt
itemLoadSecretsFinish ::
(B.CallStack.HasCallStack, MonadIO m, Gio.AsyncResult.IsAsyncResult a) =>
a
-> m ()
itemLoadSecretsFinish :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsyncResult a) =>
a -> m ()
itemLoadSecretsFinish a
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
result_' <- a -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
result_
onException (do
_ <- propagateGError $ secret_item_load_secrets_finish result_'
touchManagedPtr result_
return ()
) (do
return ()
)
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "secret_item_load_secrets_sync" secret_item_load_secrets_sync ::
Ptr (GList (Ptr Item)) ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO CInt
itemLoadSecretsSync ::
(B.CallStack.HasCallStack, MonadIO m, IsItem a, Gio.Cancellable.IsCancellable b) =>
[a]
-> Maybe (b)
-> m ()
itemLoadSecretsSync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsItem a, IsCancellable b) =>
[a] -> Maybe b -> m ()
itemLoadSecretsSync [a]
items 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
items' <- (a -> IO (Ptr Item)) -> [a] -> IO [Ptr Item]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> IO (Ptr Item)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [a]
items
items'' <- packGList items'
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_item_load_secrets_sync items'' maybeCancellable
mapM_ touchManagedPtr items
whenJust cancellable touchManagedPtr
g_list_free items''
return ()
) (do
g_list_free items''
)
#if defined(ENABLE_OVERLOADING)
#endif