{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- 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                  ,
    noSchemaAttribute                       ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded 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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

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

-- | Memory-managed wrapper type.
newtype SchemaAttribute = SchemaAttribute (ManagedPtr SchemaAttribute)
    deriving (SchemaAttribute -> SchemaAttribute -> Bool
(SchemaAttribute -> SchemaAttribute -> Bool)
-> (SchemaAttribute -> SchemaAttribute -> Bool)
-> Eq SchemaAttribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SchemaAttribute -> SchemaAttribute -> Bool
$c/= :: SchemaAttribute -> SchemaAttribute -> Bool
== :: SchemaAttribute -> SchemaAttribute -> Bool
$c== :: SchemaAttribute -> SchemaAttribute -> Bool
Eq)
foreign import ccall "secret_schema_attribute_get_type" c_secret_schema_attribute_get_type :: 
    IO GType

instance BoxedObject SchemaAttribute where
    boxedType :: SchemaAttribute -> IO GType
boxedType _ = IO GType
c_secret_schema_attribute_get_type

-- | Convert 'SchemaAttribute' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue SchemaAttribute where
    toGValue :: SchemaAttribute -> IO GValue
toGValue o :: SchemaAttribute
o = do
        GType
gtype <- IO GType
c_secret_schema_attribute_get_type
        SchemaAttribute -> (Ptr SchemaAttribute -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr SchemaAttribute
o (GType
-> (GValue -> Ptr SchemaAttribute -> IO ())
-> Ptr SchemaAttribute
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr SchemaAttribute -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO SchemaAttribute
fromGValue gv :: GValue
gv = do
        Ptr SchemaAttribute
ptr <- GValue -> IO (Ptr SchemaAttribute)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr SchemaAttribute)
        (ManagedPtr SchemaAttribute -> SchemaAttribute)
-> Ptr SchemaAttribute -> IO SchemaAttribute
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr SchemaAttribute -> SchemaAttribute
SchemaAttribute Ptr SchemaAttribute
ptr
        
    

-- | Construct a `SchemaAttribute` struct initialized to zero.
newZeroSchemaAttribute :: MonadIO m => m SchemaAttribute
newZeroSchemaAttribute :: m SchemaAttribute
newZeroSchemaAttribute = IO SchemaAttribute -> m SchemaAttribute
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. BoxedObject a => Int -> IO (Ptr a)
callocBoxedBytes 16 IO (Ptr SchemaAttribute)
-> (Ptr SchemaAttribute -> IO SchemaAttribute)
-> IO SchemaAttribute
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr SchemaAttribute -> SchemaAttribute)
-> Ptr SchemaAttribute -> IO SchemaAttribute
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr SchemaAttribute -> SchemaAttribute
SchemaAttribute

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


-- | A convenience alias for `Nothing` :: `Maybe` `SchemaAttribute`.
noSchemaAttribute :: Maybe SchemaAttribute
noSchemaAttribute :: Maybe SchemaAttribute
noSchemaAttribute = Maybe SchemaAttribute
forall a. Maybe a
Nothing

-- | 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 :: SchemaAttribute -> m (Maybe Text)
getSchemaAttributeName s :: SchemaAttribute
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ 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 :: Ptr SchemaAttribute
ptr -> do
    CString
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` 0) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \val' :: CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
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 :: SchemaAttribute -> CString -> m ()
setSchemaAttributeName s :: SchemaAttribute
s val :: CString
val = IO () -> m ()
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 :: 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` 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 :: SchemaAttribute -> m ()
clearSchemaAttributeName s :: SchemaAttribute
s = IO () -> m ()
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 :: 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` 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 = getSchemaAttributeName
    attrSet = setSchemaAttributeName
    attrConstruct = undefined
    attrClear = clearSchemaAttributeName
    attrTransfer _ v = do
        return v

schemaAttribute_name :: AttrLabelProxy "name"
schemaAttribute_name = 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 :: SchemaAttribute -> m SchemaAttributeType
getSchemaAttributeType s :: SchemaAttribute
s = IO SchemaAttributeType -> m SchemaAttributeType
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 :: Ptr SchemaAttribute
ptr -> do
    CUInt
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` 8) :: IO CUInt
    let val' :: SchemaAttributeType
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
    SchemaAttributeType -> IO SchemaAttributeType
forall (m :: * -> *) a. Monad m => a -> m a
return SchemaAttributeType
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 :: SchemaAttribute -> SchemaAttributeType -> m ()
setSchemaAttributeType s :: SchemaAttribute
s val :: SchemaAttributeType
val = IO () -> m ()
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 :: 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` 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 = getSchemaAttributeType
    attrSet = setSchemaAttributeType
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

schemaAttribute_type :: AttrLabelProxy "type"
schemaAttribute_type = AttrLabelProxy

#endif



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

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

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

#endif