{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An attribute in a t'GI.Secret.Structs.Schema.Schema'.

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

module GI.Secret.Structs.SchemaAttribute
    ( 

-- * Exported types
    SchemaAttribute(..)                     ,
    newZeroSchemaAttribute                  ,


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolveSchemaAttributeMethod            ,
#endif



 -- * Properties


-- ** name #attr:name#
-- | name of the attribute

    clearSchemaAttributeName                ,
    getSchemaAttributeName                  ,
#if defined(ENABLE_OVERLOADING)
    schemaAttribute_name                    ,
#endif
    setSchemaAttributeName                  ,


-- ** type #attr:type#
-- | the type of the attribute

    getSchemaAttributeType                  ,
#if defined(ENABLE_OVERLOADING)
    schemaAttribute_type                    ,
#endif
    setSchemaAttributeType                  ,




    ) 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.Enums as Secret.Enums

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

#endif

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

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

foreign import ccall "secret_schema_attribute_get_type" c_secret_schema_attribute_get_type :: 
    IO GType

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

instance B.Types.TypedObject SchemaAttribute where
    glibType :: IO GType
glibType = IO GType
c_secret_schema_attribute_get_type

instance B.Types.GBoxed SchemaAttribute

-- | Convert t'SchemaAttribute' 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 SchemaAttribute) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_secret_schema_attribute_get_type
    gvalueSet_ :: Ptr GValue -> Maybe SchemaAttribute -> IO ()
gvalueSet_ Ptr GValue
gv Maybe SchemaAttribute
P.Nothing = Ptr GValue -> Ptr SchemaAttribute -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr SchemaAttribute
forall a. Ptr a
FP.nullPtr :: FP.Ptr SchemaAttribute)
    gvalueSet_ Ptr GValue
gv (P.Just SchemaAttribute
obj) = SchemaAttribute -> (Ptr SchemaAttribute -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr SchemaAttribute
obj (Ptr GValue -> Ptr SchemaAttribute -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe SchemaAttribute)
gvalueGet_ Ptr GValue
gv = do
        ptr <- Ptr GValue -> IO (Ptr SchemaAttribute)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr SchemaAttribute)
        if ptr /= FP.nullPtr
        then P.Just <$> B.ManagedPtr.newBoxed SchemaAttribute ptr
        else return P.Nothing
        
    

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

instance tag ~ 'AttrSet => Constructible SchemaAttribute tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr SchemaAttribute -> SchemaAttribute)
-> [AttrOp SchemaAttribute tag] -> m SchemaAttribute
new ManagedPtr SchemaAttribute -> SchemaAttribute
_ [AttrOp SchemaAttribute tag]
attrs = do
        o <- m SchemaAttribute
forall (m :: * -> *). MonadIO m => m SchemaAttribute
newZeroSchemaAttribute
        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' schemaAttribute #name
-- @
getSchemaAttributeName :: MonadIO m => SchemaAttribute -> m (Maybe T.Text)
getSchemaAttributeName :: forall (m :: * -> *).
MonadIO m =>
SchemaAttribute -> m (Maybe Text)
getSchemaAttributeName SchemaAttribute
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
$ SchemaAttribute
-> (Ptr SchemaAttribute -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr SchemaAttribute
s ((Ptr SchemaAttribute -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr SchemaAttribute -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr SchemaAttribute
ptr -> do
    val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr SchemaAttribute
ptr Ptr SchemaAttribute -> 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' schemaAttribute [ #name 'Data.GI.Base.Attributes.:=' value ]
-- @
setSchemaAttributeName :: MonadIO m => SchemaAttribute -> CString -> m ()
setSchemaAttributeName :: forall (m :: * -> *).
MonadIO m =>
SchemaAttribute -> CString -> m ()
setSchemaAttributeName SchemaAttribute
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
$ SchemaAttribute -> (Ptr SchemaAttribute -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr SchemaAttribute
s ((Ptr SchemaAttribute -> IO ()) -> IO ())
-> (Ptr SchemaAttribute -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SchemaAttribute
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr SchemaAttribute
ptr Ptr SchemaAttribute -> 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
-- @
clearSchemaAttributeName :: MonadIO m => SchemaAttribute -> m ()
clearSchemaAttributeName :: forall (m :: * -> *). MonadIO m => SchemaAttribute -> m ()
clearSchemaAttributeName SchemaAttribute
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
$ SchemaAttribute -> (Ptr SchemaAttribute -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr SchemaAttribute
s ((Ptr SchemaAttribute -> IO ()) -> IO ())
-> (Ptr SchemaAttribute -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SchemaAttribute
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr SchemaAttribute
ptr Ptr SchemaAttribute -> 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 SchemaAttributeNameFieldInfo
instance AttrInfo SchemaAttributeNameFieldInfo where
    type AttrBaseTypeConstraint SchemaAttributeNameFieldInfo = (~) SchemaAttribute
    type AttrAllowedOps SchemaAttributeNameFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint SchemaAttributeNameFieldInfo = (~) CString
    type AttrTransferTypeConstraint SchemaAttributeNameFieldInfo = (~)CString
    type AttrTransferType SchemaAttributeNameFieldInfo = CString
    type AttrGetType SchemaAttributeNameFieldInfo = Maybe T.Text
    type AttrLabel SchemaAttributeNameFieldInfo = "name"
    type AttrOrigin SchemaAttributeNameFieldInfo = SchemaAttribute
    attrGet :: forall o.
AttrBaseTypeConstraint SchemaAttributeNameFieldInfo o =>
o -> IO (AttrGetType SchemaAttributeNameFieldInfo)
attrGet = o -> IO (AttrGetType SchemaAttributeNameFieldInfo)
SchemaAttribute -> IO (Maybe Text)
forall (m :: * -> *).
MonadIO m =>
SchemaAttribute -> m (Maybe Text)
getSchemaAttributeName
    attrSet :: forall o b.
(AttrBaseTypeConstraint SchemaAttributeNameFieldInfo o,
 AttrSetTypeConstraint SchemaAttributeNameFieldInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
SchemaAttribute -> CString -> IO ()
forall (m :: * -> *).
MonadIO m =>
SchemaAttribute -> CString -> m ()
setSchemaAttributeName
    attrConstruct :: forall o b.
(AttrBaseTypeConstraint SchemaAttributeNameFieldInfo o,
 AttrSetTypeConstraint SchemaAttributeNameFieldInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
forall a. HasCallStack => a
undefined
    attrClear :: forall o.
AttrBaseTypeConstraint SchemaAttributeNameFieldInfo o =>
o -> IO ()
attrClear = o -> IO ()
SchemaAttribute -> IO ()
forall (m :: * -> *). MonadIO m => SchemaAttribute -> m ()
clearSchemaAttributeName
    attrTransfer :: forall o b.
(AttrBaseTypeConstraint SchemaAttributeNameFieldInfo o,
 AttrTransferTypeConstraint SchemaAttributeNameFieldInfo b) =>
Proxy o -> b -> IO (AttrTransferType SchemaAttributeNameFieldInfo)
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.SchemaAttribute.name"
        , resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Structs-SchemaAttribute.html#g:attr:name"
        })

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

#endif


-- | Get the value of the “@type@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' schemaAttribute #type
-- @
getSchemaAttributeType :: MonadIO m => SchemaAttribute -> m Secret.Enums.SchemaAttributeType
getSchemaAttributeType :: forall (m :: * -> *).
MonadIO m =>
SchemaAttribute -> m SchemaAttributeType
getSchemaAttributeType SchemaAttribute
s = IO SchemaAttributeType -> m SchemaAttributeType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SchemaAttributeType -> m SchemaAttributeType)
-> IO SchemaAttributeType -> m SchemaAttributeType
forall a b. (a -> b) -> a -> b
$ SchemaAttribute
-> (Ptr SchemaAttribute -> IO SchemaAttributeType)
-> IO SchemaAttributeType
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr SchemaAttribute
s ((Ptr SchemaAttribute -> IO SchemaAttributeType)
 -> IO SchemaAttributeType)
-> (Ptr SchemaAttribute -> IO SchemaAttributeType)
-> IO SchemaAttributeType
forall a b. (a -> b) -> a -> b
$ \Ptr SchemaAttribute
ptr -> do
    val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr SchemaAttribute
ptr Ptr SchemaAttribute -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO CUInt
    let val' = (Int -> SchemaAttributeType
forall a. Enum a => Int -> a
toEnum (Int -> SchemaAttributeType)
-> (CUInt -> Int) -> CUInt -> SchemaAttributeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
val
    return val'

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

#if defined(ENABLE_OVERLOADING)
data SchemaAttributeTypeFieldInfo
instance AttrInfo SchemaAttributeTypeFieldInfo where
    type AttrBaseTypeConstraint SchemaAttributeTypeFieldInfo = (~) SchemaAttribute
    type AttrAllowedOps SchemaAttributeTypeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint SchemaAttributeTypeFieldInfo = (~) Secret.Enums.SchemaAttributeType
    type AttrTransferTypeConstraint SchemaAttributeTypeFieldInfo = (~)Secret.Enums.SchemaAttributeType
    type AttrTransferType SchemaAttributeTypeFieldInfo = Secret.Enums.SchemaAttributeType
    type AttrGetType SchemaAttributeTypeFieldInfo = Secret.Enums.SchemaAttributeType
    type AttrLabel SchemaAttributeTypeFieldInfo = "type"
    type AttrOrigin SchemaAttributeTypeFieldInfo = SchemaAttribute
    attrGet :: forall o.
AttrBaseTypeConstraint SchemaAttributeTypeFieldInfo o =>
o -> IO (AttrGetType SchemaAttributeTypeFieldInfo)
attrGet = o -> IO (AttrGetType SchemaAttributeTypeFieldInfo)
SchemaAttribute -> IO SchemaAttributeType
forall (m :: * -> *).
MonadIO m =>
SchemaAttribute -> m SchemaAttributeType
getSchemaAttributeType
    attrSet :: forall o b.
(AttrBaseTypeConstraint SchemaAttributeTypeFieldInfo o,
 AttrSetTypeConstraint SchemaAttributeTypeFieldInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
SchemaAttribute -> SchemaAttributeType -> IO ()
forall (m :: * -> *).
MonadIO m =>
SchemaAttribute -> SchemaAttributeType -> m ()
setSchemaAttributeType
    attrConstruct :: forall o b.
(AttrBaseTypeConstraint SchemaAttributeTypeFieldInfo o,
 AttrSetTypeConstraint SchemaAttributeTypeFieldInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
forall a. HasCallStack => a
undefined
    attrClear :: forall o.
AttrBaseTypeConstraint SchemaAttributeTypeFieldInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
    attrTransfer :: forall o b.
(AttrBaseTypeConstraint SchemaAttributeTypeFieldInfo o,
 AttrTransferTypeConstraint SchemaAttributeTypeFieldInfo b) =>
Proxy o -> b -> IO (AttrTransferType SchemaAttributeTypeFieldInfo)
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.SchemaAttribute.type"
        , resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-secret-0.0.20/docs/GI-Secret-Structs-SchemaAttribute.html#g:attr:type"
        })

schemaAttribute_type :: AttrLabelProxy "type"
schemaAttribute_type :: AttrLabelProxy "type"
schemaAttribute_type = AttrLabelProxy "type"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SchemaAttribute
type instance O.AttributeList SchemaAttribute = SchemaAttributeAttributeList
type SchemaAttributeAttributeList = ('[ '("name", SchemaAttributeNameFieldInfo), '("type", SchemaAttributeTypeFieldInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveSchemaAttributeMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveSchemaAttributeMethod l o = O.MethodResolutionFailed l o

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

#endif