#define ENABLE_OVERLOADING (MIN_VERSION_haskell_gi_overloading(1,0,0) \
&& !defined(__HADDOCK_VERSION__))
module GI.Secret.Structs.Schema
(
Schema(..) ,
newZeroSchema ,
noSchema ,
#if ENABLE_OVERLOADING
SchemaRefMethodInfo ,
#endif
schemaRef ,
#if ENABLE_OVERLOADING
SchemaUnrefMethodInfo ,
#endif
schemaUnref ,
getSchemaFlags ,
#if ENABLE_OVERLOADING
schema_flags ,
#endif
setSchemaFlags ,
clearSchemaName ,
getSchemaName ,
#if 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.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.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.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)
#if ENABLE_OVERLOADING
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
#endif
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)
#if ENABLE_OVERLOADING
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
#endif
#if ENABLE_OVERLOADING
instance O.HasAttributeList Schema
type instance O.AttributeList Schema = SchemaAttributeList
type SchemaAttributeList = ('[ '("name", SchemaNameFieldInfo), '("flags", SchemaFlagsFieldInfo)] :: [(Symbol, *)])
#endif
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'
#if ENABLE_OVERLOADING
data SchemaRefMethodInfo
instance (signature ~ (m Schema), MonadIO m) => O.MethodInfo SchemaRefMethodInfo Schema signature where
overloadedMethod _ = schemaRef
#endif
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 ()
#if ENABLE_OVERLOADING
data SchemaUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo SchemaUnrefMethodInfo Schema signature where
overloadedMethod _ = schemaUnref
#endif
#if ENABLE_OVERLOADING
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) => OL.IsLabel t (Schema -> p) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#else
fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif
#endif