{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Represents a set of attributes that are stored with an item.
-- 
-- These schemas are used for interoperability between various services storing
-- the same types of items.
-- 
-- Each schema has a name like @org.gnome.keyring.NetworkPassword@, and defines a
-- set of attributes, and types (string, integer, boolean) for those attributes.
-- 
-- Attributes are stored as strings in the Secret Service, and the attribute types
-- simply define standard ways to store integer and boolean values as strings.
-- Attributes are represented in libsecret via a t'GHashTable' with
-- string keys and values. Even for values that defined as an integer or boolean in
-- the schema, the attribute values in the t'GHashTable' are strings.
-- Boolean values are stored as the strings \'true\' and \'false\'. Integer values are
-- stored in decimal, with a preceding negative sign for negative integers.
-- 
-- Schemas are handled entirely on the client side by this library. The name of the
-- schema is automatically stored as an attribute on the item.
-- 
-- Normally when looking up passwords only those with matching schema names are
-- returned. If the schema /@flags@/ contain the @SECRET_SCHEMA_DONT_MATCH_NAME@ flag,
-- then lookups will not check that the schema name matches that on the item, only
-- the schema\'s attributes are matched. This is useful when you are looking up
-- items that are not stored by the libsecret library. Other libraries such as
-- libgnome-keyring don\'t store the schema name.
-- 
-- Additional schemas can be defined via the [struct/@schema@/] structure like this:
-- 
-- 
-- === /c code/
-- >// in a header:
-- >
-- >const SecretSchema * example_get_schema (void) G_GNUC_CONST;
-- >
-- >#define EXAMPLE_SCHEMA  example_get_schema ()
-- >
-- >
-- >// in a .c file
-- >
-- >const SecretSchema *
-- >example_get_schema (void)
-- >{
-- >    static const SecretSchema the_schema = {
-- >        "org.example.Password", SECRET_SCHEMA_NONE,
-- >        {
-- >            {  "number", SECRET_SCHEMA_ATTRIBUTE_INTEGER },
-- >            {  "string", SECRET_SCHEMA_ATTRIBUTE_STRING },
-- >            {  "even", SECRET_SCHEMA_ATTRIBUTE_BOOLEAN },
-- >            {  NULL, 0 },
-- >        }
-- >    };
-- >    return &the_schema;
-- >}
-- 

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

module GI.Secret.Structs.Schema
    ( 

-- * Exported types
    Schema(..)                              ,
    newZeroSchema                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [ref]("GI.Secret.Structs.Schema#g:method:ref"), [unref]("GI.Secret.Structs.Schema#g:method:unref").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveSchemaMethod                     ,
#endif

-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    SchemaRefMethodInfo                     ,
#endif
    schemaRef                               ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    SchemaUnrefMethodInfo                   ,
#endif
    schemaUnref                             ,




 -- * Properties


-- ** flags #attr:flags#
-- | flags for the schema

    getSchemaFlags                          ,
#if defined(ENABLE_OVERLOADING)
    schema_flags                            ,
#endif
    setSchemaFlags                          ,


-- ** name #attr:name#
-- | the dotted name of the schema

    clearSchemaName                         ,
    getSchemaName                           ,
#if defined(ENABLE_OVERLOADING)
    schema_name                             ,
#endif
    setSchemaName                           ,




    ) where

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

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

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import {-# SOURCE #-} qualified GI.Secret.Flags as Secret.Flags

#else
import {-# SOURCE #-} qualified GI.Secret.Flags as Secret.Flags

#endif

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

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

foreign import ccall "secret_schema_get_type" c_secret_schema_get_type :: 
    IO GType

type instance O.ParentTypes Schema = '[]
instance O.HasParentTypes Schema

instance B.Types.TypedObject Schema where
    glibType :: IO GType
glibType = IO GType
c_secret_schema_get_type

instance B.Types.GBoxed Schema

-- | Convert t'Schema' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Schema) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_secret_schema_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Schema -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Schema
P.Nothing = Ptr GValue -> Ptr Schema -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr Schema
forall a. Ptr a
FP.nullPtr :: FP.Ptr Schema)
    gvalueSet_ Ptr GValue
gv (P.Just Schema
obj) = Schema -> (Ptr Schema -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Schema
obj (Ptr GValue -> Ptr Schema -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Schema)
gvalueGet_ Ptr GValue
gv = do
        ptr <- Ptr GValue -> IO (Ptr Schema)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr Schema)
        if ptr /= FP.nullPtr
        then P.Just <$> B.ManagedPtr.newBoxed Schema ptr
        else return P.Nothing
        
    

-- | Construct a t'Schema' struct initialized to zero.
newZeroSchema :: MonadIO m => m Schema
newZeroSchema :: forall (m :: * -> *). MonadIO m => m Schema
newZeroSchema = IO Schema -> m Schema
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Schema -> m Schema) -> IO Schema -> m Schema
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr Schema)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
592 IO (Ptr Schema) -> (Ptr Schema -> IO Schema) -> IO Schema
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Schema -> Schema) -> Ptr Schema -> IO Schema
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Schema -> Schema
Schema

instance tag ~ 'AttrSet => Constructible Schema tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr Schema -> Schema) -> [AttrOp Schema tag] -> m Schema
new ManagedPtr Schema -> Schema
_ [AttrOp Schema tag]
attrs = do
        o <- m Schema
forall (m :: * -> *). MonadIO m => m Schema
newZeroSchema
        GI.Attributes.set o attrs
        return o


-- | Get the value of the “@name@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' schema #name
-- @
getSchemaName :: MonadIO m => Schema -> m (Maybe T.Text)
getSchemaName :: forall (m :: * -> *). MonadIO m => Schema -> m (Maybe Text)
getSchemaName Schema
s = 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
$ Schema -> (Ptr Schema -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Schema
s ((Ptr Schema -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr Schema -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr Schema
ptr -> do
    val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr Schema
ptr Ptr Schema -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO CString
    result <- SP.convertIfNonNull val $ \CString
val' -> do
        val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        return val''
    return result

-- | Set the value of the “@name@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' schema [ #name 'Data.GI.Base.Attributes.:=' value ]
-- @
setSchemaName :: MonadIO m => Schema -> CString -> m ()
setSchemaName :: forall (m :: * -> *). MonadIO m => Schema -> CString -> m ()
setSchemaName Schema
s CString
val = 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
$ Schema -> (Ptr Schema -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Schema
s ((Ptr Schema -> IO ()) -> IO ()) -> (Ptr Schema -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Schema
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Schema
ptr Ptr Schema -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CString
val :: CString)

-- | Set the value of the “@name@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #name
-- @
clearSchemaName :: MonadIO m => Schema -> m ()
clearSchemaName :: forall (m :: * -> *). MonadIO m => Schema -> m ()
clearSchemaName Schema
s = 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
$ Schema -> (Ptr Schema -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Schema
s ((Ptr Schema -> IO ()) -> IO ()) -> (Ptr Schema -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Schema
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Schema
ptr Ptr Schema -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data SchemaNameFieldInfo
instance AttrInfo SchemaNameFieldInfo where
    type AttrBaseTypeConstraint SchemaNameFieldInfo = (~) Schema
    type AttrAllowedOps SchemaNameFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint SchemaNameFieldInfo = (~) CString
    type AttrTransferTypeConstraint SchemaNameFieldInfo = (~)CString
    type AttrTransferType SchemaNameFieldInfo = CString
    type AttrGetType SchemaNameFieldInfo = Maybe T.Text
    type AttrLabel SchemaNameFieldInfo = "name"
    type AttrOrigin SchemaNameFieldInfo = Schema
    attrGet :: forall o.
AttrBaseTypeConstraint SchemaNameFieldInfo o =>
o -> IO (AttrGetType SchemaNameFieldInfo)
attrGet = o -> IO (AttrGetType SchemaNameFieldInfo)
Schema -> IO (Maybe Text)
forall (m :: * -> *). MonadIO m => Schema -> m (Maybe Text)
getSchemaName
    attrSet :: forall o b.
(AttrBaseTypeConstraint SchemaNameFieldInfo o,
 AttrSetTypeConstraint SchemaNameFieldInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
Schema -> CString -> IO ()
forall (m :: * -> *). MonadIO m => Schema -> CString -> m ()
setSchemaName
    attrConstruct :: forall o b.
(AttrBaseTypeConstraint SchemaNameFieldInfo o,
 AttrSetTypeConstraint SchemaNameFieldInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
forall a. HasCallStack => a
undefined
    attrClear :: forall o.
AttrBaseTypeConstraint SchemaNameFieldInfo o =>
o -> IO ()
attrClear = o -> IO ()
Schema -> IO ()
forall (m :: * -> *). MonadIO m => Schema -> m ()
clearSchemaName
    attrTransfer :: forall o b.
(AttrBaseTypeConstraint SchemaNameFieldInfo o,
 AttrTransferTypeConstraint SchemaNameFieldInfo b) =>
Proxy o -> b -> IO (AttrTransferType SchemaNameFieldInfo)
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
    dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Structs.Schema.name"
        , resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Structs-Schema.html#g:attr:name"
        })

schema_name :: AttrLabelProxy "name"
schema_name :: AttrLabelProxy "name"
schema_name = AttrLabelProxy "name"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy

#endif


-- | Get the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' schema #flags
-- @
getSchemaFlags :: MonadIO m => Schema -> m [Secret.Flags.SchemaFlags]
getSchemaFlags :: forall (m :: * -> *). MonadIO m => Schema -> m [SchemaFlags]
getSchemaFlags Schema
s = IO [SchemaFlags] -> m [SchemaFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SchemaFlags] -> m [SchemaFlags])
-> IO [SchemaFlags] -> m [SchemaFlags]
forall a b. (a -> b) -> a -> b
$ Schema -> (Ptr Schema -> IO [SchemaFlags]) -> IO [SchemaFlags]
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Schema
s ((Ptr Schema -> IO [SchemaFlags]) -> IO [SchemaFlags])
-> (Ptr Schema -> IO [SchemaFlags]) -> IO [SchemaFlags]
forall a b. (a -> b) -> a -> b
$ \Ptr Schema
ptr -> do
    val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr Schema
ptr Ptr Schema -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO CUInt
    let val' = CUInt -> [SchemaFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
val
    return val'

-- | Set the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' schema [ #flags 'Data.GI.Base.Attributes.:=' value ]
-- @
setSchemaFlags :: MonadIO m => Schema -> [Secret.Flags.SchemaFlags] -> m ()
setSchemaFlags :: forall (m :: * -> *). MonadIO m => Schema -> [SchemaFlags] -> m ()
setSchemaFlags Schema
s [SchemaFlags]
val = 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
$ Schema -> (Ptr Schema -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Schema
s ((Ptr Schema -> IO ()) -> IO ()) -> (Ptr Schema -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Schema
ptr -> do
    let val' :: CUInt
val' = [SchemaFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SchemaFlags]
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Schema
ptr Ptr Schema -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data SchemaFlagsFieldInfo
instance AttrInfo SchemaFlagsFieldInfo where
    type AttrBaseTypeConstraint SchemaFlagsFieldInfo = (~) Schema
    type AttrAllowedOps SchemaFlagsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint SchemaFlagsFieldInfo = (~) [Secret.Flags.SchemaFlags]
    type AttrTransferTypeConstraint SchemaFlagsFieldInfo = (~)[Secret.Flags.SchemaFlags]
    type AttrTransferType SchemaFlagsFieldInfo = [Secret.Flags.SchemaFlags]
    type AttrGetType SchemaFlagsFieldInfo = [Secret.Flags.SchemaFlags]
    type AttrLabel SchemaFlagsFieldInfo = "flags"
    type AttrOrigin SchemaFlagsFieldInfo = Schema
    attrGet :: forall o.
AttrBaseTypeConstraint SchemaFlagsFieldInfo o =>
o -> IO (AttrGetType SchemaFlagsFieldInfo)
attrGet = o -> IO (AttrGetType SchemaFlagsFieldInfo)
Schema -> IO [SchemaFlags]
forall (m :: * -> *). MonadIO m => Schema -> m [SchemaFlags]
getSchemaFlags
    attrSet :: forall o b.
(AttrBaseTypeConstraint SchemaFlagsFieldInfo o,
 AttrSetTypeConstraint SchemaFlagsFieldInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
Schema -> [SchemaFlags] -> IO ()
forall (m :: * -> *). MonadIO m => Schema -> [SchemaFlags] -> m ()
setSchemaFlags
    attrConstruct :: forall o b.
(AttrBaseTypeConstraint SchemaFlagsFieldInfo o,
 AttrSetTypeConstraint SchemaFlagsFieldInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
forall a. HasCallStack => a
undefined
    attrClear :: forall o.
AttrBaseTypeConstraint SchemaFlagsFieldInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
    attrTransfer :: forall o b.
(AttrBaseTypeConstraint SchemaFlagsFieldInfo o,
 AttrTransferTypeConstraint SchemaFlagsFieldInfo b) =>
Proxy o -> b -> IO (AttrTransferType SchemaFlagsFieldInfo)
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
    dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Structs.Schema.flags"
        , resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Structs-Schema.html#g:attr:flags"
        })

schema_flags :: AttrLabelProxy "flags"
schema_flags :: AttrLabelProxy "flags"
schema_flags = AttrLabelProxy "flags"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy

#endif


-- XXX Skipped attribute for "Schema:attributes"
-- Not implemented: Don't know how to unpack C array of type TCArray False 32 (-1) (TInterface (Name {namespace = "Secret", name = "SchemaAttribute"}))

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Schema
type instance O.AttributeList Schema = SchemaAttributeList
type SchemaAttributeList = ('[ '("name", SchemaNameFieldInfo), '("flags", SchemaFlagsFieldInfo)] :: [(Symbol, DK.Type)])
#endif

-- XXX Could not generate method Schema::new
-- Not implemented: GHashTable element of type TInterface (Name {namespace = "Secret", name = "SchemaAttributeType"}) unsupported.
-- method Schema::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "schema"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Schema" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the schema to reference"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Secret" , name = "Schema" })
-- throws : False
-- Skip return : False

foreign import ccall "secret_schema_ref" secret_schema_ref :: 
    Ptr Schema ->                           -- schema : TInterface (Name {namespace = "Secret", name = "Schema"})
    IO (Ptr Schema)

-- | Adds a reference to the t'GI.Secret.Structs.Schema.Schema'.
-- 
-- It is not normally necessary to call this function from C code, and is
-- mainly present for the sake of bindings. If the /@schema@/ was statically
-- allocated, then this function will copy the schema.
schemaRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Schema
    -- ^ /@schema@/: the schema to reference
    -> m Schema
    -- ^ __Returns:__ the referenced schema, which should be later
    --   unreferenced with [method/@schema@/.unref]
schemaRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Schema -> m Schema
schemaRef Schema
schema = IO Schema -> m Schema
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Schema -> m Schema) -> IO Schema -> m Schema
forall a b. (a -> b) -> a -> b
$ do
    schema' <- Schema -> IO (Ptr Schema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Schema
schema
    result <- secret_schema_ref schema'
    checkUnexpectedReturnNULL "schemaRef" result
    result' <- (wrapBoxed Schema) result
    touchManagedPtr schema
    return result'

#if defined(ENABLE_OVERLOADING)
data SchemaRefMethodInfo
instance (signature ~ (m Schema), MonadIO m) => O.OverloadedMethod SchemaRefMethodInfo Schema signature where
    overloadedMethod :: Schema -> signature
overloadedMethod = Schema -> signature
Schema -> m Schema
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Schema -> m Schema
schemaRef

instance O.OverloadedMethodInfo SchemaRefMethodInfo Schema where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Structs.Schema.schemaRef",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Structs-Schema.html#v:schemaRef"
        })


#endif

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

foreign import ccall "secret_schema_unref" secret_schema_unref :: 
    Ptr Schema ->                           -- schema : TInterface (Name {namespace = "Secret", name = "Schema"})
    IO ()

-- | Releases a reference to the t'GI.Secret.Structs.Schema.Schema'.
-- 
-- If the last reference is released then the schema will be freed.
-- 
-- It is not normally necessary to call this function from C code, and is
-- mainly present for the sake of bindings. It is an error to call this for
-- a /@schema@/ that was statically allocated.
schemaUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Schema
    -- ^ /@schema@/: the schema to reference
    -> m ()
schemaUnref :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Schema -> m ()
schemaUnref Schema
schema = 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
    schema' <- Schema -> IO (Ptr Schema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Schema
schema
    secret_schema_unref schema'
    touchManagedPtr schema
    return ()

#if defined(ENABLE_OVERLOADING)
data SchemaUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod SchemaUnrefMethodInfo Schema signature where
    overloadedMethod :: Schema -> signature
overloadedMethod = Schema -> signature
Schema -> m ()
forall (m :: * -> *). (HasCallStack, MonadIO m) => Schema -> m ()
schemaUnref

instance O.OverloadedMethodInfo SchemaUnrefMethodInfo Schema where
    overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
        resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Secret.Structs.Schema.schemaUnref",
        resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Structs-Schema.html#v:schemaUnref"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveSchemaMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveSchemaMethod "ref" o = SchemaRefMethodInfo
    ResolveSchemaMethod "unref" o = SchemaUnrefMethodInfo
    ResolveSchemaMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveSchemaMethod t Schema, O.OverloadedMethod info Schema p) => OL.IsLabel t (Schema -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel :: Schema -> 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 ~ ResolveSchemaMethod t Schema, O.OverloadedMethod info Schema p, R.HasField t Schema p) => R.HasField t Schema p where
    getField :: Schema -> 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 ~ ResolveSchemaMethod t Schema, O.OverloadedMethodInfo info Schema) => OL.IsLabel t (O.MethodProxy info Schema) where
#if MIN_VERSION_base(4,10,0)
    fromLabel :: MethodProxy info Schema
fromLabel = MethodProxy info Schema
forall info obj. MethodProxy info obj
O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif