module GI.Secret.Structs.Schema
(
Schema(..) ,
newZeroSchema ,
noSchema ,
SchemaRefMethodInfo ,
schemaRef ,
SchemaUnrefMethodInfo ,
schemaUnref ,
getSchemaFlags ,
schema_flags ,
setSchemaFlags ,
clearSchemaName ,
getSchemaName ,
schema_name ,
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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
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 GI.Secret.Flags as Secret.Flags
newtype Schema = Schema (ManagedPtr Schema)
foreign import ccall "secret_schema_get_type" c_secret_schema_get_type ::
IO GType
instance BoxedObject Schema where
boxedType _ = c_secret_schema_get_type
newZeroSchema :: MonadIO m => m Schema
newZeroSchema = liftIO $ callocBoxedBytes 592 >>= wrapBoxed Schema
instance tag ~ 'AttrSet => Constructible Schema tag where
new _ attrs = do
o <- newZeroSchema
GI.Attributes.set o attrs
return o
noSchema :: Maybe Schema
noSchema = Nothing
getSchemaName :: MonadIO m => Schema -> m (Maybe T.Text)
getSchemaName s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 0) :: IO CString
result <- SP.convertIfNonNull val $ \val' -> do
val'' <- cstringToText val'
return val''
return result
setSchemaName :: MonadIO m => Schema -> CString -> m ()
setSchemaName s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 0) (val :: CString)
clearSchemaName :: MonadIO m => Schema -> m ()
clearSchemaName s = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 0) (FP.nullPtr :: CString)
data SchemaNameFieldInfo
instance AttrInfo SchemaNameFieldInfo where
type AttrAllowedOps SchemaNameFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
type AttrSetTypeConstraint SchemaNameFieldInfo = (~) CString
type AttrBaseTypeConstraint SchemaNameFieldInfo = (~) Schema
type AttrGetType SchemaNameFieldInfo = Maybe T.Text
type AttrLabel SchemaNameFieldInfo = "name"
type AttrOrigin SchemaNameFieldInfo = Schema
attrGet _ = getSchemaName
attrSet _ = setSchemaName
attrConstruct = undefined
attrClear _ = clearSchemaName
schema_name :: AttrLabelProxy "name"
schema_name = AttrLabelProxy
getSchemaFlags :: MonadIO m => Schema -> m [Secret.Flags.SchemaFlags]
getSchemaFlags s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 8) :: IO CUInt
let val' = wordToGFlags val
return val'
setSchemaFlags :: MonadIO m => Schema -> [Secret.Flags.SchemaFlags] -> m ()
setSchemaFlags s val = liftIO $ withManagedPtr s $ \ptr -> do
let val' = gflagsToWord val
poke (ptr `plusPtr` 8) (val' :: CUInt)
data SchemaFlagsFieldInfo
instance AttrInfo SchemaFlagsFieldInfo where
type AttrAllowedOps SchemaFlagsFieldInfo = '[ 'AttrSet, 'AttrGet]
type AttrSetTypeConstraint SchemaFlagsFieldInfo = (~) [Secret.Flags.SchemaFlags]
type AttrBaseTypeConstraint SchemaFlagsFieldInfo = (~) Schema
type AttrGetType SchemaFlagsFieldInfo = [Secret.Flags.SchemaFlags]
type AttrLabel SchemaFlagsFieldInfo = "flags"
type AttrOrigin SchemaFlagsFieldInfo = Schema
attrGet _ = getSchemaFlags
attrSet _ = setSchemaFlags
attrConstruct = undefined
attrClear _ = undefined
schema_flags :: AttrLabelProxy "flags"
schema_flags = AttrLabelProxy
instance O.HasAttributeList Schema
type instance O.AttributeList Schema = SchemaAttributeList
type SchemaAttributeList = ('[ '("name", SchemaNameFieldInfo), '("flags", SchemaFlagsFieldInfo)] :: [(Symbol, *)])
foreign import ccall "secret_schema_ref" secret_schema_ref ::
Ptr Schema ->
IO (Ptr Schema)
schemaRef ::
(B.CallStack.HasCallStack, MonadIO m) =>
Schema
-> m Schema
schemaRef schema = liftIO $ do
schema' <- unsafeManagedPtrGetPtr schema
result <- secret_schema_ref schema'
checkUnexpectedReturnNULL "schemaRef" result
result' <- (wrapBoxed Schema) result
touchManagedPtr schema
return result'
data SchemaRefMethodInfo
instance (signature ~ (m Schema), MonadIO m) => O.MethodInfo SchemaRefMethodInfo Schema signature where
overloadedMethod _ = schemaRef
foreign import ccall "secret_schema_unref" secret_schema_unref ::
Ptr Schema ->
IO ()
schemaUnref ::
(B.CallStack.HasCallStack, MonadIO m) =>
Schema
-> m ()
schemaUnref schema = liftIO $ do
schema' <- unsafeManagedPtrGetPtr schema
secret_schema_unref schema'
touchManagedPtr schema
return ()
data SchemaUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo SchemaUnrefMethodInfo Schema signature where
overloadedMethod _ = schemaUnref
type family ResolveSchemaMethod (t :: Symbol) (o :: *) :: * where
ResolveSchemaMethod "ref" o = SchemaRefMethodInfo
ResolveSchemaMethod "unref" o = SchemaUnrefMethodInfo
ResolveSchemaMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveSchemaMethod t Schema, O.MethodInfo info Schema p) => O.IsLabelProxy t (Schema -> p) where
fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolveSchemaMethod t Schema, O.MethodInfo info Schema p) => O.IsLabel t (Schema -> p) where
fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif